From a54fe584de6be51195191636356f4dbf70776ce7 Mon Sep 17 00:00:00 2001 From: David Sagan Date: Thu, 15 Aug 2024 23:38:08 -0400 Subject: [PATCH] Fix PTC bombing program due to e_gun being tracked through. Error flags are set instead. (#1148) * Fix PTC bombing program due to e_gun being tracked through. Error flags are set instead. * Fix Tao "set global quiet" command. --- bmad/code/combine_consecutive_elements.f90 | 8 ++- bmad/code/make_hybrid_lat.f90 | 4 +- bmad/code/transfer_map_calc.f90 | 19 +++--- bmad/modules/transfer_map_mod.f90 | 6 +- bmad/ptc/ele_to_fibre.f90 | 1 + bmad/ptc/ptc_interface_mod.f90 | 33 +++++++--- tao/code/tao_graph_setup_mod.f90 | 70 +++++++++++----------- tao/code/tao_quiet_set.f90 | 5 +- tao/version/tao_version_mod.f90 | 2 +- 9 files changed, 87 insertions(+), 61 deletions(-) diff --git a/bmad/code/combine_consecutive_elements.f90 b/bmad/code/combine_consecutive_elements.f90 index c05cda5d25..8d2e5cd0c1 100644 --- a/bmad/code/combine_consecutive_elements.f90 +++ b/bmad/code/combine_consecutive_elements.f90 @@ -53,11 +53,15 @@ subroutine combine_consecutive_elements (lat, error) cycle endif call combine_eles (ele1, ele2, branch, error) + if (error) return endif if (ele2%key == marker$ .and. ie < branch%n_ele_track - 1) then ele2 => branch%ele(ie+2) - if (ele1%name == ele2%name .and. ele1%key == ele2%key) call combine_eles (ele1, ele2, branch, error) + if (ele1%name == ele2%name .and. ele1%key == ele2%key) then + call combine_eles (ele1, ele2, branch, error) + if (error) return + endif endif enddo @@ -171,7 +175,7 @@ subroutine combine_eles (ele1, ele2, branch, error) ele1%value(voltage$) = 2 * ele1%value(voltage$) case (taylor$) - call concat_ele_taylor (ele1%taylor, ele2, ele1%taylor) + call concat_ele_taylor (ele1%taylor, ele2, ele1%taylor, error) end select diff --git a/bmad/code/make_hybrid_lat.f90 b/bmad/code/make_hybrid_lat.f90 index 349f00425b..3e03688839 100644 --- a/bmad/code/make_hybrid_lat.f90 +++ b/bmad/code/make_hybrid_lat.f90 @@ -279,9 +279,9 @@ subroutine make_hybrid_lat (lat_in, lat_out, use_taylor, orb0_arr) if (do_taylor) then if (associated(ele_in%taylor(1)%term)) then - call concat_ele_taylor (ele_out%taylor, ele_in, ele_out%taylor) + call concat_ele_taylor (ele_out%taylor, ele_in, ele_out%taylor, err_flag) else - call taylor_propagate1 (ele_out%taylor, ele_in, b_in%param) + call taylor_propagate1 (ele_out%taylor, ele_in, b_in%param, err_flag) endif else ele_out%mat6 = matmul(ele_in%mat6, ele_out%mat6) diff --git a/bmad/code/transfer_map_calc.f90 b/bmad/code/transfer_map_calc.f90 index 7dbeffe202..bf311ab801 100644 --- a/bmad/code/transfer_map_calc.f90 +++ b/bmad/code/transfer_map_calc.f90 @@ -111,7 +111,7 @@ subroutine transfer_map_calc (lat, t_map, err_flag, ix1, ix2, ref_orb, ix_branch if (i1 < i2) then do i = i1+1, i2 - call add_on_to_map (t_map, branch%ele(i)) + call add_on_to_map (t_map, branch%ele(i), err_flag) if (err_flag) return enddo @@ -119,11 +119,11 @@ subroutine transfer_map_calc (lat, t_map, err_flag, ix1, ix2, ref_orb, ix_branch elseif (branch%param%geometry == closed$) then do i = i1+1, branch%n_ele_track - call add_on_to_map (t_map, branch%ele(i)) + call add_on_to_map (t_map, branch%ele(i), err_flag) if (err_flag) return enddo do i = 1, i2 - call add_on_to_map (t_map, branch%ele(i)) + call add_on_to_map (t_map, branch%ele(i), err_flag) if (err_flag) return enddo @@ -133,7 +133,7 @@ subroutine transfer_map_calc (lat, t_map, err_flag, ix1, ix2, ref_orb, ix_branch if (unit_start_this) then do i = i2+1, i1 - call add_on_to_map (t_map, branch%ele(i)) + call add_on_to_map (t_map, branch%ele(i), err_flag) if (err_flag) return enddo call taylor_inverse (t_map, t_map) @@ -141,7 +141,7 @@ subroutine transfer_map_calc (lat, t_map, err_flag, ix1, ix2, ref_orb, ix_branch else call taylor_make_unit (a_map) do i = i2+1, i1 - call add_on_to_map (a_map, branch%ele(i)) + call add_on_to_map (a_map, branch%ele(i), err_flag) if (err_flag) return enddo call taylor_inverse (a_map, a_map) @@ -154,20 +154,23 @@ subroutine transfer_map_calc (lat, t_map, err_flag, ix1, ix2, ref_orb, ix_branch !-------------------------------------------------------- contains -subroutine add_on_to_map (map, ele) +subroutine add_on_to_map (map, ele, err_flag) type (taylor_struct) :: map(:) type (ele_struct) ele integer i, k +logical err_flag ! if (logic_option(.false., concat_if_possible) .and. associated(ele%taylor(1)%term)) then - call concat_ele_taylor (map, ele, map) + call concat_ele_taylor (map, ele, map, err_flag) else - call taylor_propagate1 (map, ele, branch%param, orb0) + call taylor_propagate1 (map, ele, branch%param, err_flag, orb0) endif +if (err_flag) return + ! Check for overflow ! Map term overflow defined by |term| > 10^(20*n) where n = sum(term_exponents) diff --git a/bmad/modules/transfer_map_mod.f90 b/bmad/modules/transfer_map_mod.f90 index 0d31deb1dc..4c4ab0644a 100644 --- a/bmad/modules/transfer_map_mod.f90 +++ b/bmad/modules/transfer_map_mod.f90 @@ -188,6 +188,8 @@ subroutine transfer_this_map (map, branch, s_1, s_2, error_flag, orb, concat_if_ ! Init ! Want to get the whole lattice if [s_1, s_2] spans the entire lattice +error_flag = .false. + if (s_1 == branch%ele(0)%s) then ix_ele = 1 else @@ -249,10 +251,10 @@ subroutine transfer_this_map (map, branch, s_1, s_2, error_flag, orb, concat_if_ ! Now for the integration step if (track_entire_ele .and. logic_option(.false., concat_if_possible) .and. associated(ele%taylor(1)%term)) then - call concat_ele_taylor (map, ele, map) + call concat_ele_taylor (map, ele, map, error_flag); if (error_flag) return call init_coord(orb, map%ref, ele, downstream_end$) else - call taylor_propagate1 (map, runt, branch%param, orb) + call taylor_propagate1 (map, runt, branch%param, error_flag, orb); if (error_flag) return call init_coord(orb, map%ref, runt, downstream_end$) endif diff --git a/bmad/ptc/ele_to_fibre.f90 b/bmad/ptc/ele_to_fibre.f90 index 6a6253677d..4b2bdaea4d 100644 --- a/bmad/ptc/ele_to_fibre.f90 +++ b/bmad/ptc/ele_to_fibre.f90 @@ -442,6 +442,7 @@ subroutine ele_to_fibre (ele, ptc_fibre, param, use_offsets, err_flag, integ_ord call out_io (s_fatal$, r_name, 'CONVERSION TO PTC NOT IMPLEMENTED FOR ELEMENTS OF TYPE ' // trim(key_name(ele%key)), & 'FOR ELEMENT: ' // trim(ele%name)) if (global_com%exit_on_error) call err_exit + return end select !------------------------------ diff --git a/bmad/ptc/ptc_interface_mod.f90 b/bmad/ptc/ptc_interface_mod.f90 index 26deaab448..c72c205ce7 100644 --- a/bmad/ptc/ptc_interface_mod.f90 +++ b/bmad/ptc/ptc_interface_mod.f90 @@ -2095,7 +2095,7 @@ end subroutine concat_taylor !------------------------------------------------------------------------ !------------------------------------------------------------------------ !+ -! Subroutine concat_ele_taylor (taylor1, ele, taylor3) +! Subroutine concat_ele_taylor (taylor1, ele, taylor3, err_flag) ! ! Routine to concatinate two taylor maps: ! taylor3[x] = ele_taylor(taylor1[x]) @@ -2105,14 +2105,15 @@ end subroutine concat_taylor ! Also see: concat_taylor ! ! Input: -! taylor1(6) -- Taylor_struct: Taylor map. -! ele -- ele_struct: Element containing a Taylor map. +! taylor1(6) -- Taylor_struct: Taylor map. +! ele -- ele_struct: Element containing a Taylor map. ! ! Output -! taylor3(6) -- Taylor_struct: Concatinated map +! taylor3(6) -- Taylor_struct: Concatinated map +! err_flag -- logical: Set True if there is an error. False otherwise. !- -Subroutine concat_ele_taylor (taylor1, ele, taylor3) +Subroutine concat_ele_taylor (taylor1, ele, taylor3, err_flag) use s_tracking, only: mis_fib, alloc, kill, dtiltd, assignment(=), real_8, fibre @@ -2127,9 +2128,12 @@ Subroutine concat_ele_taylor (taylor1, ele, taylor3) real(rp) beta0, beta1, tilt real(8) x_dp(6) logical err_flag +character(*), parameter :: r_name = 'concat_ele_taylor' ! Match elements are not implemented in PTC so just use the matrix. +err_flag = .false. + if (ele%key == match$) then call mat6_to_taylor (ele%vec0, ele%mat6, ele%taylor) call concat_taylor (taylor1, ele%taylor, taylor3) @@ -2154,6 +2158,10 @@ Subroutine concat_ele_taylor (taylor1, ele, taylor3) param%particle = positron$ ! Actually this does not matter to the calculation call ele_to_fibre (ele, fib, param, .true., err_flag) +if (err_flag) then + call out_io(s_error$, r_name, 'CANNOT USE ELEMENT WITH PTC: ' // ele_full_name(ele)) + return +endif ! Init @@ -2410,7 +2418,7 @@ end subroutine real_8_to_taylor !------------------------------------------------------------------------ !------------------------------------------------------------------------ !+ -! Subroutine taylor_propagate1 (bmad_taylor, ele, param, ref_in) +! Subroutine taylor_propagate1 (bmad_taylor, ele, param, err_flag, ref_in) ! ! Subroutine to track (symplectic integration) a taylor map through an element. ! The alternative routine, if ele has a taylor map, is concat_taylor. @@ -2427,10 +2435,11 @@ end subroutine real_8_to_taylor ! if the direction of propagation is backwards. ! ! Output: -! bmad_taylor(6) -- Taylor_struct: Map through element +! bmad_taylor(6) -- Taylor_struct: Map through element. +! err_flag -- logical: Set True if there is an error. False otherwise. !- -subroutine taylor_propagate1 (bmad_taylor, ele, param, ref_in) +subroutine taylor_propagate1 (bmad_taylor, ele, param, err_flag, ref_in) use s_tracking use mad_like, only: real_8, fibre, ptc_track => track @@ -2448,11 +2457,12 @@ subroutine taylor_propagate1 (bmad_taylor, ele, param, ref_in) real(rp) beta0, beta1, m2_rel logical err_flag +character(*), parameter :: r_name = 'taylor_propagate1' ! If the element is a taylor then just concat since this is faster. if (ele%key == taylor$) then - call concat_ele_taylor (bmad_taylor, ele, bmad_taylor) + call concat_ele_taylor (bmad_taylor, ele, bmad_taylor, err_flag) return endif @@ -2471,6 +2481,11 @@ subroutine taylor_propagate1 (bmad_taylor, ele, param, ref_in) ! track the map call ele_to_fibre (ele, ptc_fibre, param, .true., err_flag, ref_in = ref_in) +if (err_flag) then + call out_io(s_error$, r_name, 'CANNOT USE ELEMENT WITH PTC: ' // ele_full_name(ele)) + return +endif + call track_probe_x (ptc_tlr, ptc_private%base_state, fibre1 = bmadl%start) ! transfer ptc map back to bmad map diff --git a/tao/code/tao_graph_setup_mod.f90 b/tao/code/tao_graph_setup_mod.f90 index 4de00e3e6f..5f8174c0bd 100644 --- a/tao/code/tao_graph_setup_mod.f90 +++ b/tao/code/tao_graph_setup_mod.f90 @@ -2218,7 +2218,7 @@ subroutine tao_calc_data_at_s_pts (tao_lat, curve, comp_sign, good) character(100) why_invalid character(200) data_type character(*), parameter :: r_name = 'tao_calc_data_at_s_pts' -logical err, good(:), first_time, radiation_fluctuations_on, ok, gd +logical err_flag, good(:), first_time, radiation_fluctuations_on, ok, gd ! Some init @@ -2325,11 +2325,11 @@ subroutine tao_calc_data_at_s_pts (tao_lat, curve, comp_sign, good) ! Check if in a hybrid or taylor element within which interpolation cannot be done. - ix_ele_here = element_at_s (lat, s_now, .true., ix_branch, err) + ix_ele_here = element_at_s (lat, s_now, .true., ix_branch, err_flag) ele_here => branch%ele(ix_ele_here) - if (ele_here%key == hybrid$ .or. ele_here%key == taylor$ .or. err) then - if (err .or. s_last == ele_here%s) then + if (ele_here%key == hybrid$ .or. ele_here%key == taylor$ .or. err_flag) then + if (err_flag .or. s_last == ele_here%s) then good(ii) = .false. first_time = .true. cycle @@ -2363,8 +2363,8 @@ subroutine tao_calc_data_at_s_pts (tao_lat, curve, comp_sign, good) orbit%vec(1:5:2) = [curve%orbit%x, curve%orbit%y, 0.0_rp] orbit%t = curve%orbit%t orbit%s = s_now - value = tao_param_value_at_s (data_type, ele_here, orbit, err, why_invalid) - if (err) then + value = tao_param_value_at_s (data_type, ele_here, orbit, err_flag, why_invalid) + if (err_flag) then call tao_set_curve_invalid(curve, why_invalid, .true.) good = .false. bmad_com%radiation_fluctuations_on = radiation_fluctuations_on @@ -2432,21 +2432,21 @@ subroutine tao_calc_data_at_s_pts (tao_lat, curve, comp_sign, good) case ('lat') if (cache_status == using_cache$) then - ele = tao_branch%plot_cache(ii)%ele - orbit = tao_branch%plot_cache(ii)%orbit - mat6 = tao_branch%plot_cache(ii)%ele%mat6 - vec0 = tao_branch%plot_cache(ii)%ele%vec0 - err = tao_branch%plot_cache(ii)%err + ele = tao_branch%plot_cache(ii)%ele + orbit = tao_branch%plot_cache(ii)%orbit + mat6 = tao_branch%plot_cache(ii)%ele%mat6 + vec0 = tao_branch%plot_cache(ii)%ele%vec0 + err_flag = tao_branch%plot_cache(ii)%err else if (first_time) then - call twiss_and_track_at_s (lat, s_now, ele, orb, orbit, ix_branch, err, compute_floor_coords = .true.) + call twiss_and_track_at_s (lat, s_now, ele, orb, orbit, ix_branch, err_flag, compute_floor_coords = .true.) call mat6_from_s_to_s (lat, mat6, vec0, branch%ele(0)%s, x1, orb(0), ix_branch = ix_branch) orbit_end = orbit first_time = .false. else - call twiss_and_track_from_s_to_s (branch, orbit, s_now, orbit_end, ele, ele, err, compute_floor_coords = .true.) + call twiss_and_track_from_s_to_s (branch, orbit, s_now, orbit_end, ele, ele, err_flag, compute_floor_coords = .true.) mat6 = matmul(ele%mat6, mat6) vec0 = matmul(ele%mat6, vec0) + ele%vec0 orbit = orbit_end @@ -2458,10 +2458,10 @@ subroutine tao_calc_data_at_s_pts (tao_lat, curve, comp_sign, good) tao_branch%plot_cache(ii)%orbit = orbit tao_branch%plot_cache(ii)%ele%mat6 = mat6 tao_branch%plot_cache(ii)%ele%vec0 = vec0 - tao_branch%plot_cache(ii)%err = err + tao_branch%plot_cache(ii)%err = err_flag endif - if (err) then + if (err_flag) then tao_branch%plot_cache(ii:)%err = .true. good(ii:) = .false. bmad_com%radiation_fluctuations_on = radiation_fluctuations_on @@ -2484,8 +2484,8 @@ subroutine tao_calc_data_at_s_pts (tao_lat, curve, comp_sign, good) return end select - call this_value_at_s (data_type_select, sub_data_type, value, good(ii), ok, ii, & - s_last, s_now, tao_branch, orbit, lat, branch, ele); if (.not. ok) return + call this_value_at_s (data_type_select, sub_data_type, value, good(ii), ii, & + s_last, s_now, tao_branch, orbit, lat, branch, ele, err_flag); if (err_flag) return curve%y_line(ii) = curve%y_line(ii) + comp_sign * value s_last = s_now @@ -2505,9 +2505,9 @@ subroutine tao_calc_data_at_s_pts (tao_lat, curve, comp_sign, good) endif s_now = branch%ele(curve%ix_ele_ref)%s - call twiss_and_track_at_s (lat, s_now, ele, orb, orbit, ix_branch, err, compute_floor_coords = .true.) + call twiss_and_track_at_s (lat, s_now, ele, orb, orbit, ix_branch, err_flag, compute_floor_coords = .true.) - if (err) then + if (err_flag) then tao_branch%plot_cache(ii:)%err = .true. good(ii:) = .false. bmad_com%radiation_fluctuations_on = radiation_fluctuations_on @@ -2524,8 +2524,8 @@ subroutine tao_calc_data_at_s_pts (tao_lat, curve, comp_sign, good) return endif - call this_value_at_s (data_type_select, sub_data_type, value, gd, ok, ii, & - s_last, s_now, tao_branch, orbit, lat, branch, ele); if (.not. ok) return + call this_value_at_s (data_type_select, sub_data_type, value, gd, ii, & + s_last, s_now, tao_branch, orbit, lat, branch, ele, err_flag); if (.not. ok) return curve%y_line = curve%y_line - comp_sign * value end select @@ -2537,8 +2537,8 @@ subroutine tao_calc_data_at_s_pts (tao_lat, curve, comp_sign, good) !-------------------------------------------------------- contains -subroutine this_value_at_s (data_type_select, sub_data_type, value, good1, ok, ii, & - s_last, s_now, tao_branch, orbit, lat, branch, ele) +subroutine this_value_at_s (data_type_select, sub_data_type, value, good1, ii, & + s_last, s_now, tao_branch, orbit, lat, branch, ele, err_flag) type (coord_struct) orbit, orb_end type (tao_lattice_branch_struct) :: tao_branch @@ -2551,14 +2551,12 @@ subroutine this_value_at_s (data_type_select, sub_data_type, value, good1, ok, i real(rp) value, s_last, s_now, ds, m6(6,6), dalpha, dbeta, aa, bb, dE integer status, ii, i, j -logical good1, ok +logical good1, is_ok, err_flag character(*) data_type_select, sub_data_type character(40) name ! -ok = .true. - select case (data_type_select) case ('apparent_emit', 'norm_apparent_emit') @@ -2586,7 +2584,7 @@ subroutine this_value_at_s (data_type_select, sub_data_type, value, good1, ok, i ele_dum%key = overlay$ ! so entire attribute name table will be searched i = attribute_index(ele_dum, name) if (i < 1) goto 9000 - call pointer_to_attribute (ele_ref, name, .false., a_ptr, err, .false.) + call pointer_to_attribute (ele_ref, name, .false., a_ptr, err_flag, .false.) if (associated (a_ptr%r)) value = a_ptr%r case ('emit') @@ -2615,9 +2613,9 @@ subroutine this_value_at_s (data_type_select, sub_data_type, value, good1, ok, i case ('expression') this_ele => ele ! Need a pointer to an ele - call tao_evaluate_expression (data_type(12:), 1, .false., val_arr, err, .true., & + call tao_evaluate_expression (data_type(12:), 1, .false., val_arr, err_flag, .true., & dflt_source = 'at_ele', dflt_ele = this_ele, dflt_uni = tao_lat%u%ix_uni, & - dflt_orbit = orbit); if (err) goto 9000 ! Error message & Return + dflt_orbit = orbit); if (err_flag) goto 9000 ! Error message & Return value = val_arr(1) case ('momentum_compaction') @@ -2701,7 +2699,8 @@ subroutine this_value_at_s (data_type_select, sub_data_type, value, good1, ok, i expnt(k) = expnt(k) + 1 enddo call transfer_map_from_s_to_s (lat, t_map, s_last, s_now, ix_branch = ix_branch, & - unit_start = .false., concat_if_possible = s%global%concatenate_maps) + unit_start = .false., err_flag = err_flag, concat_if_possible = s%global%concatenate_maps) + if (err_flag) return value = taylor_coef (t_map(i), expnt) case ('chrom') @@ -2736,8 +2735,8 @@ subroutine this_value_at_s (data_type_select, sub_data_type, value, good1, ok, i value = sqrt(aa**2 + bb**2) case default - value = tao_param_value_at_s (data_type, ele, orbit, err, why_invalid) - if (err) then + value = tao_param_value_at_s (data_type, ele, orbit, err_flag, why_invalid) + if (err_flag) then call tao_set_curve_invalid(curve, why_invalid, .true.) goto 9100 ! Cleanup & Return endif @@ -2753,7 +2752,6 @@ subroutine this_value_at_s (data_type_select, sub_data_type, value, good1, ok, i good = .false. bmad_com%radiation_fluctuations_on = radiation_fluctuations_on if (cache_status == loading_cache$) tao_branch%plot_cache_valid = .false. -ok = .false. end subroutine this_value_at_s @@ -2893,7 +2891,7 @@ subroutine tao_curve_datum_calc (eles, plot, curve, who) integer i, j, m, ie, n_dat -logical err, valid +logical err_flag, valid logical, allocatable :: good(:) character(*) who @@ -2921,8 +2919,8 @@ subroutine tao_curve_datum_calc (eles, plot, curve, who) datum%data_source = curve%data_source datum%ix_branch = tao_branch_index(curve%ix_branch) -call tao_split_component (curve%component, scratch%comp, err) -if (err) then +call tao_split_component (curve%component, scratch%comp, err_flag) +if (err_flag) then call tao_set_curve_invalid (curve, 'BAD CURVE COMPONENT EXPRESSION: ' // curve%component) return endif diff --git a/tao/code/tao_quiet_set.f90 b/tao/code/tao_quiet_set.f90 index f8b19345bb..39849a9597 100644 --- a/tao/code/tao_quiet_set.f90 +++ b/tao/code/tao_quiet_set.f90 @@ -30,8 +30,11 @@ subroutine tao_quiet_set (set) name = s%global%quiet endif +elseif (set == 'ALL') then + name = set + else - call match_word (set, [character(12):: 'off', 'all', 'ALL'], ix, .false., .true., name) + call match_word (set, [character(12):: 'off', 'all'], ix, .false., .true., name) if (ix < 1) then call out_io (s_error$, r_name, 'BAD "quiet" COMMAND ARGUMENT: ' // set) return diff --git a/tao/version/tao_version_mod.f90 b/tao/version/tao_version_mod.f90 index 6138bd023c..e6751d5453 100644 --- a/tao/version/tao_version_mod.f90 +++ b/tao/version/tao_version_mod.f90 @@ -6,5 +6,5 @@ !- module tao_version_mod -character(*), parameter :: tao_version_date = "2024/08/14 01:16:46" +character(*), parameter :: tao_version_date = "2024/08/14 23:51:16" end module