subroutine take_eta (data_or_ref, u, graph, err_flag)

use cesrv_struct
use cesrv_interface

implicit none

type (universe_struct), target :: u

type (graph_struct) graph

integer data_or_ref, orbit_num, orbit_num1, orbit_num2
integer, save :: cu_del_freq = 2000
integer cu_half_del_freq, idel, species
integer ix, save_set, iu, i, j, vnumbr, ival(120)
integer raw(4, 120), raw1(4,120), raw2(4,120), comd(16) / 16*0 / ! command array for BEARUN
integer :: rf_delay_ms = 500
integer termout / -1 /, det_type(120)

real(rp) master_freq_orig, rf_freq_orig, master_freq_curr, mom_comp
real(rp) x_eta(120), y_eta(120)
real(rp) rf_freq1, rf_freq2
real(rp) del_e_e, del_freq
real(rp) del_time, rf_freq
real(rp), save :: rate = 4

! Note: single precision
real x1_orbit(120), y1_orbit(120), x2_orbit(120), y2_orbit(120) 

character line*40, string*5, date_str*20, lattice*40, comment*78
character(140) dat_file, file_name, str
integer, parameter :: db_num = 15
character(12) :: name, db_name(db_num) =  [ &
        'CSR_QUAD_CUR', 'CSR_QADD_CUR', 'CSR_SEXT_CUR', 'CSR_SQEWQUAD', &
        'CSR_SQEWSEXT', 'CSR_HORZ_CUR', 'CSR_HBND_CUR', 'CSR_VERT_CUR', &
        'CSR_HSP_VOLT', 'CSR_HSP_VVAL', 'CSR_OCTU_CUR', 'SCW_CUR_READ', &
        'UND_VERT_CUR', 'UND_CNTG_CUR', 'UND_CNTGTRIM']

logical good_data1(120), good_data2(120)
logical ok, err_flag

! init

call vxputn ('PROGRAMPULSE', 9, 9, 1)  ! pause xetec
call set_species (species, err_flag)
if (err_flag) return

call check_current (ok)
if (.not. ok) return

mom_comp = u%global_design%synch_int(1) / u%ring%param%total_length

! debug

if (logic%debug) then
  print *, 'Fake Take_eta'
  return
endif

! change rf freq

print *, 'Dispersion measurement...'
print *, 'Comment to be inserted in the data file'
call get_input_string ('Comment:', comment)
call make_legal_comment (comment, comment)

write (str, '(a, i0, a)') 'Change in RF Freq to use <CR = ', cu_del_freq, ' CU>:'
call get_input_string (str, line)
call string_to_int (line, cu_del_freq, cu_del_freq, err_flag)
if (err_flag) return

cu_half_del_freq = int(cu_del_freq/2)

! Set slew rate

write (str, '(a, f4.1, a)') 'RF slew rate (Hz/sec @12 MHz) <CR =', rate, '>:'
call get_input_string (str, line)
call string_to_real (line, rate, rate, err_flag)
if (err_flag) return
call slew_master_rate (real(rate))

! Get the current rf freq which is 42 times the master

call get_master_synth(master_freq_orig)
rf_freq_orig = master_freq_orig*42.

! Change the rf_freq
! Add in a half-way step to help the rf stay on

call set_500mhz_ref(rf_freq_orig-float(cu_half_del_freq))
call milli_sleep(rf_delay_ms)
call set_500mhz_ref(rf_freq_orig-float(cu_del_freq))

call run_timer ('START') ! start timer
call milli_sleep(10000)

! make first measurement

print *, ' Changed CESR RF Frequency and now taking 1st orbit...'
call bearun (raw1, comd, termout, .false.)      ! get orbit
call butout (raw1, orbit_num1)
print *, 'BUTNS.', orbit_num1, ' Written'
call nonlin_butcon (raw1, 1, 100, y1_orbit, x1_orbit)

call vxgetn ('CSRBPM FLAGS', 1, 120, det_type)
call det_ok (raw1, 1, 120, det_type, good_data1)

! Read the frequency.
! Note: want to wait 20 secs from time freq was changed to when freq is read

print *, ' Reading RF frequency ...'
call run_timer ('STOP', del_time)
idel = (20 - del_time) * 1000
if (idel > 0) call milli_sleep (idel)

call get_master_synth(master_freq_curr)
rf_freq1 = master_freq_curr * 42.

print *, ' CESR RF frequency:', rf_freq1
if (rf_freq1 == 0) then
  print *, 'ERROR READING RF FREQUENCY. DISPERSION MEASUREMENT ABORTED.'
  return
endif

! Change the rf_freq for the second measurement
! Add in a half-way steps to help the rf stay on

call set_500mhz_ref(rf_freq_orig-float(cu_half_del_freq))
call milli_sleep(rf_delay_ms)
call set_500mhz_ref(rf_freq_orig)
call milli_sleep(rf_delay_ms)
call set_500mhz_ref(rf_freq_orig+float(cu_half_del_freq))
call milli_sleep(rf_delay_ms)
call set_500mhz_ref(rf_freq_orig+float(cu_del_freq))
call run_timer ('START') ! start timer
call milli_sleep(10000)

! Bearun restarts xetec so must reset the species again.

call vxputn ('PROGRAMPULSE', 9, 9, 1)  ! pause xetec
call set_species (species, err_flag)
if (err_flag) return

! make second orbit measurement

print *, ' Changed CESR RF Frequency and now taking 2nd orbit...'
call bearun (raw2, comd, termout, .false.)      ! get orbit
call butout (raw2, orbit_num2)
print *, 'BUTNS.', orbit_num2, ' Written'
call nonlin_butcon (raw2, 1, 100, y2_orbit, x2_orbit)
call vxgetn ('CSRBPM FLAGS', 1, 120, det_type)
call det_ok (raw2, 1, 100, det_type, good_data2)

call vxputn ('PROGRAMPULSE', 9, 9, 2)  ! restart xetec

! Read the frequency.

print *, ' Reading RF frequency ...'
call run_timer ('STOP', del_time)
idel = (20 - del_time) * 1000
if (idel > 0) call milli_sleep (idel)

call get_master_synth(master_freq_curr)
rf_freq2 = master_freq_curr * 42.

print *, ' CESR RF frequency:', rf_freq2
if (rf_freq2 == 0) then
  print *, 'ERROR READING RF FREQUENCY. DISPERSION MEASUREMENT ABORTED.'
  return
endif

! change rf freq back to nominal
! Change the rf freq back
call set_500mhz_ref(rf_freq_orig+float(cu_half_del_freq))
call milli_sleep(rf_delay_ms)
call slew_master_synth(master_freq_orig)

! Calculate energy change.

del_freq = (rf_freq2 - rf_freq1)
rf_freq = (rf_freq1 + rf_freq2) / 2
del_E_E = -del_freq / (rf_freq * mom_comp)
print *, ' delta_E/E:', del_E_E

x_eta = (x2_orbit - x1_orbit) / (1000 * del_E_E)
y_eta = (y2_orbit - y1_orbit) / (1000 * del_E_E)

! use average orbit for data

raw = (raw1 + raw2) / 2
call butout (raw, orbit_num)
print *, 'Averaged Orbit: BUTNS.', orbit_num, ' Written'

! write to file

call fullfilename ( &
     '$CESR_ONLINE/machine_data/mach_meas/eta/eta.number', file_name)
call increment_file_number (file_name, 5, ix, string)
iu = lunget()
call form_file_name_with_number ('ETA', ix, dat_file, err_flag)
open (iu, file = dat_file, status = 'NEW')

call getlat (lattice)
call vxgetn ('CSR SAVRECRD', 1, 1, save_set)  ! get save set number
call date_and_time_stamp (date_str)

write (iu, *) '!'
write (iu, *) '&DATA_PARAMETERS'
write (iu, *) '  file_type         = ', "'DISPERSION DATA'"
write (iu, *) '  data_date        = ', "'", date_str, "'"
write (iu, *) '  lattice          = ', "'", trim(lattice), "'"
write (iu, *) '  save_set         = ', save_set
write (iu, *) '  comment = ', trim(comment)
write (iu, *) '/END'

write (iu, *)
write (iu, *) '&ETA_PARAMETERS'
write (iu, *) '  rf_freq1   = ', rf_freq1
write (iu, *) '  rf_freq2   = ', rf_freq2
write (iu, *) '  orbit_num  = ', orbit_num
write (iu, *) '  orbit_num1 = ', orbit_num1
write (iu, *) '  orbit_num2 = ', orbit_num2
write (iu, *) '  del_e_e    = ', del_e_e
write (iu, *) '/END'

write (iu, *)
write (iu, *) '&DATA_BASE'
do i = 1, db_num
  name = db_name(i)
  call to_node_name(name)
  ix = vnumbr(name)
  call vxgetn (name, 1, ix, ival)
  write (iu, '(3x, 2a)') db_name(i), ' = '
  write (iu, '((12x, 10i6))') (ival(j), j = 1, ix)
enddo
write (iu, *) '/END'

write (iu, *)
write (iu, *) '    Det       Eta_x    Eta_y  Good'
write (iu, *) '&DISPERSION_DATA'
do i = 0, 120
  j = i
  if (i == 0) j = 100
  write (iu, '(a, i3, a, 2f9.3, l4, 4i10)') ' ETA_(', i, ') =', &
                  x_eta(j), y_eta(j), good_data1(j) .and. good_data2(j), raw2(:,j) - raw1(:,j)
enddo
write (iu, *) '/END'
close (iu)

print *, 'Written: ', trim(dat_file)
call read_eta (data_or_ref, 0, u, graph, err_flag, .false.)

end subroutine