Source module last modified on Tue, 2 May 2006, 0:54;
HTML image of Fortran source automatically generated by
for2html on Mon, 29 May 2006, 15:06.
#--------------------------------------------------
#//////////////////////////////////////////////////////////////////////
#////
#//// R E S T R A X 4.8.0
#////
#//// Some subroutines for I/O operations in EXCI:
#//// Should be linked only with EXCI library, not with RESTRAX !
#////
#//////////////////////////////////////////////////////////////////////
#--------------------------------------------------
real*4 FUNCTION EXCIVERSION()
# Return EXCI version number
#--------------------------------------------------
implicit none
INCLUDE 'const.inc'
INCLUDE 'exci.inc'
EXCIVERSION=exci_number
end
#--------------------------------------------------
SUBROUTINE SETEXCIDEFAULT
# Set default values to common EXCI variables
#--------------------------------------------------
implicit none
INCLUDE 'const.inc'
INCLUDE 'inout.inc'
INCLUDE 'exci.inc'
integer*4 i,mrespar
parameter (mrespar=mpar-2)
data phontitle,phonname / 'default', 'exc.par'/
data excread /1/
data nbr,nterm /0,2/
data wen/6*1.d0/
data parname / 'Intensity', 'Background',mrespar* ' '/
data param /1.d0,10.d0,mrespar*0.d0/
data fixparam /mpar*1/ ! all free by default !!
phontitle= 'default' ! identification string
phonname= 'exc.par' ! default name of input file
# read input file: never (0), when necessary (1), always (2)
excread=1
nbr=0 ! number of dispersion branches
nterm=nbr+2 ! number of free parameters
do i=1,6 ! default energy widths in meV
wen(i)=1.d0
enddo
# Default names of free parameters:
parname(1)= 'Intensity'
parname(2)= 'Background'
do i=3,mpar
parname(i)= ' '
enddo
# Default FIXED tags (1 .. free, 0 .. fixed)
do i=1,mpar
fixparam(i)=1
enddo
# write(*,*) 'SETEXCIDEFAULT(): ',trim(phonname)
end
#--------------------------------------------------
SUBROUTINE OPENEXCIFILE(iunit,fn,ires)
# Open file for input - to be linked with EXCI module
# if success, return IRES=0
#--------------------------------------------------
implicit none
INCLUDE 'const.inc'
# INCLUDE 'inout.inc'
integer*4 iunit,ires,is,il
character*(*) fn
real*8 excar(10)
integer*4 excn,excn1
common /exctest/excn,excn1,excar
data excn,excn1/6,7/
data excar/1.d0,2.d0,3.d0,4.d0,5.d0,6.d0,7.d0,8.d0,9.d0,10.d0/
ires=-1
call GETBOUNDS(fn,is,il)
open(unit=iunit,file=fn(is:is+il-1),status= 'OLD',err=20,
& iostat=ires)
# WRITE(*,*) 'param. file open: ',IUNIT,FN(IS:IS+IL-1)
20 return
end
#--------------------------------------------------
SUBROUTINE CLOSEEXCIFILE(iunit)
# Close input file - to be linked with EXCI module
#--------------------------------------------------
implicit none
INCLUDE 'const.inc'
integer*4 iunit
# WRITE(*,*) 'param. file closed: ',IUNIT
close(unit=iunit)
end
# ---------------------------------------------------
SUBROUTINE GETBOUNDS(line,istart,ilen)
# get position of string by stripping off the surrounding spaces
# ---------------------------------------------------
implicit none
character*(*) line
integer*4 l,i,istart,ilen
l=len(line)
istart=1
if (l.eq.0) then
ilen=0
return
endif
do while (l.gt.0.and.(line(l:l).eq. ' '.or.line(l:l).eq.char(0)))
l=l-1
enddo
i=1
do while (i.lt.l.and.(line(i:i).eq. ' '.or.line(i:i).eq.char(0)))
i=i+1
enddo
if (i.gt.l) then
ilen=0
else
istart=i
ilen=l-i+1
endif
end