Merge pull request #559 from bmad-sim/devel/step26

Fix last checkin.

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.
 

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

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

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)

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, &

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