Fix command. (#1069)

* Fix `python floor_plan` command.

tao/code/tao_plot_mod.f90

@@ -434,8 +434,6 @@ subroutine tao_draw_floor_plan (plot, graph)
 
 ! Draw for a particular universe
 
-if (allocated(graph%floor_list)) deallocate(graph%floor_list)
-
 if (graph%ix_universe == -2) then
   do isu = 1, size(s%u)
     call draw_this_floor_plan(isu, plot, graph)
@@ -492,6 +490,7 @@ subroutine draw_this_floor_plan(isu, plot, graph)
 lat => tao_lat%lat
 
 ! loop over all elements in the lattice. 
+! If the logic of this loop is changed, a corresponding change must be made for the "python floor_plan" code.
 
 do n = 0, ubound(lat%branch, 1)
   branch => lat%branch(n)
@@ -665,7 +664,6 @@ recursive subroutine tao_draw_ele_for_floor_plan (plot, graph, tao_lat, ele, ele
 type (coord_struct), pointer :: orbit(:)
 type (coord_struct) orb_here, orb_start, orb_end
 type (tao_shape_pattern_struct), pointer :: pat
-type (tao_floor_plan_ele), allocatable :: floor_ele(:)
 
 integer, parameter :: n_bend_extra = 40, l1 = -n_bend_extra, l2 = 200 + n_bend_extra
 integer i, j, k, n_bend, n, ix, ic, n_mid, min1_bend, min2_bend, max1_bend, max2_bend
@@ -698,24 +696,6 @@ recursive subroutine tao_draw_ele_for_floor_plan (plot, graph, tao_lat, ele, ele
 call find_element_ends (ele, ele1, ele2)
 if (.not. associated(ele1)) return
 
-if (.not. allocated(graph%floor_list)) then
-  allocate(graph%floor_list(1))
-  n = 1
-else
-  n = size(graph%floor_list) + 1
-  call move_alloc(graph%floor_list, floor_ele)
-  allocate(graph%floor_list(n))
-  graph%floor_list(:n-1) = floor_ele
-endif
-
-graph%floor_list(n)%ele_loc = ele_loc(ele)
-
-if (associated(ele_shape)) then
-  graph%floor_list(n)%shape = ele_shape
-else
-  graph%floor_list(n)%shape%shape = null_name$
-endif
-
 !
 
 orbit => tao_lat%tao_branch(ele1%ix_branch)%orbit

tao/code/tao_python_cmd.f90

@@ -139,7 +139,6 @@ subroutine tao_python_cmd (input_str)
 type (tao_ele_shape_struct), pointer :: shapes(:)
 type (tao_ele_shape_struct), allocatable :: shapes_temp(:)
 type (tao_ele_shape_struct), pointer :: shape
-type (tao_ele_shape_struct) :: ashape
 type (tao_ele_shape_input) shape_input
 type (photon_element_struct), pointer :: ph
 type (qp_axis_struct) x_ax, y_ax
@@ -4265,54 +4264,16 @@ subroutine tao_python_cmd (input_str)
   endif
 
   g => graphs(1)%g
-  u => tao_pointer_to_universe(g%ix_universe, .true.)
-  lat => u%model%lat
 
-  if (.not. allocated(g%floor_list)) then
-    call invalid ('Floor plan drawing not yet setup for this graph.')
-    return
+  if (g%ix_universe == -2) then
+    do iu = 1, size(s%u)
+      call this_floor_plan(iu, g)
+    enddo
+  else
+    iu = tao_universe_index(g%ix_universe)
+    call this_floor_plan(iu, g)
   endif
 
-  do i = 1, size(g%floor_list)
-    ele => pointer_to_ele(lat, g%floor_list(i)%ele_loc)
-    ashape = g%floor_list(i)%shape
-    if (ashape%shape == null_name$) then
-      y1 = 0
-      y2 = 0
-      color = ''
-      label_name = ''
-      shape_shape = ''
-      line_width = 0
-    else
-      color = ashape%color
-      shape_shape = ashape%shape
-      line_width = ashape%line_width
-    endif
-
-    call find_element_ends(ele, ele1, ele2)
-    floor%r = [0.0_rp, 0.0_rp, 0.0_rp]
-    floor1 = coords_local_curvilinear_to_floor (floor, ele, .true.)
-
-    floor%r = [0.0_rp, 0.0_rp, ele%value(l$)]
-    floor2 = coords_local_curvilinear_to_floor (floor, ele, .true.)
-    call tao_floor_to_screen_coords (g, floor1, end1)
-    call tao_floor_to_screen_coords (g, floor2, end2)
-    if (ele%key == sbend$) then
-      nl=incr(nl); write (li(nl), '(2(i0, a), 2a, 6(es14.7, a), (i0, a), 2a, 2(es10.2, a), 4a, 4(es14.7, a))') &
-                  ele%ix_branch, ';', ele%ix_ele, ';', &
-                  trim(key_name(ele%key)), ';', end1%r(1), ';', end1%r(2), ';', end1%theta, ';', &
-                  end2%r(1), ';', end2%r(2), ';', end2%theta, ';', &
-                  line_width, ';', trim(shape_shape), ';', y1, ';', y2, ';', trim(color), ';', trim(label_name), ';', &
-                  ele%value(l$), ';', ele%value(angle$), ';', ele%value(e1$), ';', ele%value(e2$)
-    else
-      nl=incr(nl); write (li(nl), '(2(i0, a), 2a, 6(es14.7, a), (i0, a), 2a, 2(es10.2, a), 4a)') &
-                  ele%ix_branch, ';', ele%ix_ele, ';', &
-                  trim(key_name(ele%key)), ';', end1%r(1), ';', end1%r(2), ';', end1%theta, ';', &
-                  end2%r(1), ';', end2%r(2), ';', end2%theta, ';', &
-                  line_width, ';', trim(shape_shape), ';', y1, ';', y2, ';', trim(color), ';', trim(label_name)
-    endif
-  enddo
-
 !------------------------------------------------------------------------------------------------
 !------------------------------------------------------------------------------------------------
 !%% floor_orbit
@@ -9184,4 +9145,116 @@ recursive subroutine write_this_ele_floor(ele, loc, can_vary, suffix)
 
 end subroutine write_this_ele_floor
 
+!----------------------------------------------------------------------
+! contains
+
+subroutine this_floor_plan (iu, graph)
+
+type (tao_graph_struct) :: graph
+type (lat_struct), pointer :: lat
+type (tao_ele_shape_struct), pointer :: ele_shape, ele_shape2
+type (branch_struct), pointer :: branch
+type (ele_struct), pointer :: ele, slave
+
+real(rp) y1, y2
+integer iu, n, i, j, ix_shape_min, ix_pass, n_links
+character(40) label_name
+
+!
+
+lat => s%u(iu)%model%lat
+
+do n = 0, ubound(lat%branch, 1)
+  branch => lat%branch(n)
+  branch%ele%logic = .false.  ! Used to mark as drawn.
+  do i = 0, branch%n_ele_max
+    ele => branch%ele(i)
+    if (ele%slave_status == super_slave$) cycle
+
+    ix_shape_min = 1
+    do
+      call tao_ele_shape_info(iu, ele, s%plot_page%floor_plan%ele_shape, ele_shape, label_name, y1, y2, ix_shape_min)
+      if (.not. associated(ele_shape) .and. (ele%key == overlay$ .or. &
+                                             ele%key == group$ .or. ele%key == girder$)) exit   ! Nothing to draw
+
+      if (graph%floor_plan%draw_only_first_pass .and. ele%slave_status == multipass_slave$) then
+        call multipass_chain (ele, ix_pass, n_links)
+        if (ix_pass > 1) exit
+      endif
+
+      if (ele%lord_status == multipass_lord$) then
+        do j = 1, ele%n_slave
+          if (graph%floor_plan%draw_only_first_pass .and. j > 1) exit
+          slave => pointer_to_slave(ele, j)
+          ele_shape2 => tao_pointer_to_ele_shape (iu, slave, s%plot_page%floor_plan%ele_shape)
+          if (associated(ele_shape2)) cycle ! Already drawn. Do not draw twice
+          call this_floor_plan2 (graph, slave, ele_shape, label_name, y1, y2)
+        enddo
+      else
+        call this_floor_plan2 (graph, ele, ele_shape, label_name, y1, y2)
+      endif
+      if (.not. associated(ele_shape)) exit
+      if (.not. ele_shape%multi) exit
+    enddo
+
+  enddo
+enddo
+
+end subroutine this_floor_plan
+
+!----------------------------------------------------------------------
+! contains
+
+subroutine this_floor_plan2 (graph, ele, ashape, label_name, y1, y2)
+
+type (tao_graph_struct) :: graph
+type (ele_struct) ele
+type (tao_ele_shape_struct), pointer :: ashape
+type (ele_struct), pointer :: ele1, ele2
+type (floor_position_struct) floor, floor1, floor2
+
+real(rp) y1, y2
+integer line_width
+character(40) color, label_name, shape_shape
+
+!
+
+call find_element_ends (ele, ele1, ele2)
+if (.not. associated(ele1)) return
+
+if (.not. associated(ashape)) then
+  color = ''
+  label_name = ''
+  shape_shape = ''
+  line_width = 0
+else
+  color = ashape%color
+  shape_shape = ashape%shape
+  line_width = ashape%line_width
+endif
+
+floor%r = [0.0_rp, 0.0_rp, 0.0_rp]
+floor1 = coords_local_curvilinear_to_floor (floor, ele, .true.)
+
+floor%r = [0.0_rp, 0.0_rp, ele%value(l$)]
+floor2 = coords_local_curvilinear_to_floor (floor, ele, .true.)
+call tao_floor_to_screen_coords (graph, floor1, end1)
+call tao_floor_to_screen_coords (graph, floor2, end2)
+if (ele%key == sbend$) then
+  nl=incr(nl); write (li(nl), '(2(i0, a), 2a, 6(es14.7, a), (i0, a), 2a, 2(es10.2, a), 4a, 4(es14.7, a))') &
+              ele%ix_branch, ';', ele%ix_ele, ';', &
+              trim(key_name(ele%key)), ';', end1%r(1), ';', end1%r(2), ';', end1%theta, ';', &
+              end2%r(1), ';', end2%r(2), ';', end2%theta, ';', &
+              line_width, ';', trim(shape_shape), ';', y1, ';', y2, ';', trim(color), ';', trim(label_name), ';', &
+              ele%value(l$), ';', ele%value(angle$), ';', ele%value(e1$), ';', ele%value(e2$)
+else
+  nl=incr(nl); write (li(nl), '(2(i0, a), 2a, 6(es14.7, a), (i0, a), 2a, 2(es10.2, a), 4a)') &
+              ele%ix_branch, ';', ele%ix_ele, ';', &
+              trim(key_name(ele%key)), ';', end1%r(1), ';', end1%r(2), ';', end1%theta, ';', &
+              end2%r(1), ';', end2%r(2), ';', end2%theta, ';', &
+              line_width, ';', trim(shape_shape), ';', y1, ';', y2, ';', trim(color), ';', trim(label_name)
+endif
+
+end subroutine this_floor_plan2
+
 end subroutine tao_python_cmd

tao/code/tao_struct.f90

@@ -230,11 +230,6 @@ module tao_struct
 
 ! This is used with floor_plan drawings.
 
-type tao_floor_plan_ele
-  type (lat_ele_loc_struct) :: ele_loc
-  type (tao_ele_shape_struct) :: shape
-end type
-
 type tao_floor_plan_struct
   character(2) :: view = 'zx'                ! or 'xz'.
   real(rp) :: rotation = 0                   ! Rotation of floor plan plot: 1.0 -> 360^deg
@@ -265,7 +260,6 @@ module tao_struct
   type (tao_curve_struct), allocatable :: curve(:)
   type (tao_plot_struct), pointer :: p => null() ! pointer to parent plot
   type (tao_floor_plan_struct) :: floor_plan = tao_floor_plan_struct()
-  type (tao_floor_plan_ele), allocatable :: floor_list(:)           ! Store what is drawn. Used by "python floor_plan" command.
   type (qp_point_struct) :: text_legend_origin = qp_point_struct()
   type (qp_point_struct) :: curve_legend_origin = qp_point_struct()
   type (qp_axis_struct) :: x = qp_axis_struct()              ! X-axis parameters.