Fix bookkeeping when controller controls Cartesian map parameter.

bmad/code/pointer_to_attribute.f90

@@ -1,37 +1,44 @@
 !+
-! Subroutine pointer_to_attribute (ele, attrib_name, do_allocation, a_ptr, err_flag, err_print_flag, ix_attrib)
+! Subroutine pointer_to_attribute (ele, attrib_name, do_allocation, a_ptr, err_flag, err_print_flag, ix_attrib, do_unlink)
 !
 ! Returns a pointer to an attribute of an element ele with attribute name attrib_name.
 ! Note: Use attribute_free to see if the attribute may be varied independently.
 ! Note: This routine will not work on bmad_com components. Rather use pointers_to_attribute.
+!
+! Note: To save memory, ele%cartesian_map (and other field maps), can point to the same memory location as the 
+! Cartesian maps of other elements. This linkage is not desired if the attribute to be pointed to is varied. 
+! In this case, the do_unlink argumnet should be set to True.
+!
 ! Note: Alternatively consider the routines:
 !     pointers_to_attribute
 !     set_ele_attribute
 !     value_of_attribute
 !
 ! Input:
-!   ele             -- Ele_struct: After this routine finishes Ptr_attrib 
+!   ele             -- ele_struct: After this routine finishes Ptr_attrib 
 !                        will point to a variable within this element.
-!   attrib_name     -- Character(40): Name of attribute. Must be uppercase.
+!   attrib_name     -- character(40): Name of attribute. Must be uppercase.
 !                       For example: "HKICK".
-!   do_allocation   -- Logical: If True then do an allocation if needed.
+!   do_allocation   -- logical: If True then do an allocation if needed.
 !                       EG: The multipole An and Bn arrays need to be allocated
 !                       before their use.
-!   err_print_flag  -- Logical, optional: If present and False then suppress
+!   err_print_flag  -- logical, optional: If present and False then suppress
 !                       printing of an error message on error.
+!   do_unlink       -- logical, optional: Default False. If True and applicable, unlink the structure containing the attribute.
+!                       See above for details.
 !
 ! Output:
 !   a_ptr      -- all_pointer_struct: Pointer to the attribute. 
 !     %r           -- pointer to real attribute. Nullified if error or attribute is not real.               
 !     %i           -- pointer to integer attribute. Nullified if error or attribute is not integer.
 !     %l           -- pointer to logical attribute. Nullified if error or attribute is not logical.               
-!   err_flag   -- Logical: Set True if attribtute not found. False otherwise.
-!   ix_attrib  -- Integer, optional: If applicable, this is the index to the 
+!   err_flag   -- logical: Set True if attribtute not found. False otherwise.
+!   ix_attrib  -- integer, optional: If applicable, this is the index to the 
 !                     attribute in the ele%value(:), ele%control%var(:), ele%a_pole(:) or ele%b_pole(:) arrays.
 !                     Set to 0 if not in any of these arrays.
 !-
 
-subroutine pointer_to_attribute (ele, attrib_name, do_allocation, a_ptr, err_flag, err_print_flag, ix_attrib)
+subroutine pointer_to_attribute (ele, attrib_name, do_allocation, a_ptr, err_flag, err_print_flag, ix_attrib, do_unlink)
 
 use bmad_interface, except_dummy => pointer_to_attribute
 
@@ -41,6 +48,7 @@ subroutine pointer_to_attribute (ele, attrib_name, do_allocation, a_ptr, err_fla
 type (ele_struct), pointer :: slave
 type (wake_lr_mode_struct), allocatable :: lr_mode(:)
 type (cartesian_map_struct), pointer :: ct_map
+type (cartesian_map_term_struct), pointer :: ct_ptr
 type (cartesian_map_term1_struct), pointer :: ct_term
 type (cylindrical_map_struct), pointer :: cl_map
 type (grid_field_struct), pointer :: g_field
@@ -64,7 +72,7 @@ subroutine pointer_to_attribute (ele, attrib_name, do_allocation, a_ptr, err_fla
 character(24) :: r_name = 'pointer_to_attribute'
 
 logical err_flag, do_allocation, do_print, err, out_of_bounds
-logical, optional :: err_print_flag
+logical, optional :: err_print_flag, do_unlink
 
 ! init check
 
@@ -263,6 +271,15 @@ subroutine pointer_to_attribute (ele, attrib_name, do_allocation, a_ptr, err_fla
   n_cc = get_this_index(a_name, 14, err, 1, size(ele%cartesian_map))
   if (err) goto 9140
   ct_map => ele%cartesian_map(n_cc)
+  if (.not. associated(ct_map%ptr)) return
+
+  ct_ptr => ct_map%ptr
+  if (logic_option(.false., do_unlink) .and. ct_map%ptr%n_link > 1) then
+    ct_map%ptr%n_link = ct_map%ptr%n_link - 1
+    allocate(ct_map%ptr)
+    ct_map%ptr = ct_ptr
+    ct_map%ptr%n_link = 1
+  endif
 
   if (a_name(1:3) == '%T(' .or. a_name(1:6) == '%TERM(') then
     nt = get_this_index(a_name, index(a_name, '('), err, 1, size(ct_map%ptr%term))
@@ -306,15 +323,15 @@ subroutine pointer_to_attribute (ele, attrib_name, do_allocation, a_ptr, err_fla
   cl_map => ele%cylindrical_map(n_cc)
 
   select case (a_name)
-  case ('%PHI0_FIELDMAP');    a_ptr%r => cl_map%phi0_fieldmap
-  case ('%THETA0_AZIMUTH');   a_ptr%r => cl_map%theta0_azimuth
-  case ('%FIELD_SCALE');      a_ptr%r => cl_map%field_scale
-  case ('%DZ');               a_ptr%r => cl_map%dz
+  case ('%PHI0_FIELDMAP');    a_ptr%r  => cl_map%phi0_fieldmap
+  case ('%THETA0_AZIMUTH');   a_ptr%r  => cl_map%theta0_azimuth
+  case ('%FIELD_SCALE');      a_ptr%r  => cl_map%field_scale
+  case ('%DZ');               a_ptr%r  => cl_map%dz
   case ('%R0');               a_ptr%r1 => cl_map%r0
-  case ('%R0(1)');            a_ptr%r => cl_map%r0(1)
-  case ('%R0(2)');            a_ptr%r => cl_map%r0(2)
-  case ('%R0(3)');            a_ptr%r => cl_map%r0(3)
-  case ('%MASTER_PARAMETER'); a_ptr%i => cl_map%master_parameter
+  case ('%R0(1)');            a_ptr%r  => cl_map%r0(1)
+  case ('%R0(2)');            a_ptr%r  => cl_map%r0(2)
+  case ('%R0(3)');            a_ptr%r  => cl_map%r0(3)
+  case ('%MASTER_PARAMETER'); a_ptr%i  => cl_map%master_parameter
   case default;           goto 9000
   end select
 

bmad/code/pointers_to_attribute.f90

@@ -1,6 +1,6 @@
 !+
 ! Subroutine pointers_to_attribute (lat, ele_name, attrib_name, do_allocation,
-!                     ptr_array, err_flag, err_print_flag, eles, ix_attrib)
+!                     ptr_array, err_flag, err_print_flag, eles, ix_attrib, do_unlink)
 !
 ! Returns an array of pointers to an attribute with name attrib_name within elements with name ele_name.
 !
@@ -43,7 +43,7 @@
 !-
 
 Subroutine pointers_to_attribute (lat, ele_name, attrib_name, do_allocation, &
-                        ptr_array, err_flag, err_print_flag, eles, ix_attrib)
+                        ptr_array, err_flag, err_print_flag, eles, ix_attrib, do_unlink)
 
 use bmad_interface, except_dummy => pointers_to_attribute
 
@@ -65,7 +65,7 @@ Subroutine pointers_to_attribute (lat, ele_name, attrib_name, do_allocation, &
 character(*), parameter :: r_name = 'pointers_to_attribute'
 
 logical err_flag, do_allocation, do_print
-logical, optional :: err_print_flag
+logical, optional :: err_print_flag, do_unlink
 
 ! init
 
@@ -285,7 +285,7 @@ Subroutine pointers_to_attribute (lat, ele_name, attrib_name, do_allocation, &
 call re_allocate (ptrs, n_loc)
 n = 0
 do i = 1, n_loc
-  call pointer_to_attribute (eles2(i)%ele, attrib_name, do_allocation, a_ptr, err_flag, .false., ix_a)
+  call pointer_to_attribute (eles2(i)%ele, attrib_name, do_allocation, a_ptr, err_flag, .false., ix_a, do_unlink)
   if (err_flag) cycle
   n = n + 1
   ptrs(n) = a_ptr

bmad/code/set_ele_attribute.f90

@@ -32,9 +32,8 @@
 
 subroutine set_ele_attribute (ele, set_string, err_flag, err_print_flag, set_lords)
 
-use bmad_parser_mod, dummy => set_ele_attribute
-use bmad_interface, dummy2 => set_ele_attribute
-
+use bmad_interface, dummy => set_ele_attribute
+use bmad_parser_struct, only: bp_com, bp_com2, stack_file_struct, bp_common_struct, redef$
 
 implicit none
 

bmad/code/set_ele_real_attribute.f90

@@ -46,7 +46,7 @@ subroutine set_ele_real_attribute (ele, attrib_name, value, err_flag, err_print_
 call str_upcase (a_name, attrib_name)
 if (.not. attribute_free (ele, a_name, err_print_flag, dependent_attribs_free = .true.)) return
 
-call pointer_to_attribute (ele, attrib_name, .true., a_ptr, err_flag)
+call pointer_to_attribute (ele, attrib_name, .true., a_ptr, err_flag, do_unlink = .true.)
 if (associated(a_ptr%r)) then
   a_ptr%r = value
 elseif (associated(a_ptr%i)) then

bmad/low_level/ramper_slave_setup.f90

@@ -105,7 +105,7 @@ recursive subroutine set_this_slave (slave, lord, ix_control, r1, lat, n_slave,
 
 ! Check attribute.
 
-call pointer_to_attribute (slave, r1%attribute, .true., a_ptr, err, .false.)
+call pointer_to_attribute (slave, r1%attribute, .true., a_ptr, err, .false., do_unlink = .true.)
 if (err .or. .not. associated(a_ptr%r)) then
   if (has_wild) return
   call out_io (s_error$, r_name, 'BAD SLAVE ATTRIBUTE FOR RAMPER LORD: ' // lord%name, &

bmad/modules/bmad_routine_interface.f90

@@ -1675,11 +1675,24 @@ subroutine order_super_lord_slaves (lat, ix_lord)
 
 subroutine converter_distribution_parser (ele, delim, delim_found, err_flag)
   import
+  implicit none
   type (ele_struct), target :: ele
   character(*) delim
   logical delim_found, err_flag
 end subroutine
 
+subroutine parser_set_attribute (how, ele, delim, delim_found, err_flag, pele, check_free, heterogeneous_ele_list, set_field_master)
+  use bmad_parser_struct, only: parser_ele_struct
+  import
+  implicit none
+  type (ele_struct), target :: ele
+  type (parser_ele_struct), optional :: pele
+  integer how
+  character(1) delim
+  logical, target :: delim_found, err_flag
+  logical, optional :: check_free, heterogeneous_ele_list, set_field_master
+end subroutine
+
 function particle_is_moving_backwards (orbit) result (is_moving_backwards)
   import
   implicit none
@@ -1739,15 +1752,15 @@ function physical_ele_end (track_end, orbit, ele_orientation, return_stream_end)
   logical, optional :: return_stream_end
 end function
 
-subroutine pointer_to_attribute (ele, attrib_name, do_allocation, a_ptr, err_flag, err_print_flag, ix_attrib)
+subroutine pointer_to_attribute (ele, attrib_name, do_allocation, a_ptr, err_flag, err_print_flag, ix_attrib, do_unlink)
   import
   implicit none
   type (ele_struct), target :: ele
   type (all_pointer_struct) a_ptr
   character(*) attrib_name
   logical err_flag
   logical do_allocation
-  logical, optional :: err_print_flag
+  logical, optional :: err_print_flag, do_unlink
   integer, optional :: ix_attrib
 end subroutine
 
@@ -1830,15 +1843,15 @@ function pointer_to_wake_ele (ele, delta_s) result (wake_ele)
 end function
 
 subroutine pointers_to_attribute (lat, ele_name, attrib_name, do_allocation, &
-                  ptr_array, err_flag, err_print_flag, eles, ix_attrib)
+                  ptr_array, err_flag, err_print_flag, eles, ix_attrib, do_unlink)
   import
   implicit none
   type (lat_struct), target :: lat
   type (all_pointer_struct), allocatable :: ptr_array(:)
   character(*) ele_name, attrib_name
   logical err_flag
   logical do_allocation
-  logical, optional :: err_print_flag
+  logical, optional :: err_print_flag, do_unlink
   type (ele_pointer_struct), optional, allocatable :: eles(:)
   integer, optional :: ix_attrib
 end subroutine

bmad/modules/bookkeeper_mod.f90

@@ -235,7 +235,7 @@ recursive subroutine group_change_this (ele, attrib_name, ctl, dir, this_lord, t
 
 !
 
-call pointer_to_attribute (ele, attrib_name, .false., a_ptr, err_flag)
+call pointer_to_attribute (ele, attrib_name, .false., a_ptr, err_flag, do_unlink = .true.)
 if (err_flag) then
   if (global_com%exit_on_error) call err_exit
   return
@@ -1080,7 +1080,6 @@ subroutine makeup_super_slave (lat, slave, err_flag)
     T_end(4,1) =  ks / 2
     T_end(2,3) = -ks / 2
 
-
     call transfer_ele (slave, sol_quad)
     sol_quad%key = sol_quad$
     sol_quad%value(ks$) = ks
@@ -1661,7 +1660,7 @@ subroutine makeup_control_slave (lat, slave, err_flag)
       return
     endif
 
-    call pointer_to_attribute (slave, control%attribute, .true., a_ptr, err_flag)
+    call pointer_to_attribute (slave, control%attribute, .true., a_ptr, err_flag, do_unlink = .true.)
     if (err_flag) then
       if (global_com%exit_on_error) call err_exit
       return

bmad/output/write_lattice_in_elegant_format.f90

@@ -426,9 +426,9 @@ subroutine write_lattice_in_elegant_format (out_file_name, lat, ref_orbit, &
 ! Now write info to the output file...
 ! lat lattice name
 
-write (iu, '(3a)') comment_char, ' File generated by: write_lattice_in_elegant_format', trim(eol_char)
-write (iu, '(4a)') comment_char, ' Bmad Lattice File: ', trim(lat%input_file_name), trim(eol_char)
-if (lat%lattice /= '') write (iu, '(4a)') comment_char, ' Bmad Lattice: ', trim(lat%lattice), trim(eol_char)
+write (iu, '(3a)') comment_char, ' File generated by: write_lattice_in_foreign_format', trim(eol_char)
+write (iu, '(4a)') comment_char, ' Bmad lattice file: ', trim(lat%input_file_name), trim(eol_char)
+if (lat%lattice /= '') write (iu, '(4a)') comment_char, ' Bmad lattice name: ', trim(lat%lattice), trim(eol_char)
 write (iu, '(a)')
 
 ! write element parameters

bmad/output/write_lattice_in_julia.f90

@@ -73,7 +73,8 @@ subroutine write_lattice_in_julia(julia_file, lat, err_flag)
 
 ! Write element defs
 
-write (iu, '(a)') '# Lattice file translated from Bmad.'
+write (iu, '(a)')  '# File generated by: write_lattice_in_foreign_format'
+write (iu, '(4a)') '# Bmad lattice file: ', trim(lat%input_file_name)
 write (iu, '(a)')
 
 n_names = 0

bmad/output/write_lattice_in_mad_format.f90

@@ -574,9 +574,9 @@ subroutine write_lattice_in_mad_format (out_type, out_file_name, lat, ref_orbit,
 ! Now write info to the output file...
 ! lat lattice name
 
-write (iu, '(3a)') comment_char, ' File generated by: write_lattice_in_mad_format', trim(eol_char)
-write (iu, '(4a)') comment_char, ' Bmad Lattice File: ', trim(lat%input_file_name), trim(eol_char)
-if (lat%lattice /= '') write (iu, '(4a)') comment_char, ' Bmad Lattice: ', trim(lat%lattice), trim(eol_char)
+write (iu, '(3a)') comment_char, ' File generated by: write_lattice_in_foreign_format', trim(eol_char)
+write (iu, '(4a)') comment_char, ' Bmad lattice file: ', trim(lat%input_file_name), trim(eol_char)
+if (lat%lattice /= '') write (iu, '(4a)') comment_char, ' Bmad lattice name: ', trim(lat%lattice), trim(eol_char)
 write (iu, '(a)')
 
 ! beam definition

bmad/output/write_lattice_in_sad_format.f90

@@ -331,7 +331,10 @@ subroutine write_lattice_in_sad_format (out_file_name, lat, include_apertures, i
     if (ix_pole_max > -1) then
       ab_ele%a_pole = ab_ele%a_pole / 2
       ab_ele%b_pole = ab_ele%b_pole / 2
-      if (associated(ele%a_pole)) deallocate (ele%a_pole, ele%b_pole)
+      if (associated(ele%a_pole)) then
+        deallocate (ele%a_pole, ele%b_pole)
+        call attribute_bookkeeper(ele, .true.)
+      endif
       j_count = j_count + 1
       write (ab_ele%name, '(a1, a, i0)') key_name(ele%key), 'MULTIPOLE_', j_count
       call insert_element (lat_out, ab_ele, ix_ele, branch_out%ix_branch)
@@ -430,9 +433,9 @@ subroutine write_lattice_in_sad_format (out_file_name, lat, include_apertures, i
 ! Now write info to the output file...
 ! lat lattice name
 
-write (iu, '(3a)') '! File generated by Bmad from Bmad lattice file:'
-write (iu, '(4x, 2a)') trim(lat%input_file_name), ';'
-if (lat%lattice /= '') write (iu, '(4a)') '! Bmad lattice name: ', trim(lat%lattice), ';'
+write (iu, '(3a)') '! File generated by: write_lattice_in_foreign_format'
+write (iu, '(4a)') '! Bmad lattice file: ', trim(lat%input_file_name)
+if (lat%lattice /= '') write (iu, '(4a)') '! Bmad lattice name: ', trim(lat%lattice)
 write (iu, '(a)')
 
 write (iu, '(3a)') 'MOMENTUM = ',  re_str(ele%value(p0c$)), ';'