Now setting particle_start%t will work in Tao. (bmad-sim#1536)

* Now setting particle_start%t will work in Tao.

Author: DavidSagan

bmad/code/set_ele_real_attribute.f90

@@ -51,6 +51,8 @@ subroutine set_ele_real_attribute (ele, attrib_name, value, err_flag, err_print_
   a_ptr%r = value
 elseif (associated(a_ptr%i)) then
   a_ptr%i = nint(value)
+elseif (associated(a_ptr%q)) then
+  a_ptr%q = nint(value)
 else
   if (logic_option(.true., err_print_flag)) then
     call out_io (s_error$, r_name, 'BAD ATTRIBUTE: ' // a_name)

sim_utils/interfaces/sim_utils_interface.f90

@@ -957,6 +957,15 @@ subroutine word_read (in_str, delim_list, word, ix_word, delim, delim_found, out
   logical, optional :: ignore_interior
 end subroutine
 
+subroutine set_all_ptr (a_ptr, value, delta, value_set)
+  import
+  implicit none
+  type (all_pointer_struct) a_ptr
+  real(rp) value
+  real(rp), optional :: value_set
+  logical, optional :: delta
+end subroutine
+
 subroutine str_substitute (string, str_match, str_replace, do_trim, ignore_escaped)
   implicit none
   character(*) string
@@ -994,6 +1003,13 @@ subroutine string_trim (in_string, out_string, word_len)
   integer word_len
 end subroutine string_trim
 
+function value_of_all_ptr (a_ptr) result (value)
+  import
+  implicit none
+  type (all_pointer_struct) a_ptr
+  real(rp) value
+end function value_of_all_ptr
+
 function virtual_memory_usage() result (usage)
   implicit none
   integer usage

sim_utils/interfaces/sim_utils_struct.f90

@@ -219,57 +219,5 @@ function is_false (param) result (this_false)
 
 end function is_false
 
-!-------------------------------------------------------------------------------------------
-!-------------------------------------------------------------------------------------------
-!-------------------------------------------------------------------------------------------
-!+
-! Function value_of_all_ptr (a_ptr) result (value)
-!
-! Routine to return the value pointed to by an all_pointer_struct.
-!
-! Input:
-!   a_ptr -- all_pointer_struct: Pointer to a variable
-!
-! Output:
-!   value -- real(rp): Value pointed to by a_ptr. Set to true$ or false$ if a_ptr%l is associated. 
-!                      Set to real_garbage$ if the number of pointer components of a_ptr that
-!                      are associated is not 1 (that is, value is not unique).
-!-
-
-function value_of_all_ptr (a_ptr) result (value)
-
-type (all_pointer_struct) a_ptr
-real(rp) value
-integer n
-
-!
-
-
-n = 0
-
-if (associated(a_ptr%r)) then
-  n = n + 1
-  value = a_ptr%r
-endif
-
-if (associated(a_ptr%i)) then
-  n = n + 1
-  value = a_ptr%i
-endif
-
-if (associated(a_ptr%l)) then
-  n = n + 1
-  if (a_ptr%l) then
-    value = true$
-  else
-    value = false$
-  endif
-endif
-
-if (n /= 1) then
-  value = real_garbage$
-endif
-
-end function value_of_all_ptr
-
 end module
+

sim_utils/misc/set_all_ptr.f90

@@ -0,0 +1,80 @@
+!+
+! Subroutine set_all_ptr (a_ptr, value, delta, value_set)
+!
+! Routine to set real or integer value pointed to by a_ptr.
+! If more than one thing is pointed to, an error is generated.
+!
+! Input:
+!   a_ptr       -- all_pointer_struct: Pointer to a variable
+!   value       -- real(rp): Value to load. An error is generated if the number of pointer components 
+!                      of a_ptr that are associated is not 1.
+!   delta       -- real(rp): Default False. If True, load value as a change in value.
+!
+! Output:
+!   a_ptr       -- all_pointer_struct: Value set.
+!   value_set   -- real(rp): Value set. Useful when delta = True.
+!-
+
+subroutine set_all_ptr (a_ptr, value, delta, value_set)
+
+use sim_utils, dummy => set_all_ptr
+
+implicit none
+
+type (all_pointer_struct) a_ptr
+real(rp) value
+real(rp), optional :: value_set
+logical, optional :: delta
+integer n
+character(*), parameter :: r_name = 'set_all_ptr'
+
+
+!
+
+n = 0
+
+if (associated(a_ptr%r)) then
+  n = n + 1
+  if (logic_option(.false., delta)) then
+    a_ptr%r = a_ptr%r + value
+  else
+    a_ptr%r = value
+  endif
+  if (present(value_set)) value_set = a_ptr%r
+endif
+
+if (associated(a_ptr%q)) then
+  n = n + 1
+  if (logic_option(.false., delta)) then
+    a_ptr%q = a_ptr%q + value
+  else
+    a_ptr%q = value
+  endif
+  if (present(value_set)) value_set = a_ptr%q
+endif
+
+
+if (associated(a_ptr%i)) then
+  n = n + 1
+  if (logic_option(.false., delta)) then
+    a_ptr%i = a_ptr%i + nint(value)
+  else
+    a_ptr%i = nint(value)
+  endif
+  if (present(value_set)) value_set = a_ptr%i
+endif
+
+if (n == 1) return
+
+if (n == 0) then
+  call out_io(s_error$, r_name, 'POINTER NOT ASSOCIATED! PLEASE REPORT THIS!')
+  return
+endif
+
+if (n > 1) then
+  call out_io(s_error$, r_name, 'MULTIPLE ASSOCIATED POINTERS! PLEASE REPORT THIS!')
+  return
+endif
+
+end subroutine set_all_ptr
+

sim_utils/misc/value_of_all_ptr.f90

@@ -0,0 +1,59 @@
+!+
+! Function value_of_all_ptr (a_ptr) result (value)
+!
+! Routine to return the value pointed to by an all_pointer_struct.
+!
+! Input:
+!   a_ptr -- all_pointer_struct: Pointer to a variable
+!
+! Output:
+!   value -- real(rp): Value pointed to by a_ptr. Set to true$ or false$ if a_ptr%l is associated. 
+!                      Set to real_garbage$ if the number of pointer components of a_ptr that
+!                      are associated is not 1 (that is, value is not unique).
+!-
+
+function value_of_all_ptr (a_ptr) result (value)
+
+use sim_utils_interface, dummy => value_of_all_ptr
+
+implicit none
+
+type (all_pointer_struct) a_ptr
+real(rp) value
+integer n
+
+!
+
+
+n = 0
+
+if (associated(a_ptr%r)) then
+  n = n + 1
+  value = a_ptr%r
+endif
+
+if (associated(a_ptr%i)) then
+  n = n + 1
+  value = a_ptr%i
+endif
+
+if (associated(a_ptr%q)) then
+  n = n + 1
+  value = a_ptr%q
+endif
+
+if (associated(a_ptr%l)) then
+  n = n + 1
+  if (a_ptr%l) then
+    value = true$
+  else
+    value = false$
+  endif
+endif
+
+if (n /= 1) then
+  value = real_garbage$
+endif
+
+end function value_of_all_ptr
+

tao/code/tao_change_mod.f90

@@ -235,7 +235,7 @@ subroutine tao_change_ele (ele_name, attrib_name, num_str, update, err_flag)
 type (ele_pointer_struct), allocatable :: eles(:)
 
 real(rp), allocatable :: change_number(:), old_value(:)
-real(rp) new_merit, old_merit, new_value, delta, max_val
+real(rp) new_merit, old_merit, delta, max_val, new_value, design_value
 
 integer i, ix, iu, nl, len_name, nd
 integer, parameter :: len_lines = 200
@@ -331,23 +331,24 @@ subroutine tao_change_ele (ele_name, attrib_name, num_str, update, err_flag)
   do i = 1, nd
     if (.not. free(i)) cycle
 
-    old_value(i) = m_ptr(i)%r
+    old_value(i) = value_of_all_ptr(m_ptr(i))
+    design_value = value_of_all_ptr(d_ptr(i))
 
     if (abs_or_rel == '@') then
-      m_ptr(i)%r = change_number(i)
+      call set_all_ptr(m_ptr(i), change_number(i), value_set = new_value)
     elseif (abs_or_rel == 'd') then
-      m_ptr(i)%r = d_ptr(i)%r + change_number(i)
+      call set_all_ptr(m_ptr(i), design_value + change_number(i), value_set = new_value)
     elseif (abs_or_rel == '%') then
-      m_ptr(i)%r = m_ptr(i)%r * (1 + 0.01 * change_number(i))
+      call set_all_ptr(m_ptr(i), old_value(i) * (1 + 0.01 * change_number(i)), value_set = new_value)
     else
-      m_ptr(i)%r = m_ptr(i)%r + change_number(i)
+      call set_all_ptr(m_ptr(i), change_number(i), delta = .true., value_set = new_value)
     endif
 
-    delta = m_ptr(i)%r - old_value(i)
+    delta = new_value - old_value(i)
 
     call tao_set_flags_for_changed_attribute(u, e_name, eles(i)%ele, m_ptr(i), who = a_name)
 
-    max_val = max(abs(old_value(i)), abs(m_ptr(i)%r), abs(d_ptr(1)%r)) 
+    max_val = max(abs(old_value(i)), abs(new_value), abs(design_value)) 
     str = real_num_fortran_format(max_val, 14, 2)
     fmt = '(5' // trim(str) // ', 4x, a)'
 
@@ -356,9 +357,8 @@ subroutine tao_change_ele (ele_name, attrib_name, num_str, update, err_flag)
     if (nl < 11) then
       name = 'PARTICLE_START'
       if (associated(eles(i)%ele)) name = eles(i)%ele%name
-      nl=nl+1; write (lines(nl), fmt) old_value(i), m_ptr(i)%r, &
-                              old_value(i)-d_ptr(i)%r, m_ptr(i)%r-d_ptr(i)%r, &
-                              m_ptr(i)%r-old_value(i), trim(name)
+      nl=nl+1; write (lines(nl), fmt) old_value(i), new_value, old_value(i)-design_value, &
+                                                    new_value-design_value, delta, trim(name)
     else
       if (.not. etc_added) then
         nl=nl+1; lines(nl) = '   ... etc ...'

tao/code/tao_set_flags_for_changed_attribute.f90

@@ -45,6 +45,7 @@ subroutine tao_set_flags_for_changed_attribute (u, ele_name, ele_ptr, val_ptr, w
   select case (who)
   case ('PZ');        lat%particle_start%p0c = 0
   case ('E_PHOTON');  lat%particle_start%vec(6) = 0
+  case ('T');         lat%particle_start%vec(5) = real_garbage$   ! So time is used instead of z.
   end select
   return
 endif

tao/code/tao_set_mod.f90

@@ -1374,7 +1374,13 @@ subroutine tao_set_particle_start_cmd (who, value_str)
 
     ! Set value
 
-    a_ptr(1)%r = set_val(1)
+    if (associated(a_ptr(1)%r)) then
+      a_ptr(1)%r = set_val(1)
+    elseif (associated(a_ptr(1)%q)) then ! Time is quad precision
+      a_ptr(1)%q = set_val(1)
+    else
+      call out_io(s_error$, r_name, 'Bad particle_start component: ' // who2)
+    endif
   endif
 
   call tao_set_flags_for_changed_attribute (u, 'PARTICLE_START', who = who2)

tao/version/tao_version_mod.f90

@@ -6,5 +6,5 @@
 !-
 
 module tao_version_mod
-character(*), parameter :: tao_version_date = "2025/05/23 00:07:15"
+character(*), parameter :: tao_version_date = "2025/05/23 10:25:08"
 end module