diff --git a/tao/code/tao_plot_mod.f90 b/tao/code/tao_plot_mod.f90 index 586b507ad6..bd28d4a699 100644 --- a/tao/code/tao_plot_mod.f90 +++ b/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 diff --git a/tao/code/tao_python_cmd.f90 b/tao/code/tao_python_cmd.f90 index 8722465220..af97b68596 100644 --- a/tao/code/tao_python_cmd.f90 +++ b/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 diff --git a/tao/code/tao_struct.f90 b/tao/code/tao_struct.f90 index 11ae4a083c..44850fcca6 100644 --- a/tao/code/tao_struct.f90 +++ b/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.