Merge pull request #685 from bmad-sim/devel/71

Now rampers can control other controllers.

bmad/code/apply_rampers_to_slave.f90

@@ -19,13 +19,14 @@ subroutine apply_rampers_to_slave (slave, ramper, err_flag)
 implicit none
 
 type (ele_struct), target :: slave
-type (ele_struct), pointer :: rmp
+type (ele_struct), pointer :: rmp, slave2
 type (ele_pointer_struct), target :: ramper(:)
 type (lat_struct), pointer :: lat
 type (control_ramp1_struct), pointer :: r1
+type (ele_pointer_struct), allocatable :: slave_list(:)
 
-integer iv, key, ix, ir
-logical err_flag, ok
+integer iv, key, ix, ir, n, is
+logical err_flag, ok, found
 
 character(100) err_str
 character(40) name
@@ -37,12 +38,12 @@ subroutine apply_rampers_to_slave (slave, ramper, err_flag)
 if (size(ramper) == 0) return
 lat => ramper(1)%ele%branch%lat
 
+! Bookkeeping for ramper controlling ramper.
+
 do ix = 1, size(ramper)
   ramper(ix)%ele%select = .false.
 enddo
 
-! Bookkeeping for ramper controlling ramper.
-
 do ix = 1, size(ramper)
   call this_ramper_bookkeeper(ramper(ix)%ele, ramper, lat)
 enddo
@@ -69,7 +70,28 @@ subroutine apply_rampers_to_slave (slave, ramper, err_flag)
         name = r1%slave_name(ix+2:)
       endif
 
-      if ((key /= 0 .and. key /= slave%key) .or. .not. match_wild(slave%name, name)) then
+      if (r1%is_controller) then
+        slave2 => pointer_to_ele(lat, r1%slave)
+        ! In case elements have shifted in the lattice, check that slave2 is the correct element
+        if (.not. associated(slave2)) slave2 => lat%ele(0)   ! Just to point to something
+        if (slave2%name /= r1%slave_name) then
+          slave2 => pointer_to_ele(lat, r1%slave_name)
+          r1%slave = ele_loc(slave2)
+        endif
+        !
+        call get_slave_list(slave2, slave_list, n)
+        found = .false.
+        do is = 1, n
+          if (slave_list(is)%ele%name /= slave%name) cycle
+          found = .true.
+          exit
+        enddo
+        if (.not. found) then
+          r1%value = real_garbage$  ! This ramper does not control this slave.
+          cycle
+        endif
+
+      elseif ((key /= 0 .and. key /= slave%key) .or. .not. match_wild(slave%name, name)) then
         r1%value = real_garbage$  ! This ramper does not control this slave.
         cycle
       endif
@@ -79,7 +101,8 @@ subroutine apply_rampers_to_slave (slave, ramper, err_flag)
   enddo
 enddo
 
-if (slave%key /= int_garbage$) call attribute_bookkeeper(slave, .true.)
+if (slave%key == int_garbage$) return
+call attribute_bookkeeper(slave, .true.)
 
 !-------------------------------------------------------------------
 contains
@@ -125,22 +148,14 @@ end subroutine this_ramper_bookkeeper
 
 subroutine this_slave_bookkeeper (this_ramp, slave, r1)
 
-type (ele_struct) this_ramp, slave
+type (ele_struct), target :: this_ramp, slave
+type (ele_struct), pointer :: slave2
 type (control_ramp1_struct) r1
 type (all_pointer_struct) a_ptr
 
 logical err_flag
 
-! slave%key = int_garbage$ is used by the controller_function_plot program to bypass 
-! some of the bookkeeping of this routine.
-
-if (slave%key /= int_garbage$) then
-  call pointer_to_attribute (slave, r1%attribute, .true., a_ptr, err_flag, .false.)
-  if (err_flag .or. .not. associated(a_ptr%r)) then
-    r1%value = real_garbage$
-    return
-  endif
-endif
+!
 
 if (allocated(r1%stack)) then
   r1%value = expression_stack_value(r1%stack, err_flag, err_str, this_ramp%control%var, .false.)
@@ -160,11 +175,27 @@ subroutine this_slave_bookkeeper (this_ramp, slave, r1)
   endif
 endif
 
-if (slave%key /= int_garbage$) then
-  a_ptr%r = r1%value
-  call set_flags_for_changed_attribute (slave, a_ptr%r, .true.)
+! slave%key = int_garbage$ is used by the controller_function_plot program to bypass 
+! some of the bookkeeping of this routine.
+
+if (slave%key == int_garbage$) return
+
+if (r1%is_controller) then
+  slave2 => pointer_to_ele(lat, r1%slave)
+else
+  slave2 => slave  
+endif
+
+call pointer_to_attribute (slave2, r1%attribute, .true., a_ptr, err_flag, .false.)
+if (err_flag .or. .not. associated(a_ptr%r)) then
+  r1%value = real_garbage$
+  return
 endif
 
+a_ptr%r = r1%value
+call set_flags_for_changed_attribute (slave2, a_ptr%r, .true.)
+if (r1%is_controller) call control_bookkeeper(lat, slave2)
+
 end subroutine this_slave_bookkeeper
 
 end subroutine

bmad/code/get_slave_list.f90

@@ -1,8 +1,5 @@
-!---------------------------------------------------------------------------
-!---------------------------------------------------------------------------
-!---------------------------------------------------------------------------
 !+
-! Subroutine get_slave_list (lord, slave_list, n_slave)
+! Subroutine get_slave_list (lord, slaves, n_slave)
 !
 ! Subroutine to get the list of slaves for a lord element.
 !

bmad/code/split_lat.f90

@@ -172,8 +172,7 @@ subroutine split_lat (lat, s_split, ix_branch, ix_split, split_done, add_suffix,
 endif
 
 ! Insert a new element.
-! Note: Any lat%control()%ix_ele pointing to ix_split will now 
-!  point to ix_split+1.
+! Note: Any lat%control()%ix_ele pointing to ix_split will now point to ix_split+1.
 
 call insert_element (lat, ele, ix_split, ix_branch)
 
@@ -229,14 +228,12 @@ subroutine split_lat (lat, s_split, ix_branch, ix_split, split_done, add_suffix,
 ! Also: Redo the control list for the lord elements.
 
 if (ele%slave_status == super_slave$) then
-
   if (ele%n_lord == 0) goto 8000  ! nothing to do for free element
 
   ixc = lat%n_ic_max
   n_ic2 = ixc 
 
   do j = 1, ele%n_lord
-
     ! If lord does not overlap ele1 then adjust padding and do not add
     ! as a lord to ele1
 
@@ -263,7 +260,6 @@ subroutine split_lat (lat, s_split, ix_branch, ix_split, split_done, add_suffix,
     lat%n_ic_max = n_ic2
 
     if (lord%lord_status == super_lord$) call order_super_lord_slaves (lat, lord%ix_ele)
-
   enddo
 
   ! Remove lord/slave control for ele2 if the lord does not overlap
@@ -277,7 +273,6 @@ subroutine split_lat (lat, s_split, ix_branch, ix_split, split_done, add_suffix,
   enddo
 
   goto 8000   ! and return
-
 endif   ! split element is a super_slave
 
 ! Here if split element is not a super_slave.

bmad/modules/bmad_routine_interface.f90

@@ -92,7 +92,7 @@ recursive function pointer_to_branch_given_ele (ele) result (branch_ptr)
 !   foreign_ele   -- ele_struct: Lattice element in another lattice.
 !
 ! Output:
-!   ele_ptr       -- ele_struct, pointer: Pointer to the element. 
+!   ele_ptr       -- ele_struct, pointer: Pointer to the element. Nullified if no match or error.
 !-
 
 interface pointer_to_ele

bmad/modules/bmad_struct.f90

@@ -1255,7 +1255,7 @@ module bmad_struct
 !   So %ix_attrib may be -1. Using pointer_to_attribute with %attribute will always work.
 
 type control_struct
-  real(rp) :: value = 0          ! Used by group, overlay, and ramper elements.
+  real(rp) :: value = 0          ! Used by group, and overlay elements.
   real(rp), allocatable :: y_knot(:)
   type (expression_atom_struct), allocatable :: stack(:) ! Evaluation stack
   type (lat_ele_loc_struct) :: slave = lat_ele_loc_struct()
@@ -1277,6 +1277,7 @@ module bmad_struct
   type (expression_atom_struct), allocatable :: stack(:) ! Evaluation stack
   character(40) :: attribute = ''     ! Name of attribute controlled. Set to "FIELD_OVERLAPS" for field overlaps.
   character(40) :: slave_name = ''    ! Name of slave.
+  ! %slave is only used with controllers and in this case there is only one slave.
   type (lat_ele_loc_struct) :: slave = lat_ele_loc_struct()
   logical :: is_controller = .false.  ! Is the slave a controller? If so bookkeeping is different.
 end type

bmad/parsing/create_ramper.f90

@@ -73,17 +73,17 @@ subroutine create_ramper (lord, contrl, err)
   r1 => lord%control%ramp(j)
   r1%attribute = con0%attribute
   r1%slave_name = con0%slave_name
-  r1%slave      = con0%slave
   r1%value      = con1%value
   if (allocated(con1%y_knot)) r1%y_knot = con1%y_knot
   if (allocated(con1%stack))  r1%stack  = con1%stack
 
   ! If slave is an overlay, group, or girder, need to mark it as such
   r1%is_controller = .false.
-  slave => pointer_to_ele(lat, r1%slave)
+  slave => pointer_to_ele(lat, r1%slave_name)
   if (associated(slave)) then
     key = slave%key
     r1%is_controller = (key == overlay$ .or. key == group$ .or. key == girder$)
+    if (r1%is_controller) r1%slave = ele_loc(slave)
   endif
 enddo
 

bmad/parsing/read_digested_bmad_file.f90

@@ -560,7 +560,7 @@ subroutine read_this_ele (ele, ix_ele_in, error)
     allocate(ele%control%ramp(nr))
     do i = 1, nr
       rmp => ele%control%ramp(i)
-      read (d_unit, err = 9040, end = 9040) rmp%slave_name, n, nk, rmp%value, rmp%attribute, rmp%slave
+      read (d_unit, err = 9040, end = 9040) rmp%slave_name, n, nk, rmp%value, rmp%attribute, rmp%slave, rmp%is_controller
       if (n > 0) then
         allocate (rmp%stack(n))
         do j = 1, n

bmad/parsing/write_digested_bmad_file.f90

@@ -368,7 +368,7 @@ subroutine write_this_ele (ele)
     if (allocated(rmp%stack)) n = size(rmp%stack)
     nk = 0
     if (allocated(rmp%y_knot)) nk = size(rmp%y_knot)
-    write (d_unit) rmp%slave_name, n, nk, rmp%value, rmp%attribute, rmp%slave
+    write (d_unit) rmp%slave_name, n, nk, rmp%value, rmp%attribute, rmp%slave, rmp%is_controller
     do j = 1, n
       write (d_unit) rmp%stack(j)
     enddo