extension .F -> .f
[u/mrichter/AliRoot.git] / LHAPDF / lhapdf-5.9.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
39   ! Initialise common blocks
40   call commoninit()
41
42   ! Find the directory with the PDFsets
43   call getdirpath(dirpath)
44
45   ! Now build the path to the PDF set
46   setpath = dirpath(:len_trim(dirpath)) // "/" // setname(:len_trim(setname))
47
48   ! Initialize using the detected PDF set
49   call InitPDFsetM(nset, setpath(:len_trim(setpath)))
50   return
51 end subroutine InitPDFsetByNameM
52
53
54
55 subroutine InitPDFset(setpath)
56   implicit none
57   integer nset
58   character setpath*(*)
59   nset = 1
60   call commoninit()
61   call InitPDFsetM(nset,setpath)
62   return
63 end subroutine InitPDFset
64
65
66 subroutine InitLHAPDF()
67   call commoninit()
68 end subroutine InitLHAPDF
69
70
71 subroutine InitPDFsetM(nset,setpath)
72   implicit none
73   include 'parmsetup.inc'
74   include 'commonlhacontrol.inc'
75   character*512 filename
76   common/lhafilename/filename
77   character setpath*(*)
78   character*512 inputfile(nmxset)
79   character*64 string
80   character*16 s1,s2
81   character*10 lhaversion
82   integer id,token,Ctoken
83   integer lhaonce
84   save lhaonce,inputfile
85   data lhaonce/0/
86   integer lhasilent
87   common/lhasilent/lhasilent
88   integer nset,nnset
89   integer stat
90
91   filename=setpath
92 #ifndef LOW_MEMORY
93   ! check if this set is already initialized - will not work for lite
94   if(inputfile(nset)(:len_trim(setpath)).eq.setpath) return
95 #endif
96
97   ! Initialise common blocks
98   call commoninit()
99   call getlhapdfversion(lhaversion)
100
101   inputfile(nset)=setpath
102   lhasilent = 0
103   if (lhaparm(19).eq.'SILENT') then
104      lhasilent = 1
105   elseif (lhaparm(19).eq.'LOWKEY') then
106      if (lhaonce .eq. 0) then
107         lhaonce = 1
108      else
109         lhasilent = 1
110      endif
111   endif
112
113   call setnset(nset)
114   open(unit=1, file=setpath, status='old', iostat=stat)
115   if (stat .ne. 0) then
116     write(*,*) 'File ', setpath(:len_trim(setpath)), ' cannot be opened !'
117     write(*,*) 'If you have not already done so:'
118     write(*,*) 'Use the bin/lhapdf-getdata script to download the file.'
119     write(*,*) 'Set the environmental variable LHAPATH to specify the directory if not as default (above).'
120     close(1)
121     call exit(1)
122   end if
123   read(1,*) s1,s2
124   if ((    index(s2,'1.0').ne.1) &
125      .and.(index(s2,'1.1').ne.1) &
126      .and.(index(s2,'2.0').ne.1) &
127      .and.(index(s2,'2.1').ne.1) &
128      .and.(index(s2,'3.0').ne.1) &
129      .and.(index(s2,'3.1').ne.1) &
130      .and.(index(s2,'4.0').ne.1) &
131      .and.(index(s2,'5.0').ne.1) &
132      .and.(index(s2,'5.3').ne.1) &
133      .and.(index(s2,'5.4').ne.1) &
134      .and.(index(s2,'5.5').ne.1) &
135      .and.(index(s2,'5.6').ne.1) &
136      .and.(index(s2,'5.7').ne.1) &
137      .and.(index(s2,'5.8').ne.1)) then
138      write(*,*) 'Version ',s2,' not supported by this version of LHAPDF'
139      stop
140   else
141      if (lhasilent.eq.0) then
142         write(*,*) '*************************************'
143         write(*,*) '*       LHAPDF Version ',lhaversion,'   *'
144         write(*,*) '*   Configured for the following:   *'
145 #ifdef ALL
146         write(*,*) '*             All PDFs              *'
147 #endif
148 #ifndef ALL
149 #ifdef MRST
150         write(*,*) '*             MRSTMAIN              *'
151 #endif
152 #ifdef MRST06
153         write(*,*) '*              MRST06               *'
154 #endif
155 #ifdef MRST98
156         write(*,*) '*              MRST98               *'
157 #endif
158 #ifdef MRSTQED
159         write(*,*) '*              MRSTQED              *'
160 #endif
161 #ifdef CTEQ
162         write(*,*) '*               CTEQ                *'
163 #endif
164 #ifdef MSTW
165         write(*,*) '*               MSTW                *'
166 #endif
167 #ifdef ALEKHIN
168         write(*,*) '*              ALEKHIN              *'
169 #endif
170 #ifdef NNPDF
171         write(*,*) '*               NNPDF               *'
172 #endif
173 #ifdef BOTJE
174         write(*,*) '*               BOTJE               *'
175 #endif
176 #ifdef FERMI
177         write(*,*) '*               FERMI               *'
178 #endif
179 #ifdef ZEUS
180         write(*,*) '*               ZEUS                *'
181 #endif
182 #ifdef H1
183         write(*,*) '*                H1                 *'
184 #endif
185 #ifdef HERA
186         write(*,*) '*               HERA                *'
187 #endif
188 #ifdef GRV
189         write(*,*) '*                GRV                *'
190 #endif
191 #ifdef GJR
192         write(*,*) '*               GJR/JR              *'
193 #endif
194 #ifdef HKN
195         write(*,*) '*                HKN                *'
196 #endif
197 #ifdef PIONS
198         write(*,*) '*               PIONS               *'
199 #endif
200 #ifdef PHOTONS
201         write(*,*) '*              PHOTONS              *'
202 #endif
203 #ifdef USER
204         write(*,*) '*               USER                *'
205 #endif
206 #endif
207 #ifdef LOW_MEMORY
208         write(*,*) '*          LOW MEMORY option        *'
209 #endif
210 #ifdef FULL_MEMORY
211         write(*,*) '*         FULL MEMORY option        *'
212 #endif
213  1111 format(' *    Maximum ',i2,' concurrent set(s)   *')
214         write(*,1111),nmxset
215         write(*,*) '*************************************'
216         write(*,*)
217      endif
218   endif
219   id=Ctoken()
220 1 read(1,*) string
221   id=token(string)
222   ! print *,'id = ',id,string
223   if (id.eq.0) then
224      write(*,*) 'File description error:'
225      write(*,*) 'Command not understood: ',string
226      stop
227   endif
228   if (id.eq.1) call descriptionPDF(nset,id)
229   ! print *,'1/2'
230   if (id.eq.2) then 
231      call initEvolve(nset)
232   endif
233   ! print *,'2/3'
234   if (id.eq.3) call initAlphasPDF(nset)
235   ! print *,'3/4'
236   if (id.eq.4) call initInputPDF(nset)
237   ! print *,'4/5'
238   if (id.eq.5) call initListPDF(nset)
239   ! print *,'5/6'
240   if (id.eq.6) call initQCDparams(nset)
241   ! print *,'6/7'
242   if (id.eq.7) call initMinMax(nset)
243   ! print *,'7/8'
244   if (id.ne.8) goto 1
245   close(1)
246   ! print *,'calling InitEvolveCode',nset
247   call InitEvolveCode(nset)
248
249   ! Initialize the default member 0
250   call InitPDFM(nset,0)
251
252   return
253   entry getsetpath(setpath)
254     call getnset(nnset)
255     setpath=inputfile(nnset)
256   return
257
258 end subroutine InitPDFsetM
259
260
261
262 integer function token(s)
263   implicit none
264   character*16 s
265   integer not,i,Ctoken
266   parameter(not=8)
267   character*16 t(not)
268   data t/'Description:','Evolution:','Alphas:', 'Parametrization:', &
269        'Parameterlist:','QCDparams:','MinMax:','End:'/
270   integer count(not)
271   save count
272
273   token=0
274   do i=1,not
275      if (s.eq.t(i)) token=i
276   enddo
277   if (token.ne.0) then
278      count(token)=count(token)+1
279      if (count(token).eq.2) then
280         write(*,*) 'File description error:'
281         write(*,*) 'Second definition of entry: ',s
282         stop
283      endif
284   endif
285   return
286
287   entry Ctoken()
288   do i=1,not
289      count(i)=0
290   enddo
291   Ctoken=0
292   return
293 end function token
294
295
296
297 subroutine LHAprint(iprint)
298   implicit none
299   include 'commonlhacontrol.inc'
300   integer lhasilent,iprint
301   common/lhasilent/lhasilent
302   call commoninit()
303   lhasilent = iprint
304   ! If using stream #6, don't silence!
305   if(iprint.ne.6) lhaparm(19)='SILENT'
306   return
307 end subroutine LHAprint
308
309
310
311 subroutine setPDFpath(pathname)
312   implicit none
313   include 'commonlhapdfc.inc'
314   include 'commonlhacontrol.inc'
315   include 'parmsetup.inc'
316   character*(*) pathname
317   integer j
318
319   call commoninit()
320   lhaparm(20) = 'LHAPATH'
321   do j=1,len_trim(lhapath)
322      lhapath(j:j)=''
323   enddo
324   lhapath = pathname
325   return
326 end subroutine setPDFpath
327
328
329
330 subroutine lhaset(lhaparm2,lhavalue2)
331   implicit none
332   include 'commonlhacontrol.inc'
333   character*20 lhaparm2(20)
334   double precision lhavalue2(20)
335   integer j
336
337   call commoninit()
338   do j=1,20
339      lhaparm(j)=lhaparm2(j)
340      lhavalue(j)=lhavalue2(j)
341   enddo
342   return
343 end subroutine lhaset
344
345
346
347 subroutine setlhaparm(lparm)
348   implicit none
349   include 'commonlhacontrol.inc'
350   character*(*) lparm
351   integer nparm
352
353   call commoninit()
354
355   if(lparm.eq.'EKS98') then
356      lhaparm(15)='EKS98'
357   else if(lparm.eq.'EPS08') then
358      lhaparm(15)='EPS08'
359   else if(lparm.eq.'EPS09') then
360      lhaparm(15)='EPS09'
361   else if(lparm(1:5).eq.'EPS09') then
362      lhaparm(15)=lparm(1:LEN_TRIM(lparm))
363   else if(lparm.eq.'15') then
364      lhaparm(15)=''
365   else if(lparm.eq.'NOSTAT') then
366      lhaparm(16)='NOSTAT'
367   else if (lparm.eq.'16') then
368      lhaparm(16)=''
369   else if (lparm.eq.'LHAPDF') then
370      lhaparm(17)='LHAPDF'
371   else if (lparm.eq.'17') then
372      lhaparm(17)=''
373   else if (lparm.eq.'EXTRAPOLATE') then
374      lhaparm(18)='EXTRAPOLATE'
375   else if (lparm.eq.'18') then
376      lhaparm(18)=''
377   else if (lparm.eq.'SILENT') then
378      lhaparm(19)='SILENT'
379   else if (lparm.eq.'LOWKEY') then
380      lhaparm(19)='LOWKEY'
381   else if (lparm.eq.'19') then
382      lhaparm(19)=''
383   else
384      print *,'WARNING from SetLHAPARM - value',lparm,'not recognized!'
385   endif
386   return
387
388   entry getlhaparm(nparm,lparm)
389   lparm = lhaparm(nparm)
390   return
391 end subroutine setlhaparm
392
393
394
395 subroutine getdirpath(dirpath)
396   ! This routine is to determine the directory path for the PDFsets
397   ! directory. It has a two-fold purpose:
398   ! 1) to return the value as an argument in dirpath for the native
399   !    LHAPDF use (ie via initPDFSetByName
400   ! 2) to fill the value of lhapath in the LHAPDFC common for use in
401   !    lhaglue.
402   implicit none
403   include 'commonlhapdfc.inc'
404   include 'commonlhacontrol.inc'
405   include 'parmsetup.inc'
406   character*(*) dirpath
407
408   ! First look in the LHAPDFC array (lhaparm(20), set by setPDFpath).
409   ! Next, check environmental variable LHAPATH.
410   ! Finally, use binreloc via getdatapath(...).
411   ! Will use default path if this all fails.
412   if (lhaparm(20) /= 'LHAPATH') then
413      call getenv('LHAPATH', lhapath)
414      !call get_environment_variable('LHAPATH',lhapath)
415      if (lhapath.eq.'') then
416         call getdatapath(dirpath)
417         lhapath = dirpath
418      endif
419   endif
420   dirpath = lhapath
421   return
422 end subroutine getdirpath
423
424
425 !-- Get the maximum number of concurrent PDF sets.
426 subroutine GetMaxNumSets(MaxNumSets)
427   implicit none
428   include 'parmsetup.inc'
429   integer MaxNumSets
430   MaxNumSets = nmxset
431 end subroutine GetMaxNumSets
432
433
434 logical function has_photon()
435   implicit none
436   include 'parmsetup.inc'
437   integer nset
438   character*16 name(nmxset)
439   integer nmem(nmxset),ndef(nmxset),mem
440   common/NAME/name,nmem,ndef,mem
441 !
442   call getnset(nset)
443   has_photon = .FALSE.
444
445   if(name(nset).eq.'MRST4qed') has_photon = .TRUE.
446   if(name(nset).eq.'NNPDF20intqed') has_photon = .TRUE.
447 !
448   return
449 !
450 end function has_photon