subroutine transfer (from, to, factor, u)

use cesrv_struct
use cesrv_interface

implicit none

type (universe_struct), target :: u


real(rp) factor

integer i
character(*) from, to

logical print_err

!

print_err = .true.         ! assume the worst

! xquneing

if (to == 'XQUNEING') then
  select case (from)
  case ('ZERO')
    call vmputn('CSR XQUNEING', 1, 2, [0, 0])
    print *, trim(from), ' values (times 100) transfered to CSR XQUNEING data base'
  case ('DESIGN')
    call vmputn('CSR XQUNEING', 1, 2, [nint(100*u%chrom%y%d(1)%design), nint(100*u%chrom%x%d(1)%design)])
    print *, trim(from), ' values (times 100) transfered to CSR XQUNEING data base'
  case ('MODEL')
    call vmputn('CSR XQUNEING', 1, 2, [nint(100*u%chrom%y%d(1)%model), nint(100*u%chrom%x%d(1)%model)])
    print *, trim(from), ' values (times 100) transfered to CSR XQUNEING data base'
  case ('BASE_MODEL')
    call vmputn('CSR XQUNEING', 1, 2, [nint(100*u%chrom%y%d(1)%base_model), nint(100*u%chrom%x%d(1)%base_model)])
    print *, trim(from), ' values (times 100) transfered to CSR XQUNEING data base'
  case ('DATA')
    call vmputn('CSR XQUNEING', 1, 2, [nint(100*u%chrom%y%d(1)%meas), nint(100*u%chrom%x%d(1)%meas)])
    print *, trim(from), ' values (times 100) transfered to CSR XQUNEING data base'
  case ('REFERENCE')
    call vmputn('CSR XQUNEING', 1, 2, [nint(100*u%chrom%y%d(1)%ref), nint(100*u%chrom%x%d(1)%ref)])
    print *, trim(from), ' values (times 100) transfered to CSR XQUNEING data base'
  case default
    print *, 'ERROR: TRANSFER WHAT CHROMATICITY VALUES TO XQUNEING?'
  end select
  print_err = .false.                ! everything is OK
endif

! Load quads

if (to == 'QUADRUPOLE') then
  select case (from)
  case ('DESIGN', 'SAVED', 'REFERENCE', 'BASE_MODEL')
    call do_var_transfer (u%quad_k1, factor, from, u, .true.)
  case ('ZERO')
    print *, 'ERROR: CANNOT ZERO QUADS'
  case default
    print *, 'ERROR: TRANSFER WHAT TO QUADS?'
  end select
 print_err = .false.                ! everything is OK
endif

! change model

if (to == 'MODEL') then
  select case (from)
  case ('DESIGN')
    if (factor == 1) then
      u%ring = u%design
      print *, 'DESIGN lattice transfered to MODEL'
      call do_var_transfer (u%hsep_kick, factor, 'ZERO', u, .true.)
    else
      call do_var_transfer (u%quad_k1,      factor, from, u, .true.)
      call do_var_transfer (u%skew_quad_k1, factor, from, u, .true.)
      call do_var_transfer (u%hsep_kick, factor, 'ZERO', u, .true.)
      call do_var_transfer (u%hsteer_kick, factor, from, u, .true.)
      call do_var_transfer (u%vsteer_kick, factor, from, u, .true.)
      call do_var_transfer (u%sex_k2, factor, from, u, .true.)
      call do_var_transfer (u%skew_sex_k2, factor, from, u, .true.)
    endif
    print_err = .false.                ! everything is OK
  case ('BASE_MODEL')
    call do_var_transfer (u%quad_k1,      factor, from, u, .true.)
    call do_var_transfer (u%skew_quad_k1, factor, from, u, .true.)
    call do_var_transfer (u%hsep_kick, factor, from, u, .true.)
    call do_var_transfer (u%hsteer_kick, factor, from, u, .true.)
    call do_var_transfer (u%vsteer_kick, factor, from, u, .true.)
    call do_var_transfer (u%sex_k2, factor, from, u, .true.)
    call do_var_transfer (u%skew_sex_k2, factor, from, u, .true.)
    print_err = .false.                ! everything is OK

  case ('SAVED', 'REFERENCE', 'ZERO')
    if (logic%opt_vars == opt_quad$ .and. from /= 'ZERO') then
      call do_var_transfer (u%quad_k1,      factor, from, u, .true.)
      call do_var_transfer (u%skew_quad_k1, factor, from, u, .true.)
      print_err = .false.                ! everything is OK
    elseif (logic%opt_vars == opt_sex$) then
      call do_var_transfer (u%sex_k2, factor, from, u, .true.)
      call do_var_transfer (u%skew_sex_k2, factor, from, u, .true.)
      print_err = .false.                ! everything is OK
    elseif (logic%opt_vars == opt_steering$) then
      call do_var_transfer (u%hsteer_kick, factor, from, u, .true.)
      call do_var_transfer (u%vsteer_kick, factor, from, u, .true.)
      call do_var_transfer (u%hsep_kick, factor, from, u, .true.)
      print_err = .false.                ! everything is OK
    elseif (logic%opt_vars == opt_custom$) then
      call do_var_transfer (u%custom_var, factor, from, u, .true.)
      print_err = .false.                ! everything is OK
    endif

  end select
endif

! Change sextupoles

if (to == 'SEXTUPOLE') then
  select case (from)
  case ('DESIGN', 'SAVED', 'REFERENCE', 'ZERO', 'S-R', 'BASE_MODEL')
    call do_var_transfer (u%sex_k2, factor, from, u, .true.)
    print_err = .false.                ! everything is OK
  case default
    print *, 'ERROR: TRANSFER WHAT TO SEXTUPOLES?'
  end select
  print_err = .false.                ! everything is OK
endif

! Change skew sextupoles

if (to == '_SKEW_SEX') then
  select case (from)
  case ('DESIGN', 'SAVED', 'REFERENCE', 'ZERO', 'S-R', 'BASE_MODEL')
    call do_var_transfer (u%skew_sex_k2, factor, from, u, .true.)
    print_err = .false.                ! everything is OK
  case default
    print *, 'ERROR: TRANSFER WHAT TO SKEW SEXTUPOLES?'
  end select
  print_err = .false.                ! everything is OK
endif

! change variables

if (to == 'CUSTOM_VAR') then
  if (from == 'ZERO') then
    call do_var_transfer (u%custom_var, factor, from, u, .true.)
    print_err = .false.                ! everything is OK
  endif
endif

! steerings

if (to == 'HORIZONTAL') then
  select case (from)
  case ('DESIGN', 'SAVED', 'REFERENCE', 'ZERO', 'S-R', 'BASE_MODEL')

    call do_var_transfer (u%hsteer_kick, factor, from, u, .true.)
    print_err = .false.                ! everything is OK
  end select
endif

if (to == 'VERTICAL') then
  select case (from)
  case ('DESIGN', 'SAVED', 'REFERENCE', 'ZERO', 'S-R', 'BASE_MODEL')
    call do_var_transfer (u%vsteer_kick, factor, from, u, .true.)
    print_err = .false.                ! everything is OK
  end select
endif

if (to == 'H_SEPARATOR') then
  select case (from)
  case ('DESIGN', 'SAVED', 'REFERENCE', 'ZERO', 'S-R', 'BASE_MODEL')
    call do_var_transfer (u%hsep_kick, factor, from, u, .true.)
    print_err = .false.                ! everything is OK
  end select
endif

! skew quads

if (to == 'SKEW_QUAD') then
  select case (from)
  case ('DESIGN', 'SAVED', 'REFERENCE', 'ZERO', 'S-R', 'BASE_MODEL')
    call do_var_transfer (u%skew_quad_k1, factor, from, u, .true.)
    print_err = .false.
  case default
    print *, 'ERROR: TRANSFER WHAT TO SKEW QUADS?'
  end select
  print_err = .false.                ! everything is OK
endif

!----------------------------------------------------------------------
! Change data

if (to == 'DATA') then

  if (from == 'MODEL') then

    do i = lbound(u%data, 1), ubound(u%data, 1)
      if (u%data(i)%exists) then
        u%data(i)%meas = u%data(i)%model
        u%data(i)%good_dat = .true.
        u%data(i)%d1%d2%file_name = 'MODEL TRANSFERED'
        u%data(i)%d1%d2%measured = .true.
      endif
    enddo
    do i = lbound(u%var, 1), ubound(u%var, 1)
      u%var(i)%saved = u%var(i)%model
      if (u%var(i)%dvar_dcu == 0) cycle
      u%var(i)%cu_saved = (u%var(i)%saved - u%var(i)%base_cu0) / u%var(i)%dvar_dcu
    enddo
    u%main_title1 = 'Data: From the Model'
    u%data_is_from_model = .true.
    print *, 'MODEL values transfered to all DATA'

  elseif (from == 'BASE_MODEL') then

    do i = lbound(u%data, 1), ubound(u%data, 1)
      if (u%data(i)%exists) then
        u%data(i)%meas = u%data(i)%base_model
        u%data(i)%good_dat = .true.
        u%data(i)%d1%d2%file_name = 'BASE_MODEL TRANSFERED'
        u%data(i)%d1%d2%measured = .true.
      endif
    enddo
    do i = lbound(u%var, 1), ubound(u%var, 1)
      u%var(i)%saved = u%var(i)%base_model
      if (u%var(i)%dvar_dcu == 0) cycle
      u%var(i)%cu_saved = (u%var(i)%saved - u%var(i)%base_cu0) / u%var(i)%dvar_dcu
    enddo
    u%main_title1 = 'Data: From the Base_model'
    u%data_is_from_model = .true.
    print *, 'BASE_MODEL values transfered to all DATA'

  elseif (from == 'DESIGN') then
    do i = lbound(u%data, 1), ubound(u%data, 1)
      if (u%data(i)%exists) then
        u%data(i)%meas = u%data(i)%design
        u%data(i)%good_dat = .true.
        u%data(i)%d1%d2%file_name = 'DESIGN TRANSFERED'
        u%data(i)%d1%d2%measured = .true.
      endif
    enddo
    do i = lbound(u%var, 1), ubound(u%var, 1)
      u%var(i)%saved = u%var(i)%design
      if (u%var(i)%dvar_dcu == 0) cycle
      u%var(i)%cu_saved = (u%var(i)%saved - u%var(i)%base_cu0) / u%var(i)%dvar_dcu
    enddo
    u%main_title1 = 'Data: From the Design'
    u%data_is_from_model = .true.
    print *, 'DESIGN values transfered to all DATA'

  elseif (from == 'ZERO') then
    u%orbit%x%d(:)%meas = 0
    u%orbit%y%d(:)%meas = 0
    print *, 'ZERO transfered to ORBIT DATA'
    u%main_title1 = 'Data: Zeroed'

  elseif (from == 'REFERENCE') then
    do i = lbound(u%data, 1), ubound(u%data, 1)
      if (u%data(i)%exists) then
        u%data(i)%meas = u%data(i)%ref
        u%data(i)%good_dat = u%data(i)%good_ref
        u%data(i)%d1%d2%file_name = u%data(i)%d1%d2%ref_file_name
        u%data(i)%d1%d2%measured = .true.
      endif
    enddo
    do i = lbound(u%var, 1), ubound(u%var, 1)
      u%var(i)%saved = u%var(i)%saved_ref
      u%var(i)%cu_saved = u%var(i)%cu_saved_ref
    enddo
    if (u%main_title2(1:3) == 'Ref') then
      u%main_title1 = 'Data:' // u%main_title2(6:)
    else
      u%main_title1 = u%main_title2
    endif
    print *, 'REFERENCE values transfered to all DATA'

  else
    print *, 'ERROR: TRANSFER WHAT TO THE DATA?'
  endif

  print_err = .false.

endif

! individual data

select case (to)
case ('CHROMATICITY')
  call do_data_transfer (u%chrom%x%d)
  call do_data_transfer (u%chrom%y%d, .true.)
case ('ORBIT')
  call do_data_transfer (u%orbit%x%d)
  call do_data_transfer (u%orbit%y%d, .true.)
case ('TUNE') 
  call do_data_transfer (u%tune%x%d)
  call do_data_transfer (u%tune%y%d, .true.)
case ('PHASE') 
  call do_data_transfer (u%phase%x%d)
  call do_data_transfer (u%phase%y%d, .true.)
end select

! change base_model

if (to == 'BASE_MODEL') then
  if (from == 'MODEL') then
    u%data(:)%base_model = u%data(:)%model
    do i = 1, size(u%var)
      u%var(i)%base_model = u%var(i)%model
    enddo
    print *, 'Set Base_Model = Model'
  elseif (from == 'DESIGN') then
    u%data(:)%base_model = u%data(:)%design
    do i = 1, size(u%var)
      u%var(i)%base_model = u%var(i)%design
    enddo
    print *, 'Set Base_Model = Design'
  else
    print *, 'ERROR: TRANSFER WHAT TO BASE_MODEL?'
  endif
  print_err = .false.
endif

! Change REF

if (to == 'REFERENCE') then

  if (from == 'MODEL') then
    do i = lbound(u%data, 1), ubound(u%data, 1)
      if (u%data(i)%exists) then
        u%data(i)%ref = u%data(i)%model
        u%data(i)%good_ref = .true.
        u%data(i)%d1%d2%ref_file_name = 'MODEL TRANSFERED'
        u%data(i)%d1%d2%ref_measured = .true.
      endif
    enddo
    do i = lbound(u%var, 1), ubound(u%var, 1)
      u%var(i)%saved_ref = u%var(i)%model
      if (u%var(i)%dvar_dcu == 0) cycle
      u%var(i)%cu_saved_ref = (u%var(i)%saved_ref - u%var(i)%base_cu0) / &
                                                            u%var(i)%dvar_dcu
    enddo
    u%main_title2 = 'Ref:  From the Model'
    print *, 'MODEL values transfered to all REFERENCE Data'

  elseif (from == 'BASE_MODEL') then
    do i = lbound(u%data, 1), ubound(u%data, 1)
      if (u%data(i)%exists) then
        u%data(i)%ref = u%data(i)%base_model
        u%data(i)%good_ref = .true.
        u%data(i)%d1%d2%ref_file_name = 'BASE_MODEL TRANSFERED'
        u%data(i)%d1%d2%ref_measured = .true.
      endif
    enddo
    do i = lbound(u%var, 1), ubound(u%var, 1)
      u%var(i)%saved_ref = u%var(i)%base_model
      if (u%var(i)%dvar_dcu == 0) cycle
      u%var(i)%cu_saved_ref = (u%var(i)%saved_ref - u%var(i)%base_cu0) / &
                                                            u%var(i)%dvar_dcu
    enddo
    u%main_title2 = 'Ref:  From the Base_Model'
    print *, 'BASE_MODEL values transfered to all REFERENCE Data'

  elseif (from == 'DESIGN') then
    do i = lbound(u%data, 1), ubound(u%data, 1)
      if (u%data(i)%exists) then
        u%data(i)%ref = u%data(i)%design
        u%data(i)%good_ref = .true.
        u%data(i)%d1%d2%ref_file_name = 'DESIGN TRANSFERED'
        u%data(i)%d1%d2%ref_measured = .true.
      endif
    enddo
    do i = lbound(u%var, 1), ubound(u%var, 1)
      u%var(i)%saved_ref = u%var(i)%design
      if (u%var(i)%dvar_dcu == 0) cycle
      u%var(i)%cu_saved_ref = (u%var(i)%saved_ref - u%var(i)%base_cu0) / &
                                                            u%var(i)%dvar_dcu
    enddo
    u%main_title2 = 'Ref: From the Design'
    print *, 'DESIGN values transfered to all REFERENCE Data'

  elseif (from == 'DATA') then
    do i = lbound(u%data, 1), ubound(u%data, 1)
      if (u%data(i)%exists) then
        u%data(i)%ref = u%data(i)%meas
        u%data(i)%good_ref = u%data(i)%good_dat
        u%data(i)%d1%d2%ref_file_name = u%data(i)%d1%d2%file_name
        u%data(i)%d1%d2%ref_measured = .true.
      endif
    enddo
    do i = lbound(u%var, 1), ubound(u%var, 1)
      u%var(i)%saved_ref = u%var(i)%saved
      u%var(i)%cu_saved_ref = u%var(i)%cu_saved
    enddo
    if (u%main_title1(1:3) == 'Dat') then
      u%main_title2 = 'Ref: ' // u%main_title1(6:)
    else
      u%main_title2 = u%main_title1
    endif
    print *, 'DATA values transfered to all REFERENCE Data'

  else
    print *, 'ERROR: TRANSFER WHAT TO THE REFERENCE?'
  endif

  print_err = .false.                ! everything is OK

endif

!

if (print_err) then
  print *, 'ERROR: BAD TRANSFER COMBINATION'
else
  call ring_calc (u)
endif

!-----------------------------------------------------------------------
contains

subroutine do_data_transfer (dat, print_transfer)

type (data_struct) dat(:)
logical, optional :: print_transfer

!

do i = lbound(dat, 1), ubound(dat, 1)
  select case (from)
  case ('MODEL')
    if (.not. dat(i)%exists) cycle
    dat(i)%meas = dat(i)%model
    dat(i)%good_dat = .true.
    dat(i)%d1%d2%file_name = 'MODEL TRANSFERED'
    dat(i)%d1%d2%measured = .true.

  case ('DESIGN')
    if (.not. dat(i)%exists) cycle
    dat(i)%meas = dat(i)%design
    dat(i)%good_dat = .true.
    dat(i)%d1%d2%file_name = 'DESIGN TRANSFERED'
    dat(i)%d1%d2%measured = .true.

  case ('ZERO')
    if (.not. dat(i)%exists) cycle
    dat(i)%meas = 0
    dat(i)%good_dat = .true.
    dat(i)%d1%d2%file_name = 'ZERO TRANSFERED'
    dat(i)%d1%d2%measured = .true.

  case ('REFERENCE')
    if (.not. dat(i)%exists) cycle
    dat(i)%meas = dat(i)%ref
    dat(i)%good_dat = .true.
    dat(i)%d1%d2%file_name = 'REFERENCE TRANSFERED'
    dat(i)%d1%d2%measured = .true.

  case ('DATA')
    if (.not. dat(i)%exists) cycle
    dat(i)%meas = dat(i)%meas
    dat(i)%good_dat = .true.
    dat(i)%d1%d2%file_name = 'DATA TRANSFERED'
    dat(i)%d1%d2%measured = .true.

  case default
    if (logic_option(.false., print_transfer)) print *, 'ERROR: TRANSFER WHAT TO ', trim(to), '?'
    print_err = .false.
    return
  end select
enddo

if (logic_option(.false., print_transfer)) print *, trim(from), ' values transfered to ', trim(to)

print_err = .false.

end subroutine

end subroutine