[u/mrichter/AliRoot.git] / LHAPDF / lhapdf5.5.1 / src / LHpdflib.F

! -*- F90 -*-


! Initialize a PDF set, determining the path to the PDF set directory automatically
! subroutine InitPDFsetByCodes(code1, code2, code3)
!   write(*,*) "Not implemented yet: this will move the 'glue' interface to ", &
!        "LHAPDF proper and use the InitPDFsetByName function to ", &
!        "get the path automatically."
!   return
! end subroutine InitPDFsetByCodes


! Initialize a PDF set, determining the path to the PDF set
! directory automatically
subroutine InitPDFsetByName(setname)
  implicit none
  character setname*(*)
  integer nset
  nset = 1
  call commoninit()
  call InitPDFsetByNameM(nset,setname)
  return
end subroutine InitPDFsetByName

      
! Initialize a PDF set, determining the path to the PDF set
! directory automatically
subroutine InitPDFsetByNameM(nset,setname)
  implicit none
  include 'parmsetup.inc'
  include 'commonlhapdfc.inc'
  include 'commonlhacontrol.inc'
  character setname*(*)
  integer nset
  character*512 dirpath, setpath
  integer len_trim

  ! Initialise common blocks  
  call commoninit()

  ! Find the directory with the PDFsets
  call getdirpath(dirpath)

  ! Now build the path to the PDF set
  setpath = dirpath(:len_trim(dirpath)) // "/" // setname(:len_trim(setname))

  ! Initialize using the detected PDF set
  call InitPDFsetM(nset, setpath(:len_trim(setpath)))
  return
end subroutine InitPDFsetByNameM


subroutine InitPDFset(setpath)
  implicit none
  integer nset
  character setpath*(*)
  nset = 1
  call commoninit()
  call InitPDFsetM(nset,setpath)
  return
end subroutine InitPDFset


subroutine InitLHAPDF()
  call commoninit()
end subroutine InitLHAPDF


subroutine InitPDFsetM(nset,setpath)
  implicit none
  include 'parmsetup.inc'
  include 'commonlhacontrol.inc'
  character setpath*(*)
  character*512 inputfile
  character*64 string
  character*16 s1,s2
  character*10 lhaversion
  integer id,token,Ctoken
  integer lhaonce
  save lhaonce,inputfile
  data lhaonce/0/
  integer lhasilent
  common/lhasilent/lhasilent
  integer nset

  ! Initialise common blocks  
  call commoninit()
  call getlhapdfversion(lhaversion)
  
  inputfile=setpath
  lhasilent = 0
  if (lhaparm(19).eq.'SILENT') then
     lhasilent = 1
  elseif (lhaparm(19).eq.'LOWKEY') then
     if (lhaonce .eq. 0) then
        lhaonce = 1
     else
        lhasilent = 1
     endif
  endif
  
  call setnset(nset)
#ifdef __GFORTRAN__
  open(unit=1,file=setpath,status='old',action='read')
#else
  open(unit=1,file=setpath,status='old')
#endif
  read(1,*) s1,s2
  if ((    index(s2,'1.0').ne.1) &
     .and.(index(s2,'1.1').ne.1) &
     .and.(index(s2,'2.0').ne.1) &
     .and.(index(s2,'2.1').ne.1) &
     .and.(index(s2,'3.0').ne.1) &
     .and.(index(s2,'3.1').ne.1) &
     .and.(index(s2,'4.0').ne.1) &
     .and.(index(s2,'5.0').ne.1) &
     .and.(index(s2,'5.3').ne.1) &
     .and.(index(s2,'5.4').ne.1) & 
     .and.(index(s2,'5.5').ne.1)) then
     write(*,*) 'Version ',s2,' not supported by this version of LHAPDF'
     stop
  else  
     if (lhasilent.eq.0) then
        write(*,*) '*************************************'
        write(*,*) '*       LHAPDF Version ',lhaversion,'   *'
        write(*,*) '*************************************'
        write(*,*)
     endif
  endif
  id=Ctoken()
1 read(1,*) string
  id=token(string)
  ! print *,'id = ',id,string
  if (id.eq.0) then
     write(*,*) 'File description error:'
     write(*,*) 'Command not understood: ',string
     stop
  endif
  if (id.eq.1) call descriptionPDF(nset,id)
  ! print *,'1/2'
  if (id.eq.2) call initEvolve(nset)
  ! print *,'2/3'
  if (id.eq.3) call initAlphasPDF(nset)
  ! print *,'3/4'
  if (id.eq.4) call initInputPDF(nset)
  ! print *,'4/5'
  if (id.eq.5) call initListPDF(nset)
  ! print *,'5/6'
  if (id.eq.6) call initQCDparams(nset)
  ! print *,'6/7'
  if (id.eq.7) call initMinMax(nset)
  ! print *,'7/8'
  if (id.ne.8) goto 1
  close(1)
  ! print *,'calling InitEvolveCode',nset
  call InitEvolveCode(nset)

  ! Initialize the default member 0
  call InitPDFM(nset,0)

  return
  entry getsetpath(setpath)
    setpath=inputfile
  return

end subroutine InitPDFsetM


integer function token(s)
  implicit none
  character*16 s
  integer not,i,Ctoken
  parameter(not=8)
  character*16 t(not)
  data t/'Description:','Evolution:','Alphas:', 'Parametrization:', &
       'Parameterlist:','QCDparams:','MinMax:','End:'/
  integer count(not)
  save count

  token=0
  do i=1,not
     if (s.eq.t(i)) token=i
  enddo
  if (token.ne.0) then
     count(token)=count(token)+1
     if (count(token).eq.2) then
        write(*,*) 'File description error:'
        write(*,*) 'Second definition of entry: ',s
        stop
     endif
  endif
  return

  entry Ctoken()
  do i=1,not
     count(i)=0
  enddo
  Ctoken=0
  return
end function token


subroutine LHAprint(iprint)
  implicit none
  include 'commonlhacontrol.inc'
  integer lhasilent,iprint
  common/lhasilent/lhasilent
  call commoninit()
  lhasilent = iprint
  ! If using stream #6, don't silence!
  if(iprint.ne.6) lhaparm(19)='SILENT'
  return
end subroutine LHAprint


subroutine setPDFpath(pathname)
  implicit none
  include 'commonlhapdfc.inc'
  include 'commonlhacontrol.inc'
  include 'parmsetup.inc'
  character*(*) pathname
  integer j
  integer len_trim

  call commoninit()
  lhaparm(20) = 'LHAPATH'
  do j=1,len_trim(lhapath)
     lhapath(j:j)=''
  enddo
  lhapath = pathname
  return
end subroutine setPDFpath


subroutine lhaset(lhaparm2,lhavalue2)
  implicit none
  include 'commonlhacontrol.inc'
  character*20 lhaparm2(20)
  double precision lhavalue2(20)
  integer j

  call commoninit()
  do j=1,20
     lhaparm(j)=lhaparm2(j)
     lhavalue(j)=lhavalue2(j)
  enddo
  return
end subroutine lhaset


subroutine setlhaparm(lparm)
  implicit none
  include 'commonlhacontrol.inc'
  character*(*) lparm
  integer nparm

  call commoninit()

  if(lparm.eq.'EKS98') then
     lhaparm(15)='EKS98'
  else if(lparm.eq.'EPS08') then
     lhaparm(15)='EPS08'
  else if(lparm.eq.'15') then
     lhaparm(15)=''
  else if(lparm.eq.'NOSTAT') then
     lhaparm(16)='NOSTAT'
  else if (lparm.eq.'16') then
     lhaparm(16)=''
  else if (lparm.eq.'LHAPDF') then
     lhaparm(17)='LHAPDF'
  else if (lparm.eq.'17') then
     lhaparm(17)=''
  else if (lparm.eq.'EXTRAPOLATE') then
     lhaparm(18)='EXTRAPOLATE'
  else if (lparm.eq.'18') then
     lhaparm(18)=''
  else if (lparm.eq.'SILENT') then
     lhaparm(19)='SILENT'
  else if (lparm.eq.'LOWKEY') then
     lhaparm(19)='LOWKEY'
  else if (lparm.eq.'19') then
     lhaparm(19)=''
  else
     print *,'WARNING from SetLHAPARM - value',lparm,'not recognized!'
  endif
  return
  
  entry getlhaparm(nparm,lparm)
  lparm = lhaparm(nparm)
  return
end subroutine setlhaparm


subroutine getdirpath(dirpath)
  ! This routine is to determine the directory path for the PDFsets
  ! directory. It has a two-fold purpose: 
  ! 1) to return the value as an argument in dirpath for the native 
  !    LHAPDF use (ie via initPDFSetByName
  ! 2) to fill the value of lhapath in the LHAPDFC common for use in 
  !    lhaglue.
  implicit none
  include 'commonlhapdfc.inc'
  include 'commonlhacontrol.inc'
  include 'parmsetup.inc'
  character*(*) dirpath
  
  ! First look in the LHAPDFC array (lhaparm(20), set by setPDFpath).
  ! Next, check environmental variable LHAPATH.
  ! Finally, use binreloc via getdatapath(...).
  ! Will use default path if this all fails.
  if (lhaparm(20) /= 'LHAPATH') then
     call getenv('LHAPATH', lhapath)
     !call get_environment_variable('LHAPATH',lhapath)
     if (lhapath.eq.'') then
        call getdatapath(dirpath)
        lhapath = dirpath
     endif
  endif
  dirpath = lhapath 
  return
end subroutine getdirpath
Commit	Line	Data
0caf84a5	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
84ef6b08	38	integer len_trim
0caf84a5	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)
b82f5858	106	#ifdef __GFORTRAN__
e92c2cff	107	open(unit=1,file=setpath,status='old',action='read')
b82f5858	108	#else
	109	open(unit=1,file=setpath,status='old')
	110	#endif
0caf84a5	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
84ef6b08	229	integer len_trim
0caf84a5	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