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