Restore support for g77
[u/mrichter/AliRoot.git] / LHAPDF / lhapdf5.5.1 / src / LHpdflib.f
CommitLineData
0caf84a5 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
16subroutine InitPDFsetByName(setname)
17 implicit none
18 character setname*(*)
19 integer nset
20 nset = 1
21 call commoninit()
22 call InitPDFsetByNameM(nset,setname)
23 return
24end subroutine InitPDFsetByName
25
26
27
28! Initialize a PDF set, determining the path to the PDF set
29! directory automatically
30subroutine 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
84ef6b08 38 integer len_trim
0caf84a5 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
52end subroutine InitPDFsetByNameM
53
54
55
56subroutine InitPDFset(setpath)
57 implicit none
58 integer nset
59 character setpath*(*)
60 nset = 1
61 call commoninit()
62 call InitPDFsetM(nset,setpath)
63 return
64end subroutine InitPDFset
65
66
67subroutine InitLHAPDF()
68 call commoninit()
69end subroutine InitLHAPDF
70
71
72subroutine 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)
b82f5858 106#ifdef __GFORTRAN__
e92c2cff 107 open(unit=1,file=setpath,status='old',action='read')
b82f5858 108#else
109 open(unit=1,file=setpath,status='old')
110#endif
0caf84a5 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()
1341 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
169end subroutine InitPDFsetM
170
171
172
173integer 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
204end function token
205
206
207
208subroutine 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
218end subroutine LHAprint
219
220
221
222subroutine setPDFpath(pathname)
223 implicit none
224 include 'commonlhapdfc.inc'
225 include 'commonlhacontrol.inc'
226 include 'parmsetup.inc'
227 character*(*) pathname
228 integer j
84ef6b08 229 integer len_trim
0caf84a5 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
238end subroutine setPDFpath
239
240
241
242subroutine 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
255end subroutine lhaset
256
257
258
259subroutine 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
299end subroutine setlhaparm
300
301
302
303subroutine 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
330end subroutine getdirpath