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