c...	file spurion_bits.f

C**********************************************************

      subroutine title(a,atitle,len)
      implicit none
c...    passed variables
      integer a(3),len
      character*10 atitle

c...    local variables
      integer la(3), i
      logical neg,ten
      character*3 atxt(3)

 50   format(a1,3i1,a1)
 51   format(a1,i2,1x,i2,1x,i2,a1)
 52   format(a1,a,a1,a,a1,a,a1)

      call checkneg(a,neg)
      call checkten(a,ten)

      if (neg.and.ten) then
         do i=1,3
            if (a(i).le.-10) then
               write(atxt(i),'(i3)') a(i)
               la(i)=3
            else if ((a(i).lt.0).or.(a(i).ge.10)) then
               write(atxt(i),'(i2)') a(i)
               la(i)=2
            else
               write(atxt(i),'(i1)') a(i)
               la(i)=1
            endif
         enddo
         if (la(1)+la(2)+la(3).gt.8) then
           write(atitle,'(a,a,a)') atxt(1)(1:la(1)),
     &      atxt(2)(1:la(2)),atxt(3)(1:la(3))
           len=la(1)+la(2)+la(3)
         else if (la(1)+la(2)+la(3).gt.6) then
           write(atitle,'(a,a1,a,a1,a)') atxt(1)(1:la(1)),',',
     &      atxt(2)(1:la(2)),',',atxt(3)(1:la(3))
           len=la(1)+la(2)+la(3)+2
         else
           write(atitle,52) '(',atxt(1)(1:la(1)),',',
     &      atxt(2)(1:la(2)),',',atxt(3)(1:la(3)),')'
           len=la(1)+la(2)+la(3)+4
         endif

      else if ((neg).neqv.(ten)) then
         write(atitle,51) '(',a(1),a(2),a(3),')'
         len=10
      else
         write(atitle,50) '(',a(1),a(2),a(3),')'
         len=5
      endif

      return
      end


C**********************************************************

      subroutine hkl_int(hh, kk, ll, a_hkl)
      implicit none
c...    passed variables
      integer hh, kk, ll
      character*13 a_hkl

c...    local variables

 10   format ( '(', i3, ',', i3, ',', i3, ')' )
      write (a_hkl, 10)  hh, kk, ll

      return
      end

C**********************************************************

      subroutine hkl_float(q1, q2, bmatuv_inv,  a_hkl)
      implicit none
c...    passed variables
      real q1, q2
      real bmatuv_inv(3,3)
c      integer hh, kk, ll, len
      character*19 a_hkl

c...    local variables
      real qvec(3), h(3)
      integer i
      
      qvec(1) = q1
      qvec(2) = q2
      qvec(3) = 0.0
      
      call mvmult(bmatuv_inv,qvec,3,3,h)

 10   format ( '(', f5.1, ',', f5.1, ',', f5.1, ')' )
      write (a_hkl, 10) (h(i), i= 1, 3)

      return
      end


C******************************************************

      subroutine checkneg(a,neg)

      implicit none
c...    passed variables
      integer a(3)
      logical neg

c...    local variables
      integer i
      
      neg=.false.
      do i=1,3
         if (a(i).lt.0) neg=.true.
      enddo
      return
      end

C******************************************************

      subroutine checkten(a,ten)

      implicit none
c...    passed variables
      integer a(3)
      logical ten
      
c...    local variables
      integer i
      
      ten=.false.
      do i=1,3
         if (abs(a(i)).ge.10) ten=.true.
      enddo
      return
      end

C*******************************************************

      subroutine calcspurious(ki,kf, qspur,espur)
       
      implicit none
      include 'arraysize.inc'
      
c...    passed variables
      real ki(2),kf(2)
      real qspur(2,n_spur_max,n_spur_max)
      real espur(n_spur_max,n_spur_max)

c...    local variables
      integer i,j,k

      do i=1,n_spur_max
        do j=1,n_spur_max
          do k=1,2
            qspur(k,i,j)=float(i)*ki(k)-float(j)*kf(k)
C            write(*,*) k,i,j,qspur(k,i,j)
          enddo
          espur(i,j)= k2_to_E *(float(i**2)*(ki(1)**2.0+ki(2)**2.0)
     &      -float(j**2)*(kf(1)**2.0+kf(2)**2.0))
c02Apr          espur(i,j)=2.072*(float(i**2)*(ki(1)**2.0+ki(2)**2.0)
c02Apr     &      -float(j**2)*(kf(1)**2.0+kf(2)**2.0))
        enddo
      enddo

      return
      end

C*******************************************************

      subroutine load_constants()
       
      implicit none
      include 'arraysize.inc'
      
c...  local variables
      double precision temp
      
      temp = (const_hbar * const_c) **2 / (2.0d0 * const_Mnc2)
c     !! convert from eV- Angstroms^2 to meV- Angstroms^2
      k2_to_E  = sngl(temp* 1.0d+3)
      
      write (*,*) 'load_conts: k2_to_E=', k2_to_E, '  meV- Angstroms^2'

      return
      end

C***********************************************************

      subroutine autoscale(x,y)

      implicit none
      include 'spur_layout.inc'
      
c...    passed variables
      real x,y
      
      if (x.lt.xmin) xmin=1.2*x
      if (x.gt.xmax) xmax=1.2*x
      if (y.lt.ymin) ymin=1.2*y
      if (y.gt.ymax) ymax=1.2*y
      
      return
      end

C*************************************************************

      subroutine square()

      implicit none
      include 'spur_layout.inc'
      
c...    passed variables

      if ((xmax-xmin).gt.2.0*(ymax-ymin)) then
        ymax=2.0*ymax
        ymin=2.0*ymin
      endif
      if ((ymax-ymin).gt.2.0*(xmax-xmin)) then
        xmax=2.0*xmax
        xmin=2.0*xmin
      endif

      return
      end

C**************************************************************

      subroutine arrows(i,j,ki,kf)

       implicit none

c...    passed variables
      integer i,j,k
      real ki(2),kf(2)

c...    local variables
      real temp1, temp2, temp3, temp4
      
C  Provided i does not equal one (primary ki) then plot a new
C  ki beyond the last showing the spurious process.

C  Plot the ki's (although not strictly a sum of wavevectors it
C  may be easier to understand this way.

      if (i.ne.1) then
        do k=2,i
	  temp1 = float(k-1)*ki(1)
	  temp2 = float(k-1)*ki(2)
	  temp3 = float(k)*ki(1)
	  temp4 = float(k)*ki(2)
cDebug	  write (*,*) 'arrow: ->i ', k, temp1, temp2, temp3, temp4
          call pgarro(temp1, temp2, temp3, temp4)
c01Nov          call pgarro(float(k-1)*ki(1),float(k-1)*ki(2),
c01Nov     &         float(k)*ki(1),float(k)*ki(2))
        enddo
      endif
C  Plot the -j*kf added on to the final i*ki
C  No overlap possibility for multiple kf's.

      do k=1,j
	temp1 = float(i)*ki(1)-float(k-1)*kf(1)
	temp2 = float(i)*ki(2)-float(k-1)*kf(2)
	temp3 = float(i)*ki(1)-float(k)*kf(1)
	temp4 = float(i)*ki(2)-float(k)*kf(2)
cDebug	 write (*,*) 'arrow: ->j ', k, temp1, temp2, temp3, temp4
        call pgarro(temp1, temp2, temp3, temp4)
c01Nov        call pgarro(float(i)*ki(1)-float(k-1)*kf(1),
c01Nov     &  float(i)*ki(2)-float(k-1)*kf(2),
c01Nov     &  float(i)*ki(1)-float(k)*kf(1),
c01Nov     &  float(i)*ki(2)-float(k)*kf(2))
      enddo

      return
      end

C----------------------------------------------------------

      subroutine bit(spurhist,power,value,on)

C subroutine for checking and changing the bits of spurhist
C
C spurhist: 8-bit integer
C power: the bit number to be checked/changed
C value: new value of that bit
C on: make that bit =value, 0 return the value
CTR on: make that bit 1, 0 return the value
C bits: reduction of spurhist to bits, runs from 1 to 8 (power+1)
C work: a working value of spurhist

      implicit none
c...	passed variables
      integer spurhist,power,value,on

c...	local variables
      integer bits(8),i
      integer work

      work=spurhist
C      write(*,'(a,i3)') 'starting spurhist= ',work
      do i=8,1,-1
         bits(i)=work/2**(i-1)
         work=work-bits(i)*2**(i-1)
C         write(*,'(a,i1,a,i1)') 'bits(',i-1,') = ',bits(i)
      enddo


      if (on.eq.1) then
C         if (bits(power+1).eq.0) then 
         bits(power+1)=mod(value,2)   !! even-> zero. odd-> 1
cTR         bits(power+1)=1
C            write(*,*) 'setting to 1 bits(power)=',bits(power+1)
C         else
C            bits(power+1)=0
C            write(*,*) 'setting to 0 bits(power)=',bits(power+1)
C         endif
         work=0
         do i=1,8
            work=work+bits(i)*2**(i-1)
         enddo
         spurhist=work
      else
        value=bits(power+1)
      endif

cTR      value=bits(power+1)
      return
      end

C----------------------------------------------------------

      logical function bit_on(longhist,power)

C function that returns true if a bit at position power is on/true (1).
c Returns false if it is off/false/0. 
c
C spurhist: 24-bit integer
C power: the bit number to be checked/changed
C value: new value of that bit
C bits: reduction of spurhist to bits, runs from 1 to maxbit=24 (power)
C work: a working value of spurhist

      implicit none
c...	passed variables
      integer*4 longhist
      integer power

c...	local variables
      integer maxbit
      parameter (maxbit = 24)		!! Used to be 8
      integer bits(maxbit),i
      integer*4 work

      if      (power .lt. 1) then
        write (*,*) 'bit_on: Error, selected neg or zero bit: ', power 
	bit_on = .false.
      else if (power .gt. maxbit) then
        write (*,*) 'bit_on: Error, selected bit > ', maxbit, ':', power 
	bit_on = .false.
      else

        work= longhist
        do i=maxbit,1,-1
           bits(i)=work/2**(i-1)
           work=work-bits(i)*2**(i-1)
        enddo

        bit_on = (bits(power).eq.1)

      endif

      return
      end

C----------------------------------------------------------

      subroutine which_bit(longhist,power,value)

C subroutine returns the position of the first bit in lonhist with value value.
C
C longhist: 24-bit integer
C power: the bit number to be checked/changed
C value: new value of that bit
C bits: reduction of longhist to bits, runs from 1 to maxbit=24 (power)
C work: a working value of longhist

      implicit none
c...	passed variables
      integer*4 longhist
      integer   power,value

c...	local variables
      integer maxbit, nvalue
      parameter (maxbit = 24)		!! Used to be 8
      integer bits(maxbit),i
      integer*4 work



        nvalue = 0
        work= longhist
        do i =maxbit,1,-1
           bits(i)=work/2**(i-1)
	   if (bits(i) .eq. value) then
	     nvalue = nvalue + 1
	   endif
           work=work-bits(i)*2**(i-1)
        enddo

        power = 0
        do i =1, maxbit
	   if (bits(i) .eq. value) then
	     power = i
	     goto 555
	   endif
        enddo

 555    continue
 
       if      (power .lt. 1) then
         write (*,*) 'which_bit: Warning, no bits with value =', value
       else if (nvalue .gt. 1) then
         write (*,*) 'which_bit: Warning: more than one bit', 
     &		' with value=', value
         write (*,*) 'which_bit:   Only returning position of first bit'
       endif


      return
      end

C----------------------------------------------------------

      subroutine set_bit(longhist,power,value)

C subroutine for changing the bits of spurhist
C
C spurhist: 24-bit integer
C power: the bit number to be checked/changed
C value: new value of that bit
CTR on: make that bit 1, 0 return the value
C bits: reduction of spurhist to bits, runs from 1 to maxbit=24 (power)
C work: a working value of spurhist

      implicit none
c...	passed variables
      integer*4 longhist
      integer   power,value

c...	local variables
      integer maxbit
      parameter (maxbit = 24)		!! Used to be 8
      integer bits(maxbit),i
      integer*4 work

      if      (power .lt. 1) then
        write (*,*) 'set_bit: Error, selected neg or zero bit: ', power 
      else if (power .gt. maxbit) then
        write (*,*) 'set_bit: Error, selected bit > ', maxbit, 
     &	':', power 
      else
        work= longhist
        do i =maxbit,1,-1
           bits(i)=work/2**(i-1)
           work=work-bits(i)*2**(i-1)
        enddo


         bits(power)=mod(value,2)   !! even-> zero. odd-> 1
         work=0
         do i = 1, maxbit
            work=work+bits(i)*2**(i-1)
         enddo
         longhist=work

      endif

      return
      end

C----------------------------------------------------------

      subroutine set_warning(power,value, wstring)

C subroutine for changing the bits of warn_options
C
c If value = 1, put wstring sub-string in warnstring in the right place.
c If value = 0, put null sub string in warnstring

      implicit none
      include 'spur_warn.inc'

c..	functions
      integer ilen
            
c...	passed variables
      integer   power,value
      character*(*) wstring

c...	local variables
cUnused      integer i
      integer i1, i2, len
      
      call set_bit(warn_options,power,value)
      i1 = (power-1)*warn_nchar + 1
      i2 = (power)*warn_nchar
      if (value .eq. 0) then
        warnstring(i1:i2) = ' '	! null sub-string. No warning 
c	do i = i1, i2
c          warnstring(i:i) = ' '	! null sub-string. No warning 
c	enddo
      else
        len = ilen(wstring)
        warnstring(i1:i2) = wstring(1:min(len,warn_nchar)) 
      endif

      return
      end

C----------------------------------------------------------

      subroutine toggle_bit(longhist,power,value)

C subroutine for toggling the bits of spurhist
C
C spurhist: 24-bit integer
C power: the bit number to be checked/changed
C value: new value of that bit (returned)
C bits: reduction of spurhist to bits, runs from 1 to maxbit=24 (power)
C work: a working value of spurhist

      implicit none
c...	passed variables
      integer*4 longhist
      integer   power,value

c...	local variables
      integer maxbit
      parameter (maxbit = 24)		!! Used to be 8
      integer bits(maxbit),i
      integer*4 work

      if      (power .lt. 1) then
        write (*,*) 'toggle_bit: Error, selected neg or zero bit: ',
     &	 power 
      else if (power .gt. maxbit) then
        write (*,*) 'toggle_bit: Error, selected bit > ', maxbit, 
     &		':', power 
      else
        work= longhist
        do i = maxbit, 1,-1
           bits(i)=work/2**(i-1)
           work=work-bits(i)*2**(i-1)
        enddo


c	toggle the value at bit power
         bits(power)=mod(bits(power)+1,2)   !! even-> zero. odd-> 1
	 value = bits(power)			!! return the new value
         work=0
         do i = 1, maxbit
            work=work+bits(i)*2**(i-1)
         enddo
         longhist=work
	 
      endif
      
      return
      end

c==================================================================
      subroutine cmd_filenames(version_stamp, struct, 
     &      whichqbuf, whichlpi, firsttime)
c... Get filename base (no extension)
c... IF LPI file does not exist, return struct=.false.

      implicit none      
      include 'io_files.inc'

c...	passed variables
      character*(*)  version_stamp
      logical struct, firsttime
      character*1 whichqbuf, whichlpi

c...	functions
      integer	ilen
      character*80 oldbase

      oldbase = file_base
 100  continue 
      
      if (.not. firsttime) then
       write (*,*) ' Input file names will be of the form '
       write (*,*) '	   <base>.buf 	(Q buffer from experiment)'
       write (*,*) '	or <base>.bt# 	(ICP triple axis data file)'
       write (*,*) '	<base>.lpi 	(Lazy Pulverix input file, optional)'
c       write (*,*)
       write (*,*) ' Output file names will be of the form '
       write (*,*) '	<base>.struct 	(Structure information)'
       write (*,*) '	<base>.spur 	(Spurion information)'
       write (*,*) '	<base>.log 	(Log file, in case program fails)'
       write (*,*) '	<base>.debug 	(Temporary debugging info)'
c       write (*,*)
       write (*,*) ' Optional output file names will be of the form '
       write (*,*) '	<base>.bufout 	(Optional output Q buffer ', 
     &				'from this program)'
       write (*,*) '	<base>.lpiout 	(Optional output Lazy-Pulverix', 
     &				' input file)'
       write (*,*) '	<base>.icp 	', 
     &      '(Optional ICP dry run, contains spect angles)'
       write (*,*) '	<base>_bw.ps	', 
     &		'(Optional B&W postscript file, lattice plot)'
       write (*,*) '	<base>_cl.ps	', 
     &		'(Optional color postscript file, lattice plot)'
       write (*,*) '	<base>_scbw.ps	', 
     &      '(Optional B&W postscript file, scan plot)'
       write (*,*) '	<base>_sccl.ps	', 
     &		'(Optional color postscript file, scan plot)'
       write (*,*)
      endif		!! .not. firsttime
      
c---------------------------------------------------------------------
c...	q-buffer file or data file
 199  continue
      if (firsttime) then
      	whichqbuf = 'd'
      else
 200   write(*,'(a)') 'What sort of q-buf info do you want to input?'
       write(*,'(a)') '	d:   default values set by program'
       write(*,'(a)') '	c:   current values in program'
       write(*,'(a)') '	b:   q buffer file 		<base>.buf' 
       write(*,'(a)') '	0-9: ICP triple axis data file 	<base>.bt#' 
       write(*,'(a)') '	h:   HELP!!' 
c       write(*,'(a)') '	q:   quit this dialog (no changes made)' 
c       write(*,'(a)') '	#: ICP triple axis data file 	<base>.bt#' 
       write (*,'(A,$)') 'Enter q-buf choice (d,c,b,0-9, h): '
c       write (*,'(A,$)') 'Enter q-buf choice (d,c,b,0-9, h,q): '
       read (*,'(A,$)',err=200) whichqbuf
       call lower(whichqbuf)

c      if (whichqbuf .eq. 'q') goto 999
      if (whichqbuf .eq. 'h') then
	   call help('', 'spurion', 
     &	   'spurion MainMenu dm_DefaultMenu')
        goto 100
      endif 

       if (.not. ((whichqbuf .eq. 'd') .or. (whichqbuf .eq. 'c') 
     &      .or. (whichqbuf .eq. 'b') )) then
         if ( (ichar(whichqbuf) .lt. ichar('0')) .or. 
     &		(ichar(whichqbuf) .gt. ichar('9')) ) then
     	   goto 200
	 endif
      endif

       if (.not. ((whichqbuf .eq. 'd') .or. (whichqbuf .eq. 'c') )) then
 202    write(*,'(a,a,$)') 'Input q-buf or data filename base', 
     &		' (no extension): '
        read(*,'(A)',err=202) file_base
       endif
      endif		!! .not. firsttime

      if (whichqbuf .eq. 'd') then
        file_base = 'SPUR_DEFAULT'
        file_bufin = 'SPUR_DEFAULT'//ext_bufin
      else if (whichqbuf .eq. 'c') then
ccc        file_bufin = 'SPUR_CURRENT'//ext_bufin	! Don't change value
      else if (whichqbuf .eq. 'b') then
        file_bufin = file_base(1:ilen(file_base))//ext_bufin
      else
        file_bufin = file_base(1:ilen(file_base))//'.bt'//whichqbuf
      endif


c...	Close the previous files
      if (file_base(1:ilen(file_base)) .ne. 
     &      oldbase(1:ilen(oldbase)) ) then
        if (.not. firsttime) then

          close(unit=unitstruct)
          write(*,*) 'Closed: ', 
     &	  'previous Spurion output structure file: ',
     &		file_structout(1:ilen(file_structout))

          close(unit=unitspur)
          write(*,*) 'Closed: ', 
     &	  'Previous Spurion output spurion file: ',
     &		file_spurout(1:ilen(file_spurout))

          close(unit=unitdebug)
          write(*,*) 'Closed: ', 
     &	  'previous Spurion output debugging file: ',
     &		file_debug(1:ilen(file_debug))

          close(unit=unitdebug)
          write(*,*) 'Closed: ', 'previous Spurion output log file: ',
     &		file_log(1:ilen(file_log))

	endif
      endif

c---------------------------------------------------------------------
c...	LPI file
 211  continue
      if (firsttime) then
      	whichlpi = 'd'
      else
 201   write(*,*) 'What sort of lazy-pulverix info ', 
     &		 'do you want to input?'
       write(*,*) '	d: default values set by program'
       write(*,*) '	c: current values in program'
       write(*,*) '	n: none (only locations marked, no intensities)'
       write(*,*) '	b: lazy-pulverix input file   <base>.lpi' 
       write(*,*) '	l: lazy-pulverix input file   ', 
     &	      '<differentname>.lpi' 
       write(*,*) '     h:   HELP!!' 
c       write(*,'(a)') '	q:   quit this dialog (no changes made to LPI)' 

       write (*,'(A, $)') 'Enter lazy-pulverix choice (d,c,n,b,l, h): '
       read(*,'(A, $)',err=201) whichlpi

       call lower(whichlpi)

c      if (whichqbuf .eq. 'q') goto 999
      if (whichqbuf .eq. 'h') then
	   call help('', 'spurion', 
     &	   'spurion MainMenu dm_DefaultMenus')
        goto 100
      endif 

       if (.not. ((whichlpi .eq. 'd') .or. (whichlpi .eq. 'c') 
     &      .or. (whichlpi .eq. 'n') .or. (whichlpi .eq. 'b') 
     &	    .or. (whichlpi .eq. 'l'))) then
     	goto 201
       endif
      endif		!! .not. firsttime

		
      if (whichlpi .eq. 'd') then
        file_lpi = 'SPUR_DEFAULT'//ext_lpi
      else if (whichlpi .eq. 'c') then
ccc        file_lpi = 'SPUR_CURRENT'//ext_lpi		! Don't change value
      else if (whichlpi .eq. 'n') then
        struct = .false.
        file_lpi = 'SPUR_NONE'//ext_lpi
      else if (whichlpi .eq. 'b') then
        file_lpi = file_base(1:ilen(file_base))//ext_lpi
      else if (whichlpi .eq. 'l')  then
 204    write(*,'(a,a, $)') 'Input Lazy-Pulverix filename base',
     &  ' (with extension): '
        read(*,'(A)',err=204) file_lpi
      endif


c...	Output file names:
      file_bufout = file_base(1:ilen(file_base))//ext_bufout


      file_lpitemp = file_base(1:ilen(file_base))//ext_lpitemp
      file_lpiout = file_base(1:ilen(file_base))//ext_lpiout

      file_structout = file_base(1:ilen(file_base))//ext_structout
      file_spurout = file_base(1:ilen(file_base))//ext_spurout
      file_icp = file_base(1:ilen(file_base))//ext_icp
      file_debug = file_base(1:ilen(file_base))//ext_debug
      file_log = file_base(1:ilen(file_base))//ext_log
      file_ps = file_base(1:ilen(file_base))//ext_ps
      file_cps = file_base(1:ilen(file_base))//ext_cps
      file_scan_ps = file_base(1:ilen(file_base))//ext_scan_ps
      file_scan_cps = file_base(1:ilen(file_base))//ext_scan_cps

c...	open log file so record errors
      open(unit=unitlog,file=file_log,status='unknown',err=666)
      write(*,*) 'Opened: ', 'Spurion output log file: ',
     &		file_log(1:ilen(file_log))
      write (unitlog, *) version_stamp(1:79)
      write (unitlog, *) file_log


c	Check that the files file_bufin and file_lpi exist 
c	before opening new files
      if (.not. ((whichqbuf .eq. 'd') .or. (whichqbuf .eq. 'c') ) ) then
        OPEN(UNIT=unitbufin,FILE=file_bufin,STATUS='OLD',err=661)
cQbufin      write(*,*) 'Opened: ', 'Q buffer input file: ', 
cQbufin     &	file_bufin(1:ilen(file_bufin))
        close (unitbufin)
      endif

      if (.not. ((whichlpi .eq. 'd') .or. (whichlpi .eq. 'c') 
     &      .or. (whichlpi .eq. 'n') )) then
        OPEN(UNIT=unitlpi,FILE=file_lpi,STATUS='OLD',err=662)
cLazyc23456789_123456789_123456789_123456789_123456789_123456789_123456789_12
cLazy      write(*,*) 'Opened: ', 'Lazy-Pulverix input file: ',
cLazy     &		file_lpi(1:ilen(file_lpi))
        close (unitlpi)
      endif

C program output
      open(unit=unitstruct,file=file_structout, status='unknown',
     &		err=663)
      write(*,*) 'Opened: ', 'Spurion output structure file: ',
     &		file_structout(1:ilen(file_structout))
      write (unitstruct, *) version_stamp(1:79)
      write (unitstruct, *) file_structout

      open(unit=unitspur,file=file_spurout,status='unknown',
     &		err=664)
      write(*,*) 'Opened: ', 'Spurion output spurion file: ',
     &		file_spurout(1:ilen(file_spurout))
      write (unitspur, *) version_stamp(1:79)
      write (unitspur, *) file_spurout

      open(unit=unitdebug,file=file_debug,status='unknown',
     &		err=665)
      write(*,*) 'Opened: ', 'Spurion output debugging file: ',
     &		file_debug(1:ilen(file_debug))
      write (unitdebug, *) version_stamp(1:79)
      write (unitdebug, *) file_debug

      open(unit=unitlog,file=file_log,status='unknown',err=666)
      write(*,*) 'Opened: ', 'Spurion output log file: ',
     &		file_log(1:ilen(file_log))
      write (unitlog, *) version_stamp(1:79)
      write (unitlog, *) file_log

      goto 999

 661  write (*,*) 'Can not open file: ', file_bufin(1:ilen(file_bufin))
      write (*,*) 'This may causes an infinite loop. '
      goto 199
c      goto 202

 662  write (*,*) 'Can not open file: ',  file_lpi(1:ilen(file_lpi))
      write (unitlog,*) 'Can not open file: ',  
     &      file_lpi(1:ilen(file_lpi))
      goto 211
c	!! this didn't open *.struct, *.spur and *.debug files.
ccc      struct = .false.
ccc      goto 999

 663  write (*,*) 'Can not open file: ', 
     & file_structout(1:ilen(file_structout))
      write (*,*) '  Instead, will be outputed to unit ', unitstruct
      write (unitlog,*) 'Can not open file: ', 
     & file_structout(1:ilen(file_structout))
      write (unitlog,*) '  Instead, will be outputed to unit ', 
     &      unitstruct
      stop		!! for debugging
      goto 999

 664  write (*,*) 'Can not open file: ', 
     & file_spurout(1:ilen(file_spurout))
      write (*,*) '  Instead, will be outputed to unit ', unitspur
      write (unitlog,*) 'Can not open file: ', 
     & file_spurout(1:ilen(file_spurout))
      write (unitlog,*) '  Instead, will be outputed to unit ', unitspur
      stop		!! for debugging
      goto 999

 665  write (*,*) 'Can not open file: ', 
     & file_debug(1:ilen(file_debug))
      write (*,*) '  Instead, will be outputed to unit ', unitdebug
      write (unitlog,*) 'Can not open file: ', 
     & file_debug(1:ilen(file_debug))
      write (unitlog,*) '  Instead, will be outputed to unit ', 
     & unitdebug      
      stop		!! for debugging
      goto 999

 666  write (*,*) 'Can not open file: ', 
     & file_log(1:ilen(file_log))
      write (*,*) '  Instead, will be outputed to unit ', unitlog
      write (unitlog,*) 'Can not open file: ', 
     & file_log(1:ilen(file_log))
      write (unitlog,*) '  Instead, will be outputed to unit ', unitlog
      stop		!! for debugging
      goto 999


      	      
 999  return
      end

