LHAPDF/lhapdf5.5.1/src/LHpdflib.f

   1 ! -*- F90 -*-
   2
   3
   4 ! Initialize a PDF set, determining the path to the PDF set directory automatically
   5 ! subroutine InitPDFsetByCodes(code1, code2, code3)
   6 !   write(*,*) "Not implemented yet: this will move the 'glue' interface to ", &
   7 !        "LHAPDF proper and use the InitPDFsetByName function to ", &
   8 !        "get the path automatically."
   9 !   return
  10 ! end subroutine InitPDFsetByCodes
  11
  12
  13
  14 ! Initialize a PDF set, determining the path to the PDF set
  15 ! directory automatically
  16 subroutine InitPDFsetByName(setname)
  17   implicit none
  18   character setname*(*)
  19   integer nset
  20   nset = 1
  21   call commoninit()
  22   call InitPDFsetByNameM(nset,setname)
  23   return
  24 end subroutine InitPDFsetByName
  25
  26
  27
  28 ! Initialize a PDF set, determining the path to the PDF set
  29 ! directory automatically
  30 subroutine InitPDFsetByNameM(nset,setname)
  31   implicit none
  32   include 'parmsetup.inc'
  33   include 'commonlhapdfc.inc'
  34   include 'commonlhacontrol.inc'
  35   character setname*(*)
  36   integer nset
  37   character*512 dirpath, setpath
  38   integer len_trim
  39
  40   ! Initialise common blocks
  41   call commoninit()
  42
  43   ! Find the directory with the PDFsets
  44   call getdirpath(dirpath)
  45
  46   ! Now build the path to the PDF set
  47   setpath = dirpath(:len_trim(dirpath)) // "/" // setname(:len_trim(setname))
  48
  49   ! Initialize using the detected PDF set
  50   call InitPDFsetM(nset, setpath(:len_trim(setpath)))
  51   return
  52 end subroutine InitPDFsetByNameM
  53
  54
  55
  56 subroutine InitPDFset(setpath)
  57   implicit none
  58   integer nset
  59   character setpath*(*)
  60   nset = 1
  61   call commoninit()
  62   call InitPDFsetM(nset,setpath)
  63   return
  64 end subroutine InitPDFset
  65
  66
  67 subroutine InitLHAPDF()
  68   call commoninit()
  69 end subroutine InitLHAPDF
  70
  71
  72 subroutine InitPDFsetM(nset,setpath)
  73   implicit none
  74   include 'parmsetup.inc'
  75   include 'commonlhacontrol.inc'
  76   character setpath*(*)
  77   character*512 inputfile
  78   character*64 string
  79   character*16 s1,s2
  80   character*10 lhaversion
  81   integer id,token,Ctoken
  82   integer lhaonce
  83   save lhaonce,inputfile
  84   data lhaonce/0/
  85   integer lhasilent
  86   common/lhasilent/lhasilent
  87   integer nset
  88
  89   ! Initialise common blocks
  90   call commoninit()
  91   call getlhapdfversion(lhaversion)
  92
  93   inputfile=setpath
  94   lhasilent = 0
  95   if (lhaparm(19).eq.'SILENT') then
  96      lhasilent = 1
  97   elseif (lhaparm(19).eq.'LOWKEY') then
  98      if (lhaonce .eq. 0) then
  99         lhaonce = 1
 100      else
 101         lhasilent = 1
 102      endif
 103   endif
 104
 105   call setnset(nset)
 106   open(unit=1,file=setpath,status='old',action='read')
 107   read(1,*) s1,s2
 108   if ((    index(s2,'1.0').ne.1) &
 109      .and.(index(s2,'1.1').ne.1) &
 110      .and.(index(s2,'2.0').ne.1) &
 111      .and.(index(s2,'2.1').ne.1) &
 112      .and.(index(s2,'3.0').ne.1) &
 113      .and.(index(s2,'3.1').ne.1) &
 114      .and.(index(s2,'4.0').ne.1) &
 115      .and.(index(s2,'5.0').ne.1) &
 116      .and.(index(s2,'5.3').ne.1) &
 117      .and.(index(s2,'5.4').ne.1) &
 118      .and.(index(s2,'5.5').ne.1)) then
 119      write(*,*) 'Version ',s2,' not supported by this version of LHAPDF'
 120      stop
 121   else
 122      if (lhasilent.eq.0) then
 123         write(*,*) '*************************************'
 124         write(*,*) '*       LHAPDF Version ',lhaversion,'   *'
 125         write(*,*) '*************************************'
 126         write(*,*)
 127      endif
 128   endif
 129   id=Ctoken()
 130 1 read(1,*) string
 131   id=token(string)
 132   ! print *,'id = ',id,string
 133   if (id.eq.0) then
 134      write(*,*) 'File description error:'
 135      write(*,*) 'Command not understood: ',string
 136      stop
 137   endif
 138   if (id.eq.1) call descriptionPDF(nset,id)
 139   ! print *,'1/2'
 140   if (id.eq.2) call initEvolve(nset)
 141   ! print *,'2/3'
 142   if (id.eq.3) call initAlphasPDF(nset)
 143   ! print *,'3/4'
 144   if (id.eq.4) call initInputPDF(nset)
 145   ! print *,'4/5'
 146   if (id.eq.5) call initListPDF(nset)
 147   ! print *,'5/6'
 148   if (id.eq.6) call initQCDparams(nset)
 149   ! print *,'6/7'
 150   if (id.eq.7) call initMinMax(nset)
 151   ! print *,'7/8'
 152   if (id.ne.8) goto 1
 153   close(1)
 154   ! print *,'calling InitEvolveCode',nset
 155   call InitEvolveCode(nset)
 156
 157   ! Initialize the default member 0
 158   call InitPDFM(nset,0)
 159
 160   return
 161   entry getsetpath(setpath)
 162     setpath=inputfile
 163   return
 164
 165 end subroutine InitPDFsetM
 166
 167
 168
 169 integer function token(s)
 170   implicit none
 171   character*16 s
 172   integer not,i,Ctoken
 173   parameter(not=8)
 174   character*16 t(not)
 175   data t/'Description:','Evolution:','Alphas:', 'Parametrization:', &
 176        'Parameterlist:','QCDparams:','MinMax:','End:'/
 177   integer count(not)
 178   save count
 179
 180   token=0
 181   do i=1,not
 182      if (s.eq.t(i)) token=i
 183   enddo
 184   if (token.ne.0) then
 185      count(token)=count(token)+1
 186      if (count(token).eq.2) then
 187         write(*,*) 'File description error:'
 188         write(*,*) 'Second definition of entry: ',s
 189         stop
 190      endif
 191   endif
 192   return
 193
 194   entry Ctoken()
 195   do i=1,not
 196      count(i)=0
 197   enddo
 198   Ctoken=0
 199   return
 200 end function token
 201
 202
 203
 204 subroutine LHAprint(iprint)
 205   implicit none
 206   include 'commonlhacontrol.inc'
 207   integer lhasilent,iprint
 208   common/lhasilent/lhasilent
 209   call commoninit()
 210   lhasilent = iprint
 211   ! If using stream #6, don't silence!
 212   if(iprint.ne.6) lhaparm(19)='SILENT'
 213   return
 214 end subroutine LHAprint
 215
 216
 217
 218 subroutine setPDFpath(pathname)
 219   implicit none
 220   include 'commonlhapdfc.inc'
 221   include 'commonlhacontrol.inc'
 222   include 'parmsetup.inc'
 223   character*(*) pathname
 224   integer j
 225   integer len_trim
 226
 227   call commoninit()
 228   lhaparm(20) = 'LHAPATH'
 229   do j=1,len_trim(lhapath)
 230      lhapath(j:j)=''
 231   enddo
 232   lhapath = pathname
 233   return
 234 end subroutine setPDFpath
 235
 236
 237
 238 subroutine lhaset(lhaparm2,lhavalue2)
 239   implicit none
 240   include 'commonlhacontrol.inc'
 241   character*20 lhaparm2(20)
 242   double precision lhavalue2(20)
 243   integer j
 244
 245   call commoninit()
 246   do j=1,20
 247      lhaparm(j)=lhaparm2(j)
 248      lhavalue(j)=lhavalue2(j)
 249   enddo
 250   return
 251 end subroutine lhaset
 252
 253
 254
 255 subroutine setlhaparm(lparm)
 256   implicit none
 257   include 'commonlhacontrol.inc'
 258   character*(*) lparm
 259   integer nparm
 260
 261   call commoninit()
 262
 263   if(lparm.eq.'EKS98') then
 264      lhaparm(15)='EKS98'
 265   else if(lparm.eq.'EPS08') then
 266      lhaparm(15)='EPS08'
 267   else if(lparm.eq.'15') then
 268      lhaparm(15)=''
 269   else if(lparm.eq.'NOSTAT') then
 270      lhaparm(16)='NOSTAT'
 271   else if (lparm.eq.'16') then
 272      lhaparm(16)=''
 273   else if (lparm.eq.'LHAPDF') then
 274      lhaparm(17)='LHAPDF'
 275   else if (lparm.eq.'17') then
 276      lhaparm(17)=''
 277   else if (lparm.eq.'EXTRAPOLATE') then
 278      lhaparm(18)='EXTRAPOLATE'
 279   else if (lparm.eq.'18') then
 280      lhaparm(18)=''
 281   else if (lparm.eq.'SILENT') then
 282      lhaparm(19)='SILENT'
 283   else if (lparm.eq.'LOWKEY') then
 284      lhaparm(19)='LOWKEY'
 285   else if (lparm.eq.'19') then
 286      lhaparm(19)=''
 287   else
 288      print *,'WARNING from SetLHAPARM - value',lparm,'not recognized!'
 289   endif
 290   return
 291
 292   entry getlhaparm(nparm,lparm)
 293   lparm = lhaparm(nparm)
 294   return
 295 end subroutine setlhaparm
 296
 297
 298
 299 subroutine getdirpath(dirpath)
 300   ! This routine is to determine the directory path for the PDFsets
 301   ! directory. It has a two-fold purpose:
 302   ! 1) to return the value as an argument in dirpath for the native
 303   !    LHAPDF use (ie via initPDFSetByName
 304   ! 2) to fill the value of lhapath in the LHAPDFC common for use in
 305   !    lhaglue.
 306   implicit none
 307   include 'commonlhapdfc.inc'
 308   include 'commonlhacontrol.inc'
 309   include 'parmsetup.inc'
 310   character*(*) dirpath
 311
 312   ! First look in the LHAPDFC array (lhaparm(20), set by setPDFpath).
 313   ! Next, check environmental variable LHAPATH.
 314   ! Finally, use binreloc via getdatapath(...).
 315   ! Will use default path if this all fails.
 316   if (lhaparm(20) /= 'LHAPATH') then
 317      call getenv('LHAPATH', lhapath)
 318      !call get_environment_variable('LHAPATH',lhapath)
 319      if (lhapath.eq.'') then
 320         call getdatapath(dirpath)
 321         lhapath = dirpath
 322      endif
 323   endif
 324   dirpath = lhapath
 325   return
 326 end subroutine getdirpath