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