diff --git a/tao/code/tao_beam_track_endpoint.f90 b/tao/code/tao_beam_track_endpoint.f90 index 67406b71df..8e4a0feaac 100644 --- a/tao/code/tao_beam_track_endpoint.f90 +++ b/tao/code/tao_beam_track_endpoint.f90 @@ -1,5 +1,5 @@ !+ -! 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. ! @@ -7,13 +7,15 @@ ! 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,44 +40,69 @@ 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 @@ -82,7 +110,7 @@ function tao_beam_track_endpoint (ele_id, lat, branch_str, where) result (ele) 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 diff --git a/tao/code/tao_command.f90 b/tao/code/tao_command.f90 index febe11096f..113f3aee6f 100644 --- a/tao/code/tao_command.f90 +++ b/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)) diff --git a/tao/code/tao_init_mod.f90 b/tao/code/tao_init_mod.f90 index 1d156c928d..300d6fb060 100644 --- a/tao/code/tao_init_mod.f90 +++ b/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. diff --git a/tao/code/tao_interface.f90 b/tao/code/tao_interface.f90 index f05c49cd11..52fde20c8d 100644 --- a/tao/code/tao_interface.f90 +++ b/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) diff --git a/tao/code/tao_set_mod.f90 b/tao/code/tao_set_mod.f90 index edcf9d9cf4..5f9a9cd49f 100644 --- a/tao/code/tao_set_mod.f90 +++ b/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