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.