29b6595322a0bd0982982665ef2d6b9fa69c8735
[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
35       INTEGER LNROOT
36       CHARACTER*1000 CHROOT
37       CHROOT=' '
38
39 c check enviromental variable LHAPATH
40       call getenv('LHAPATH',dirpath)
41       if (dirpath.eq.'') then
42 C     Take the data from $ALICE_ROOT/LHAPDF/PDFsets
43          CALL GETENV('ALICE_ROOT',CHROOT)
44          LNROOT = LNBLNK(CHROOT)
45          IF(LNROOT.LE.0) THEN
46             dirpath='PDFsets'   ! Default value
47          ELSE
48             dirpath=CHROOT(1:LNROOT)//'/LHAPDF/PDFsets'
49          ENDIF
50       endif
51
52 c     Now do some mangling to get the right path length from the 
53 c     (hopefully) over-long string read in from the file
54       n = 512
55       do while (dirpath(n:n) .eq. ' ' .and. n .gt. 0)
56          n = n-1
57       enddo
58       dirpathlength = n
59
60 c     How long is 'name', really?
61       n = len(setname)
62       do while (setname(n:n) .eq. ' ' .and. n .gt. 0)
63          n = n-1
64       enddo
65       setnamelength = n
66
67 c     Combine the set directory path and the set name
68       setpath(1:dirpathlength) = dirpath(1:dirpathlength)
69       setpath(dirpathlength+1:dirpathlength+1) = "/"
70       setpath(dirpathlength+2:dirpathlength+setnamelength+1) = setname(1
71      $:setnamelength)
72 c      setpath(dirpathlength+setnamelength+2:dirpathlength+setnamelength+
73 c     $2) = ":"
74 c      write(*,*) setpath(1:dirpathlength+setnamelength+2)
75
76       call InitPDFsetM(nset,setpath(1:dirpathlength+setnamelength+1))
77       return
78       end
79 c     ---------------------------------------------------------
80
81       subroutine InitPDFset(setpath)
82       implicit none
83       integer nset
84       character setpath*(*)
85       nset = 1
86       call InitPDFsetM(nset,setpath)
87       return
88       end      
89 c
90       subroutine InitPDFsetM(nset,setpath)
91       implicit none
92       include 'parmsetup.inc'
93       character setpath*(*)
94       character*64 string
95       character*16 s1,s2
96       integer id,token,Ctoken
97       integer lhasilent
98       common/lhasilent/lhasilent
99       integer nset,imem
100 c
101       call setnset(nset)
102 c      
103       open(unit=1,file=setpath,status='old')
104       read(1,*) s1,s2
105       if ((index(s2,'1.0').ne.1)
106      +.and.(index(s2,'1.1').ne.1)
107      +.and.(index(s2,'2.0').ne.1)
108      +.and.(index(s2,'2.1').ne.1)
109      +.and.(index(s2,'3.0').ne.1) 
110      +.and.(index(s2,'3.1').ne.1)
111      +.and.(index(s2,'4.0').ne.1)
112      +.and.(index(s2,'5.0').ne.1))then
113          write(*,*) 
114      .        'Version ',s2,' not supported by this version of LHAPDF'
115          stop
116       else  
117        if(lhasilent.eq.0) then
118          write(*,*) '*************************************'
119          write(*,*) '*       LHAPDF Version 5.2.2          *'
120          write(*,*) '*************************************'
121          write(*,*)
122        endif
123       endif
124       id=Ctoken()
125  1    read(1,*) string
126       id=token(string)
127 c      print *,'id = ',id,string
128       if (id.eq.0) then
129          write(*,*) 'File description error:'
130          write(*,*) 'Command not understood: ',string
131          stop
132       endif
133       if (id.eq.1) call descriptionPDF(nset,id)
134 c      print *,'1/2'
135       if (id.eq.2) call initEvolve(nset)
136 c      print *,'2/3'
137       if (id.eq.3) call initAlphasPDF(nset)
138 c      print *,'3/4'
139       if (id.eq.4) call initInputPDF(nset)
140 c      print *,'4/5'
141       if (id.eq.5) call initListPDF(nset)
142 c      print *,'5/6'
143       if (id.eq.6) call initQCDparams(nset)
144 c      print *,'6/7'
145       if (id.ne.7) goto 1
146       close(1)
147 c      print *,'calling InitEvolveCode',nset
148       call InitEvolveCode(nset)
149 *
150       return
151       end
152 *     
153       integer function token(s)
154       implicit none
155       character*16 s
156       integer not,i,Ctoken
157       parameter(not=7)
158       character*16 t(not)
159       data t/'Description:','Evolution:','Alphas:',
160      .                    'Parametrization:','Parameterlist:',
161      .                    'QCDparams:',
162      .                    'End:'/
163       integer count(not)
164       save count
165 *
166       token=0
167       do i=1,not
168          if (s.eq.t(i)) token=i
169       enddo
170       if (token.ne.0) then
171          count(token)=count(token)+1
172          if (count(token).eq.2) then
173             write(*,*) 'File description error:'
174             write(*,*) 'Second definition of entry: ',s
175             stop
176          endif
177       endif
178       return
179 *
180       entry Ctoken()
181       do i=1,not
182          count(i)=0
183       enddo
184       Ctoken=0
185       return
186 *     
187       end
188 c
189       subroutine LHAprint(iprint)
190       implicit none
191       integer lhasilent,iprint
192       common/lhasilent/lhasilent
193       lhasilent=iprint
194 c      print *,'lhasilent',lhasilent
195       return
196       end