src/exci/exci_io.f

Fortran project EXCI, source module src/exci/exci_io.f.

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