c....	spurion_mod.f
c	Complete re-write to include more items from the q-buffer,
c	and with names and labels whcih better correspond. March 11, 2002
c	Routines for the modify command's sub-menu

c=============================================================================

      subroutine load_modmenuitems()
       
      implicit none
      include 'io_files.inc'
      include 'spur_modmenu.inc'

c...	passed variables 
      

c...	Old ones
      modmenuitem(bit_lp) = char_lp		!! LATTICE:
      modmenuitem(bit_la) = char_la

      modmenuitem(bit_ec) = char_ec		!! Energy:
      modmenuitem(bit_es) = char_es
      modmenuitem(bit_fe) = char_fe
      modmenuitem(bit_mo) = char_mo
      modmenuitem(bit_dm) = char_dm
      modmenuitem(bit_da) = char_da

      modmenuitem(bit_qc) = char_qc		!! Space
      modmenuitem(bit_qs) = char_qs

      modmenuitem(bit_uu) = char_uu		!! Orient
      modmenuitem(bit_vv) = char_vv

c      modmenuitem(bit_tc) = char_tc		!! Time/H:
      modmenuitem(bit_t0) = char_t0		!! Time/H:
      modmenuitem(bit_ts) = char_ts

      modmenuitem(bit_np) = char_np		!! Time

      modmenuitem(bit_modhelp) = char_modhelp
      modmenuitem(bit_modquit) = char_modquit
      
      return
      end

c=============================================================================

      subroutine load_modmenu()
       
      implicit none
      include 'io_files.inc'
      include 'spur_modmenu.inc'

c...	passed variables 
      
      modmenu(bit_lp) = 
     & 'Lattice: parameters a, b, c' 
      modmenu(bit_la) = 
     & 'Lattice: angles aa, bb, cc' 

      modmenu(bit_ec) = 
     & 'Energy: at center of scan' 
      modmenu(bit_es) = 
     & 'Energy: step' 
      modmenu(bit_fe) = 
     & 'Energy: value of fixed (MON) or (ANA)'
      modmenu(bit_mo) = 
     & 'Energy: toggle MON or ANA with E-fixed' 
      modmenu(bit_dm) = 'Energy: lattice spacing of MON'
      modmenu(bit_da) = 'Energy: lattice spacing of ANA'

      modmenu(bit_qc) = 
     & 'Space: qh qk ql at center of scan' 
      modmenu(bit_qs) = 
     & 'Space: qh qk ql step' 

      modmenu(bit_uu) = 
     & 'Orient: u=(hkl) of scattering plane' 
c...	note: Orient: Angl is unused.
      modmenu(bit_vv) = 
     & 'Orient: v=(hkl)'' of scattering plane' 


c      modmenu(bit_tc) = 
c     & 'Temp/H: center temperature T0'
      modmenu(bit_t0) = 
     & 'Temp/H: start temperature T0'
      modmenu(bit_ts) = 
     & 'Temp/H: temperature step inc-T'

      modmenu(bit_np) =
     & 'Time: number of scanned (E,Q,T) points' 

c...	Standard menu items
      modmenu(bit_modhelp) = 
     & 'HELP!!'
      modmenu(bit_modquit) =
     & 'to quit'

      
      return
      end

c=============================================================================
      subroutine load_mod_itemvalue()
cOld      subroutine load_mod_itemvalue(ec, es, hc, hs, fe, npts, mon)
       

      implicit none
      include 'io_files.inc'
      include 'spur_modmenu.inc'
      include 'spur_buf.inc'

c...	functions
c      logical bit_on

c...	passed variables 
c      real ec, es
c      REAL*4 hc(3), hs(3)
c      real fe
c      integer npts
c      CHARACTER*5 mon
      
c...    local variables
      integer i
      
      do i = 1, len_modmenu 
        moditemvalue(i) = ''
      enddo
      
      write (moditemvalue(bit_lp), 200) (qb_lattice_a(i),i=1,3)
 200  format(2(f5.2,1x), f5.2 , 1x, 'A')
      write (moditemvalue(bit_la), 210) (qb_lattice_angle(i),i=1,3)
 210  format(2(f5.1,1x), f5.1, 1x,  'Dg')

      write (moditemvalue(bit_ec), *) qb_energy_ec, ' meV'
      write (moditemvalue(bit_es), *) qb_energy_es, ' meV'
      
      write (moditemvalue(bit_fe), *) qb_energy_fe, ' meV'

      write (moditemvalue(bit_mo), *) qb_energy_fix, ' is fixed'

      write (moditemvalue(bit_da), *) qb_energy_da, ' A'
      write (moditemvalue(bit_dm), *) qb_energy_dm, ' A'

      write (moditemvalue(bit_qc), 471) (qb_space_hc(i),i=1,3)
      write (moditemvalue(bit_qs), 471) (qb_space_hs(i),i=1,3)
 471  format( '(', f4.2, ',', f4.2, ',', f4.2, ')')
  
      write (moditemvalue(bit_uu), 475) (qb_orient_u(i),i=1,3)
      write (moditemvalue(bit_vv), 475) (qb_orient_v(i),i=1,3)
 475  format( '(', i4, ',', i4, ',', i4, ')')

c      write (moditemvalue(bit_tc), *) qb_temp_T0, ' K'
      write (moditemvalue(bit_t0), *) qb_temp_T0, ' K'
      write (moditemvalue(bit_ts), *) qb_temp_incT, ' K'

      write (moditemvalue(bit_np), *) qb_time_scanpts

      return
      end

c=============================================================================

      subroutine display_submenu(aversion, key, current_thisop,
     &	 add_thisop, len_thismenu, thismenu, thisitemvalue, thismenuitem,
     &   updatecurrent) 
c      subroutine display_modmenu(aversion, key, current_modop,
c     &	 add_modop, len_modmenu, modmenu, moditemvalue, modmenuitem) 
c...	For a menu which propmpts for number to be entered, 
c...	use updatecurrent=.true.
c...	and current_thisop reflects which items have been modified.
c...	For a selection menu, where toggled items are kept track of in
c...	the variable current_thisop, use updatecurrent=.false.

      implicit none
      include 'io_files.inc'
c      include 'spur_modmenu.inc'
      include 'spur_warn.inc'

c...	functions
      logical bit_on
      integer ilen
      
c...	passed variables
      character*(*) aversion
      CHARACTER*5 key
	integer*4 current_thisop, add_thisop
	integer len_thismenu
	character*48 thismenu(*)
	character*20 thisitemvalue(*)
	character*2  thismenuitem(*)
	logical updatecurrent

c...	local variables
      integer i

c      write (*,'(A,$)') 'Type a command or hit <return> for options '
c      read (*,'(a)') key      ! read in a one character command
        
c      if ((key .eq. ' ') .or. (key .eq. '?')) then

        write (*,*) aversion
        write (*,'(a25, x, a25, x, a25)') FILE_BUFIN, FILE_LPI,
     &	 FILE_BASE(1:ilen(FILE_BASE))//'.<ext.>'
        if (warn_options .ne. 0) write (*,'(a)') warnstring

        do i = 1, len_thismenu
	  write (*,*) thismenuitem(i), ': ', thismenu(i),
     &	   ' ', bit_on(current_thisop, i), bit_on(add_thisop, i), 
     &     ' ', thisitemvalue(i)
        enddo
220     write(*,'(a,$)') 'Command ("q" to quit)? '
        read (*,'(a)',err=220) key
c      endif

      add_thisop = 0
      do i =1, len_thismenu
        if (thismenuitem(i) .eq. key) then
	   call set_bit(add_thisop,i,1)
	   if (updatecurrent) call set_bit(current_thisop,i,1)
	endif
      enddo

      return
      end
     
