LHAPDF 5.2.2 source code.
[u/mrichter/AliRoot.git] / LHAPDF / lhapdf5.2.2 / LHpdflib.f
1 c     Automatically determine the path to the system's PDF set
2 c     collection using the lhapdf-config utility (which must be
3 c     in the user's execution path
4 c     ---------------------------------------------------------
5       subroutine InitPDFsetByCodes(code1, code2, code3)
6       write(*,*) "Not implemented yet: this will move the 'glue' interf
7      +ace to LHAPDF proper and use the InitPDFsetByName function to get
8      +the path automatically."
9       return
10       end
11 c     ---------------------------------------------------------
12
13
14 c     Automatically determine the path to the system's PDF set
15 c     collection using the lhapdf-config utility (which must be
16 c     in the user's execution path
17 c     --------------------------------------------------------
18       subroutine InitPDFsetByName(setname)
19       implicit none
20       character setname*(*)
21       integer nset
22       nset = 1
23       call InitPDFsetByNameM(nset,setname)
24       return
25       end
26       
27       subroutine InitPDFsetByNameM(nset,setname)
28       implicit none
29       character setname*(*)
30       integer nset
31 c      integer :: ierror
32       integer n, dirpathlength, setnamelength
33       character*512 dirpath, setpath
34 c check enviromental variable LHAPATH
35       call getenv('LHAPATH',dirpath)
36       if (dirpath.eq.'') then
37 c      Use the lhapdf-config script to get the path to the PDF sets
38        call system
39      + ("lhapdf-config --pdfsets-path > /tmp/lhapdf-pdfsets-path")
40        open(unit=8, file="/tmp/lhapdf-pdfsets-path", status="old")
41 c      open(unit=8, file="/tmp/lhapdf-pdfsets-path", status="old", iostat
42 c      $=ierror)
43        read (8,'(A)') dirpath
44        close(8)
45       endif
46
47 c     Now do some mangling to get the right path length from the 
48 c     (hopefully) over-long string read in from the file
49       n = 512
50       do while (dirpath(n:n) .eq. ' ' .and. n .gt. 0)
51          n = n-1
52       enddo
53       dirpathlength = n
54
55 c     How long is 'name', really?
56       n = len(setname)
57       do while (setname(n:n) .eq. ' ' .and. n .gt. 0)
58          n = n-1
59       enddo
60       setnamelength = n
61
62 c     Combine the set directory path and the set name
63       setpath(1:dirpathlength) = dirpath(1:dirpathlength)
64       setpath(dirpathlength+1:dirpathlength+1) = "/"
65       setpath(dirpathlength+2:dirpathlength+setnamelength+1) = setname(1
66      $:setnamelength)
67 c      setpath(dirpathlength+setnamelength+2:dirpathlength+setnamelength+
68 c     $2) = ":"
69 c      write(*,*) setpath(1:dirpathlength+setnamelength+2)
70
71       call InitPDFsetM(nset,setpath(1:dirpathlength+setnamelength+1))
72       return
73       end
74 c     ---------------------------------------------------------
75
76       subroutine InitPDFset(setpath)
77       implicit none
78       integer nset
79       character setpath*(*)
80       nset = 1
81       call InitPDFsetM(nset,setpath)
82       return
83       end      
84 c
85       subroutine InitPDFsetM(nset,setpath)
86       implicit none
87       include 'parmsetup.inc'
88       character setpath*(*)
89       character*64 string
90       character*16 s1,s2
91       integer id,token,Ctoken
92       integer lhasilent
93       common/lhasilent/lhasilent
94       integer nset,imem
95 c
96       call setnset(nset)
97 c      
98       open(unit=1,file=setpath,status='old')
99       read(1,*) s1,s2
100       if ((index(s2,'1.0').ne.1)
101      +.and.(index(s2,'1.1').ne.1)
102      +.and.(index(s2,'2.0').ne.1)
103      +.and.(index(s2,'2.1').ne.1)
104      +.and.(index(s2,'3.0').ne.1) 
105      +.and.(index(s2,'3.1').ne.1)
106      +.and.(index(s2,'4.0').ne.1)
107      +.and.(index(s2,'5.0').ne.1))then
108          write(*,*) 
109      .        'Version ',s2,' not supported by this version of LHAPDF'
110          stop
111       else  
112        if(lhasilent.eq.0) then
113          write(*,*) '*************************************'
114          write(*,*) '*       LHAPDF Version 5.2.2          *'
115          write(*,*) '*************************************'
116          write(*,*)
117        endif
118       endif
119       id=Ctoken()
120  1    read(1,*) string
121       id=token(string)
122 c      print *,'id = ',id,string
123       if (id.eq.0) then
124          write(*,*) 'File description error:'
125          write(*,*) 'Command not understood: ',string
126          stop
127       endif
128       if (id.eq.1) call descriptionPDF(nset,id)
129 c      print *,'1/2'
130       if (id.eq.2) call initEvolve(nset)
131 c      print *,'2/3'
132       if (id.eq.3) call initAlphasPDF(nset)
133 c      print *,'3/4'
134       if (id.eq.4) call initInputPDF(nset)
135 c      print *,'4/5'
136       if (id.eq.5) call initListPDF(nset)
137 c      print *,'5/6'
138       if (id.eq.6) call initQCDparams(nset)
139 c      print *,'6/7'
140       if (id.ne.7) goto 1
141       close(1)
142 c      print *,'calling InitEvolveCode',nset
143       call InitEvolveCode(nset)
144 *
145       return
146       end
147 *     
148       integer function token(s)
149       implicit none
150       character*16 s
151       integer not,i,Ctoken
152       parameter(not=7)
153       character*16 t(not)
154       data t/'Description:','Evolution:','Alphas:',
155      .                    'Parametrization:','Parameterlist:',
156      .                    'QCDparams:',
157      .                    'End:'/
158       integer count(not)
159       save count
160 *
161       token=0
162       do i=1,not
163          if (s.eq.t(i)) token=i
164       enddo
165       if (token.ne.0) then
166          count(token)=count(token)+1
167          if (count(token).eq.2) then
168             write(*,*) 'File description error:'
169             write(*,*) 'Second definition of entry: ',s
170             stop
171          endif
172       endif
173       return
174 *
175       entry Ctoken()
176       do i=1,not
177          count(i)=0
178       enddo
179       Ctoken=0
180       return
181 *     
182       end
183 c
184       subroutine LHAprint(iprint)
185       implicit none
186       integer lhasilent,iprint
187       common/lhasilent/lhasilent
188       lhasilent=iprint
189 c      print *,'lhasilent',lhasilent
190       return
191       end