diff --git a/bmad/modules/rad_6d_mod.f90 b/bmad/modules/rad_6d_mod.f90 index b5627ceb8c..c8ba06a634 100644 --- a/bmad/modules/rad_6d_mod.f90 +++ b/bmad/modules/rad_6d_mod.f90 @@ -19,7 +19,7 @@ module rad_6d_mod !------------------------------------------------------------------------------------- !------------------------------------------------------------------------------------- !+ -! Subroutine emit_6d (ele_ref, include_opening_angle, mode, sigma_mat) +! Subroutine emit_6d (ele_ref, include_opening_angle, mode, sigma_mat, closed_orbit) ! ! Routine to calculate the three normal mode emittances, damping partition numbers, etc. ! Since the emattances, etc. are only an invariant in the limit of zero damping, the calculated @@ -29,13 +29,14 @@ module rad_6d_mod ! ele_ref -- ele_struct: Origin of the 1-turn maps used to evaluate the emittances. ! include_opening_angle -- logical: If True include the effect of the vertical opening angle of emitted radiation. ! Generally use True unless comparing against other codes. +! closed_orbit(0:) -- coord_struct, optional: Closed orbit. If not present this routine will calculate it. ! ! Output: ! mode -- normal_modes_struct: Emittance and other info. ! sigma_mat(6,6) -- real(rp): Sigma matrix !- -subroutine emit_6d (ele_ref, include_opening_angle, mode, sigma_mat) +subroutine emit_6d (ele_ref, include_opening_angle, mode, sigma_mat, closed_orbit) use f95_lapack, only: dgesv_f95 @@ -45,6 +46,7 @@ subroutine emit_6d (ele_ref, include_opening_angle, mode, sigma_mat) type (branch_struct), pointer :: branch type (normal_modes_struct) mode type (rad_map_struct) rmap +type (coord_struct), optional, target :: closed_orbit(0:) real(rp) sigma_mat(6,6), rf65, sig_s(6,6), mat6(6,6), xfer_nodamp_mat(6,6) real(rp) mt(21,21), v_sig(21,1) @@ -66,7 +68,7 @@ subroutine emit_6d (ele_ref, include_opening_angle, mode, sigma_mat) mode = normal_modes_struct() sigma_mat = 0 -call rad_damp_and_stoc_mats (ele_ref, ele_ref, include_opening_angle, rmap, mode, xfer_nodamp_mat, err) +call rad_damp_and_stoc_mats (ele_ref, ele_ref, include_opening_angle, rmap, mode, xfer_nodamp_mat, err, closed_orbit) if (err) return ! If there is no RF then add a small amount to enable the calculation to proceed. @@ -171,7 +173,7 @@ end subroutine emit_6d !------------------------------------------------------------------------------------- !------------------------------------------------------------------------------------- !+ -! Subroutine rad_damp_and_stoc_mats (ele1, ele2, include_opening_angle, rmap, mode, xfer_nodamp_mat) +! Subroutine rad_damp_and_stoc_mats (ele1, ele2, include_opening_angle, rmap, mode, xfer_nodamp_mat, closed_orbit) ! ! Routine to calculate the damping and stochastic variance matrices from exit end of ele1 ! to the exit end of ele2. Use ele1 = ele2 to get 1-turn matrices. @@ -187,6 +189,7 @@ end subroutine emit_6d ! ele2 -- ele_struct: End element of integration range. ! include_opening_angle -- logical: If True include the effect of the vertical opening angle of emitted radiation. ! Generally use True unless comparing against other codes. +! closed_orbit(0:) -- coord_struct, optional: Closed orbit. If not present this routine will calculate it. ! ! Output: ! rmap -- rad_map_struct: Damping and stochastic mats @@ -198,7 +201,7 @@ end subroutine emit_6d ! err_flag -- logical: Set true if there is a problem. !- -subroutine rad_damp_and_stoc_mats (ele1, ele2, include_opening_angle, rmap, mode, xfer_nodamp_mat, err_flag) +subroutine rad_damp_and_stoc_mats (ele1, ele2, include_opening_angle, rmap, mode, xfer_nodamp_mat, err_flag, closed_orbit) type (ele_struct), allocatable :: eles_save(:) type (ele_struct), target :: ele1, ele2 @@ -208,7 +211,9 @@ subroutine rad_damp_and_stoc_mats (ele1, ele2, include_opening_angle, rmap, mode type (branch_struct), pointer :: branch type (bmad_common_struct) bmad_com_save type (rad_map_struct), allocatable :: rm1(:) -type (coord_struct), allocatable :: closed_orb(:) +type (coord_struct), optional, target :: closed_orbit(0:) +type (coord_struct), pointer :: closed_orb(:) +type (coord_struct), allocatable, target :: closed(:) real(rp) sig_mat(6,6), mt(6,6), xfer_nodamp_mat(6,6), tol, length integer ie @@ -232,12 +237,17 @@ subroutine rad_damp_and_stoc_mats (ele1, ele2, include_opening_angle, rmap, mode bmad_com%radiation_fluctuations_on = .false. bmad_com%spin_tracking_on = .false. -if (rf_is_on(branch)) then +if (present(closed_orbit)) then + closed_orb => closed_orbit + err_flag = .false. +elseif (rf_is_on(branch)) then bmad_com%radiation_damping_on = .true. - call closed_orbit_calc(branch%lat, closed_orb, 6, +1, branch%ix_branch, err_flag) + call closed_orbit_calc(branch%lat, closed, 6, +1, branch%ix_branch, err_flag) + closed_orb => closed else bmad_com%radiation_damping_on = .false. - call closed_orbit_calc(branch%lat, closed_orb, 4, +1, branch%ix_branch, err_flag) + call closed_orbit_calc(branch%lat, closed, 4, +1, branch%ix_branch, err_flag) + closed_orb => closed endif bmad_com = bmad_com_save @@ -248,8 +258,10 @@ subroutine rad_damp_and_stoc_mats (ele1, ele2, include_opening_angle, rmap, mode goto 9000 endif -call lat_make_mat6 (ele1_track%branch%lat, -1, closed_orb, branch%ix_branch, err_flag) -if (err_flag) goto 9000 ! Restore and return +if (.not. present(closed_orbit)) then + call lat_make_mat6 (ele1_track%branch%lat, -1, closed_orb, branch%ix_branch, err_flag) + if (err_flag) goto 9000 ! Restore and return +endif ! Calculate element-by-element damping and stochastic mats. diff --git a/tao/code/tao_init.f90 b/tao/code/tao_init.f90 index 55fdce9941..f342018290 100644 --- a/tao/code/tao_init.f90 +++ b/tao/code/tao_init.f90 @@ -324,8 +324,8 @@ subroutine tao_init (err_flag) if (branch%param%geometry == closed$) then call chrom_calc (tao_lat%lat, s%global%delta_e_chrom, tao_branch%a%chrom, tao_branch%b%chrom, err, & tao_branch%orbit(0)%vec(6), low_E_lat=tao_lat%low_E_lat, high_E_lat=tao_lat%high_E_lat, ix_branch = ib) - call emit_6d(branch%ele(0), .false., tao_branch%modes_6d, sigma) - call emit_6d(branch%ele(0), .true., tao_branch%modes_6d, sigma) + call emit_6d(branch%ele(0), .false., tao_branch%modes_6d, sigma, tao_branch%orbit) + call emit_6d(branch%ele(0), .true., tao_branch%modes_6d, sigma, tao_branch%orbit) tao_branch%modes_6d%momentum_compaction = momentum_compaction(branch) if (tao_branch%modes_6d%a%j_damp < 0 .or. tao_branch%modes_6d%b%j_damp < 0 .or. & (tao_branch%modes_6d%z%j_damp < 0 .and. rf_is_on(branch))) then diff --git a/tao/code/tao_lattice_calc_mod.f90 b/tao/code/tao_lattice_calc_mod.f90 index 2ec6539948..a297c522f8 100644 --- a/tao/code/tao_lattice_calc_mod.f90 +++ b/tao/code/tao_lattice_calc_mod.f90 @@ -178,7 +178,7 @@ subroutine tao_single_track (tao_lat, calc_ok, ix_branch, print_err) if (branch%param%particle /= photon$ .and. s%global%rad_int_calc_on .and. tao_branch%track_state == moving_forward$ .and. & (s%com%force_rad_int_calc .or. u%calc%rad_int_for_data .or. u%calc%rad_int_for_plotting .or. s%global%track_type == 'beam')) then - call emit_6d(branch%ele(0), .true., tao_branch%modes_ri, sigma) + call emit_6d(branch%ele(0), .true., tao_branch%modes_6d, sigma, tao_branch%orbit) endif end subroutine tao_single_track diff --git a/tao/code/tao_python_cmd.f90 b/tao/code/tao_python_cmd.f90 index 36ee964be0..5a443f663d 100644 --- a/tao/code/tao_python_cmd.f90 +++ b/tao/code/tao_python_cmd.f90 @@ -6311,7 +6311,7 @@ subroutine tao_python_cmd (input_str) pz = tao_branch%orbit(0)%vec(6), ix_branch = branch%ix_branch) call calc_z_tune(branch) call radiation_integrals (branch%lat, tao_branch%orbit, tao_branch%modes_ri, tao_branch%ix_rad_int_cache, branch%ix_branch) - call emit_6d(branch%ele(0), .true., tao_branch%modes_ri, mat6) + call emit_6d(branch%ele(0), .true., tao_branch%modes_6d, mat6, tao_branch%orbit) n = branch%n_ele_track time1 = branch%ele(n)%ref_time gamma = branch%ele(0)%value(e_tot$) / mass_of(branch%param%particle) diff --git a/tao/code/tao_show_this.f90 b/tao/code/tao_show_this.f90 index 06027a40a7..f04e5114cb 100644 --- a/tao/code/tao_show_this.f90 +++ b/tao/code/tao_show_this.f90 @@ -5641,8 +5641,8 @@ subroutine tao_show_this (what, result_id, lines, nl) if (lat%param%geometry == closed$) then u%model%high_e_lat = u%model%lat ele2 => u%model%high_e_lat%branch(ix_branch)%ele(0) - call emit_6d (ele2, .false., tao_branch%modes_6d, sig_mat) - call emit_6d (ele2, .true., tao_branch%modes_6d, sig_mat) + call emit_6d (ele2, .false., tao_branch%modes_6d, sig_mat, tao_branch%orbit) + call emit_6d (ele2, .true., tao_branch%modes_6d, sig_mat, tao_branch%orbit) if (tao_branch%modes_6d%a%j_damp < 0 .or. tao_branch%modes_6d%b%j_damp < 0 .or. & (tao_branch%modes_6d%z%j_damp < 0 .and. rf_is_on(branch))) then call out_io (s_info$, r_name, & diff --git a/tao/version/tao_version_mod.f90 b/tao/version/tao_version_mod.f90 index 6f9de6f165..71a53b4689 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 = "2023/10/06 18:11:34" +character(*), parameter :: tao_version_date = "2023/10/07 16:36:38" end module