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 #ifdef __GFORTRAN__
 107   open(unit=1,file=setpath,status='old',action='read')
 108 #else
 109   open(unit=1,file=setpath,status='old')
 110 #endif
 111   read(1,*) s1,s2
 112   if ((    index(s2,'1.0').ne.1) &
 113      .and.(index(s2,'1.1').ne.1) &
 114      .and.(index(s2,'2.0').ne.1) &
 115      .and.(index(s2,'2.1').ne.1) &
 116      .and.(index(s2,'3.0').ne.1) &
 117      .and.(index(s2,'3.1').ne.1) &
 118      .and.(index(s2,'4.0').ne.1) &
 119      .and.(index(s2,'5.0').ne.1) &
 120      .and.(index(s2,'5.3').ne.1) &
 121      .and.(index(s2,'5.4').ne.1) &
 122      .and.(index(s2,'5.5').ne.1)) then
 123      write(*,*) 'Version ',s2,' not supported by this version of LHAPDF'
 124      stop
 125   else
 126      if (lhasilent.eq.0) then
 127         write(*,*) '*************************************'
 128         write(*,*) '*       LHAPDF Version ',lhaversion,'   *'
 129         write(*,*) '*************************************'
 130         write(*,*)
 131      endif
 132   endif
 133   id=Ctoken()
 134 1 read(1,*) string
 135   id=token(string)
 136   ! print *,'id = ',id,string
 137   if (id.eq.0) then
 138      write(*,*) 'File description error:'
 139      write(*,*) 'Command not understood: ',string
 140      stop
 141   endif
 142   if (id.eq.1) call descriptionPDF(nset,id)
 143   ! print *,'1/2'
 144   if (id.eq.2) call initEvolve(nset)
 145   ! print *,'2/3'
 146   if (id.eq.3) call initAlphasPDF(nset)
 147   ! print *,'3/4'
 148   if (id.eq.4) call initInputPDF(nset)
 149   ! print *,'4/5'
 150   if (id.eq.5) call initListPDF(nset)
 151   ! print *,'5/6'
 152   if (id.eq.6) call initQCDparams(nset)
 153   ! print *,'6/7'
 154   if (id.eq.7) call initMinMax(nset)
 155   ! print *,'7/8'
 156   if (id.ne.8) goto 1
 157   close(1)
 158   ! print *,'calling InitEvolveCode',nset
 159   call InitEvolveCode(nset)
 160
 161   ! Initialize the default member 0
 162   call InitPDFM(nset,0)
 163
 164   return
 165   entry getsetpath(setpath)
 166     setpath=inputfile
 167   return
 168
 169 end subroutine InitPDFsetM
 170
 171
 172
 173 integer function token(s)
 174   implicit none
 175   character*16 s
 176   integer not,i,Ctoken
 177   parameter(not=8)
 178   character*16 t(not)
 179   data t/'Description:','Evolution:','Alphas:', 'Parametrization:', &
 180        'Parameterlist:','QCDparams:','MinMax:','End:'/
 181   integer count(not)
 182   save count
 183
 184   token=0
 185   do i=1,not
 186      if (s.eq.t(i)) token=i
 187   enddo
 188   if (token.ne.0) then
 189      count(token)=count(token)+1
 190      if (count(token).eq.2) then
 191         write(*,*) 'File description error:'
 192         write(*,*) 'Second definition of entry: ',s
 193         stop
 194      endif
 195   endif
 196   return
 197
 198   entry Ctoken()
 199   do i=1,not
 200      count(i)=0
 201   enddo
 202   Ctoken=0
 203   return
 204 end function token
 205
 206
 207
 208 subroutine LHAprint(iprint)
 209   implicit none
 210   include 'commonlhacontrol.inc'
 211   integer lhasilent,iprint
 212   common/lhasilent/lhasilent
 213   call commoninit()
 214   lhasilent = iprint
 215   ! If using stream #6, don't silence!
 216   if(iprint.ne.6) lhaparm(19)='SILENT'
 217   return
 218 end subroutine LHAprint
 219
 220
 221
 222 subroutine setPDFpath(pathname)
 223   implicit none
 224   include 'commonlhapdfc.inc'
 225   include 'commonlhacontrol.inc'
 226   include 'parmsetup.inc'
 227   character*(*) pathname
 228   integer j
 229   integer len_trim
 230
 231   call commoninit()
 232   lhaparm(20) = 'LHAPATH'
 233   do j=1,len_trim(lhapath)
 234      lhapath(j:j)=''
 235   enddo
 236   lhapath = pathname
 237   return
 238 end subroutine setPDFpath
 239
 240
 241
 242 subroutine lhaset(lhaparm2,lhavalue2)
 243   implicit none
 244   include 'commonlhacontrol.inc'
 245   character*20 lhaparm2(20)
 246   double precision lhavalue2(20)
 247   integer j
 248
 249   call commoninit()
 250   do j=1,20
 251      lhaparm(j)=lhaparm2(j)
 252      lhavalue(j)=lhavalue2(j)
 253   enddo
 254   return
 255 end subroutine lhaset
 256
 257
 258
 259 subroutine setlhaparm(lparm)
 260   implicit none
 261   include 'commonlhacontrol.inc'
 262   character*(*) lparm
 263   integer nparm
 264
 265   call commoninit()
 266
 267   if(lparm.eq.'EKS98') then
 268      lhaparm(15)='EKS98'
 269   else if(lparm.eq.'EPS08') then
 270      lhaparm(15)='EPS08'
 271   else if(lparm.eq.'15') then
 272      lhaparm(15)=''
 273   else if(lparm.eq.'NOSTAT') then
 274      lhaparm(16)='NOSTAT'
 275   else if (lparm.eq.'16') then
 276      lhaparm(16)=''
 277   else if (lparm.eq.'LHAPDF') then
 278      lhaparm(17)='LHAPDF'
 279   else if (lparm.eq.'17') then
 280      lhaparm(17)=''
 281   else if (lparm.eq.'EXTRAPOLATE') then
 282      lhaparm(18)='EXTRAPOLATE'
 283   else if (lparm.eq.'18') then
 284      lhaparm(18)=''
 285   else if (lparm.eq.'SILENT') then
 286      lhaparm(19)='SILENT'
 287   else if (lparm.eq.'LOWKEY') then
 288      lhaparm(19)='LOWKEY'
 289   else if (lparm.eq.'19') then
 290      lhaparm(19)=''
 291   else
 292      print *,'WARNING from SetLHAPARM - value',lparm,'not recognized!'
 293   endif
 294   return
 295
 296   entry getlhaparm(nparm,lparm)
 297   lparm = lhaparm(nparm)
 298   return
 299 end subroutine setlhaparm
 300
 301
 302
 303 subroutine getdirpath(dirpath)
 304   ! This routine is to determine the directory path for the PDFsets
 305   ! directory. It has a two-fold purpose:
 306   ! 1) to return the value as an argument in dirpath for the native
 307   !    LHAPDF use (ie via initPDFSetByName
 308   ! 2) to fill the value of lhapath in the LHAPDFC common for use in
 309   !    lhaglue.
 310   implicit none
 311   include 'commonlhapdfc.inc'
 312   include 'commonlhacontrol.inc'
 313   include 'parmsetup.inc'
 314   character*(*) dirpath
 315
 316   ! First look in the LHAPDFC array (lhaparm(20), set by setPDFpath).
 317   ! Next, check environmental variable LHAPATH.
 318   ! Finally, use binreloc via getdatapath(...).
 319   ! Will use default path if this all fails.
 320   if (lhaparm(20) /= 'LHAPATH') then
 321      call getenv('LHAPATH', lhapath)
 322      !call get_environment_variable('LHAPATH',lhapath)
 323      if (lhapath.eq.'') then
 324         call getdatapath(dirpath)
 325         lhapath = dirpath
 326      endif
 327   endif
 328   dirpath = lhapath
 329   return
 330 end subroutine getdirpath