Fix for report #67958: Fortran's open call should open explicitly for read-only
[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)
e92c2cff 106 open(unit=1,file=setpath,status='old',action='read')
0caf84a5 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()
1301 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
165end subroutine InitPDFsetM
166
167
168
169integer 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
200end function token
201
202
203
204subroutine 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
214end subroutine LHAprint
215
216
217
218subroutine setPDFpath(pathname)
219 implicit none
220 include 'commonlhapdfc.inc'
221 include 'commonlhacontrol.inc'
222 include 'parmsetup.inc'
223 character*(*) pathname
224 integer j
84ef6b08 225 integer len_trim
0caf84a5 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
234end subroutine setPDFpath
235
236
237
238subroutine 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
251end subroutine lhaset
252
253
254
255subroutine 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
295end subroutine setlhaparm
296
297
298
299subroutine 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
326end subroutine getdirpath