Devel/198 (#1011)

* Fix for Tao "set beam" command.

tao/code/tao_beam_track_endpoint.f90

@@ -1,19 +1,21 @@
 !+
-! Function tao_beam_track_endpoint (ele_id, lat, branch_str, where) result (ele)
+! Function tao_beam_track_endpoint (ele_id, lat, branch_str, where, u) result (ele)
 !
 ! Routine to point to the track endpoint element.
 !
 ! Input:
 ! ele_id -- character(*): Name or index of the element.
 ! lat -- lat_struct: Lattice.
 ! branch_str -- integer: Branch where the tracking is done. '' => Branch not specified.
-! where -- character(*): 'TRACK_END' or 'TRACK_START'. Used for error messages.
+! where -- character(*): 'TRACK_END', 'TRACK_START', etc.. Used for error messages.
+! u -- tao_universe_struct: Universe beam is being tracked in.
 !
 ! Output:
 ! ele -- ele_struct, pointer: Pointer to the track endpoint element. Nullified if error.
+! Note: blank ele_id is handled if "where" contains 'END' or 'START'
 !-
 
-function tao_beam_track_endpoint (ele_id, lat, branch_str, where) result (ele)
+function tao_beam_track_endpoint (ele_id, lat, branch_str, where, u) result (ele)
 
 use tao_interface, dummy => tao_beam_track_endpoint
 
@@ -23,8 +25,9 @@ function tao_beam_track_endpoint (ele_id, lat, branch_str, where) result (ele)
 type (ele_struct), pointer :: ele0, ele
 type (ele_pointer_struct), allocatable, target :: eles(:)
 type (branch_struct), pointer :: branch
+type (tao_universe_struct), target :: u
 
-integer ix_branch, n_loc
+integer ix_branch, n_loc, ie
 logical err
 
 character(*) ele_id, where, branch_str
@@ -37,52 +40,77 @@ function tao_beam_track_endpoint (ele_id, lat, branch_str, where) result (ele)
 
 branch => pointer_to_branch(branch_str, lat)
 if (.not. associated(branch) .and. branch_str /= '') then
- call out_io (s_error$, r_name, where // 'BRANCH NOT FOUND: ' // branch_str)
+ call out_io (s_error$, r_name, trim(where) // ' BRANCH NOT FOUND: ' // branch_str)
  return
 endif
 if (associated(branch)) ix_branch = branch%ix_branch
 
-call lat_ele_locator (ele_id, lat, eles, n_loc, err, ix_dflt_branch = ix_branch)
+if (ele_id == '') then
+ if (.not. associated(branch)) branch => lat%branch(0)
+
+ if (index(where, 'START') /= 0) then
+ ele => branch%ele(0)
+
+ elseif (index(where, 'END') /= 0) then
+ if (branch%param%geometry == open$) then
+ ele => branch%ele(branch%n_ele_track)
+ else
+ ie = u%model_branch(branch%ix_branch)%beam%ix_track_start - 1
+ if (ie == -1) then
+ ele => branch%ele(0)
+ else
+ ele => branch%ele(ie)
+ endif
+ endif
 
-if (err .or. n_loc == 0) then
- if (ix_branch > -1) then
- call out_io (s_error$, r_name, where // 'ELEMENT NOT FOUND: ' // ele_id, &
- 'IN BRANCH: ' // int_str(ix_branch))
  else
- call out_io (s_error$, r_name, where // 'ELEMENT NOT FOUND: ' // ele_id)
+ call out_io(s_error$, r_name, 'BLANK STRING FOR ' // trim(where) // ' ELEMENT!')
  endif
  return
-endif
 
-if (n_loc > 1) then
- call out_io (s_error$, r_name, 'MULTIPLE ' // where // ' ELEMENTS FOUND: ' // ele_id)
- return
+else
+ call lat_ele_locator (ele_id, lat, eles, n_loc, err, ix_dflt_branch = ix_branch)
+ if (err .or. n_loc == 0) then
+ if (ix_branch > -1) then
+ call out_io (s_error$, r_name, trim(where) // ' ELEMENT NOT FOUND: ' // ele_id, &
+ 'IN BRANCH: ' // int_str(ix_branch))
+ else
+ call out_io (s_error$, r_name, trim(where) // ' ELEMENT NOT FOUND: ' // ele_id)
+ endif
+ return
+ endif
+
+ if (n_loc > 1) then
+ call out_io (s_error$, r_name, 'MULTIPLE ' // trim(where) // ' ELEMENTS FOUND: ' // ele_id)
+ return
+ endif
 endif
 
+
 ele0 => eles(1)%ele
 select case (ele0%lord_status)
 case (multipass_lord$) 
- call out_io (s_error$, r_name, 'BEAM ' // where // ' ELEMENT IS A MULTIPASS LORD: ' // ele_id, &
+ call out_io (s_error$, r_name, 'BEAM ' // trim(where) // ' ELEMENT IS A MULTIPASS LORD: ' // ele_id, &
  'WHERE TO START IN THE LATTICE IS AMBIGUOUS SINCE WHICH PASS TO USE IS NOT SPECIFIED.')
  return
 case (group_lord$, overlay_lord$)
  if (ele0%n_slave == 1) then
  ele0 => pointer_to_slave(ele0, 1)
  else
- call out_io (s_error$, r_name, 'BEAM ' // where // ' ELEMENT IS A CONTROLLER TYPE ELEMENT: ' // ele_id, &
+ call out_io (s_error$, r_name, 'BEAM ' // trim(where) // ' ELEMENT IS A CONTROLLER TYPE ELEMENT: ' // ele_id, &
  'THIS DOES NOT MAKE SENSE.')
  return
  endif
 case (girder_lord$)
- call out_io (s_error$, r_name, 'BEAM ' // where // ' ELEMENT IS A GIRDER TYPE ELEMENT: ' // ele_id, &
+ call out_io (s_error$, r_name, 'BEAM ' // trim(where) // ' ELEMENT IS A GIRDER TYPE ELEMENT: ' // ele_id, &
  'THIS DOES NOT MAKE SENSE.')
  return
 end select
 
 if (ele0%lord_status == super_lord$) ele0 => pointer_to_slave(ele0, ele0%n_lord)
 
 if (ele0%n_slave /= 0) then
- call out_io (s_error$, r_name, 'UNABLE TO ASSOCIATE BEAM ' // where // ' ELEMENT: ' // ele_id, &
+ call out_io (s_error$, r_name, 'UNABLE TO ASSOCIATE BEAM ' // trim(where) // ' ELEMENT: ' // ele_id, &
  'TO SOMEPLACE IN THE TRACKING LATTICE.')
  return
 endif

tao/code/tao_command.f90

@@ -767,9 +767,9 @@ subroutine tao_command (command_line, err_flag, err_is_fatal)
 
  select case (set_word)
  case ('beam')
- call tao_set_beam_cmd (cmd_word(1), cmd_word(3), branch_str)
+ call tao_set_beam_cmd (cmd_word(1), unquote(cmd_word(3)), branch_str)
  case ('beam_init')
- call tao_set_beam_init_cmd (cmd_word(1), cmd_word(3), branch_str)
+ call tao_set_beam_init_cmd (cmd_word(1), unquote(cmd_word(3)), branch_str)
  case ('beam_start', 'particle_start')
  if (set_word == 'beam_start') call out_io (s_warn$, r_name, 'Note: "beam_start" is now named "particle_start".')
  call tao_set_particle_start_cmd (cmd_word(1), cmd_word(3))

tao/code/tao_init_mod.f90

@@ -347,12 +347,8 @@ subroutine tao_init_beam_in_universe (u, beam_init, track_start, track_end, comb
 
 u%beam%track_beam_in_universe = .true.
 
-if (track_start == '') then
- ele => u%model%lat%branch(0)%ele(0)
-else
- ele => tao_beam_track_endpoint (track_start, u%model%lat, '', 'TRACK_START')
- if (.not. associated(ele)) return
-endif
+ele => tao_beam_track_endpoint (track_start, u%model%lat, '', 'TRACK_START', u)
+if (.not. associated(ele)) return
 
 bb => u%model_branch(ele%ix_branch)%beam
 bb%ix_track_start = ele%ix_ele
@@ -368,20 +364,10 @@ subroutine tao_init_beam_in_universe (u, beam_init, track_start, track_end, comb
 bb%track_end = track_end
 branch => u%model%lat%branch(ele%ix_branch)
 
-if (track_end == '') then
- if (branch%param%geometry == open$) then
- bb%ix_track_end = branch%n_ele_track
- else
- bb%ix_track_end = bb%ix_track_start - 1
- if (bb%ix_track_end == -1) bb%ix_track_end = branch%n_ele_track
- endif
-
-else
- bb%ix_track_end = not_set$
- ele => tao_beam_track_endpoint (track_end, u%model%lat, int_str(ele%ix_branch), 'TRACK_END')
- if (.not. associated(ele)) return
- bb%ix_track_end = ele%ix_ele
-endif
+bb%ix_track_end = not_set$
+ele => tao_beam_track_endpoint (track_end, u%model%lat, int_str(ele%ix_branch), 'TRACK_END', u)
+if (.not. associated(ele)) return
+bb%ix_track_end = ele%ix_ele
 
 ! Find where to save the beam at.
 ! Note: Beam will automatically be saved at fork elements and at the ends of the beam tracking.

tao/code/tao_interface.f90

@@ -59,12 +59,13 @@ function tao_beam_emit_calc (plane, emit_type, ele, bunch_params) result (emit)
  real(rp) emit
 end function
 
-function tao_beam_track_endpoint (ele_id, lat, branch_str, where) result (ele)
+function tao_beam_track_endpoint (ele_id, lat, branch_str, where, u) result (ele)
  import
  implicit none
  type (ele_struct), pointer :: ele
  type (lat_struct), target :: lat
  character(*) ele_id, where, branch_str
+ type (tao_universe_struct) u
 end function
 
 function tao_branch_index (ix_branch) result (ix_this)

tao/code/tao_set_mod.f90

@@ -1003,7 +1003,7 @@ subroutine tao_set_beam_cmd (who, value_str, branch_str)
 
  select case (switch)
  case ('beginning')
- ele => tao_beam_track_endpoint (value_str, u%model%lat, '', 'BEGGINING')
+ ele => tao_beam_track_endpoint (value_str, u%model%lat, '', 'BEGGINING', u)
  if (.not. associated(ele)) return
  beam => u%model_branch(ele%ix_branch)%ele(ele%ix_ele)%beam
  if (.not. allocated(beam%bunch)) then
@@ -1026,7 +1026,7 @@ subroutine tao_set_beam_cmd (who, value_str, branch_str)
  call tao_set_logical_value (u%beam%always_reinit, switch, value_str, err)
 
  case ('track_start', 'beam_track_start', 'track_end', 'beam_track_end')
- ele => tao_beam_track_endpoint (value_str, u%model%lat, branch_str, switch)
+ ele => tao_beam_track_endpoint (value_str, u%model%lat, branch_str, upcase(switch), u)
  if (.not. associated(ele)) return
 
  bb => u%model_branch(ele%ix_branch)%beam