diff --git a/bmad/code/attribute_bookkeeper.f90 b/bmad/code/attribute_bookkeeper.f90 index 627dc9b387..236e0a9e0d 100644 --- a/bmad/code/attribute_bookkeeper.f90 +++ b/bmad/code/attribute_bookkeeper.f90 @@ -711,7 +711,7 @@ subroutine attribute_bookkeeper (ele, force_bookkeeping) val(l_rectangle$) = sinc(val(angle$)) * val(l$) end select - if (ele_value_has_changed(ele, [g$], [1e-10_rp], .false.)) then + if (ele_value_has_changed(ele, [g$, rho$], [1e-10_rp, 1e-10_rp], .false.)) then call set_ele_status_stale (ele, floor_position_group$) endif endif @@ -759,7 +759,7 @@ subroutine attribute_bookkeeper (ele, force_bookkeeping) val(l_rectangle$) = sinc(val(angle$)) * val(l$) end select - if (ele_value_has_changed(ele, [g$], [1e-10_rp], .false.)) then + if (ele_value_has_changed(ele, [g$, rho$], [1e-10_rp, 1e-10_rp], .false.)) then call set_ele_status_stale (ele, floor_position_group$) endif diff --git a/bmad/doc/elements.tex b/bmad/doc/elements.tex index 6d60f67183..7122bfd510 100644 --- a/bmad/doc/elements.tex +++ b/bmad/doc/elements.tex @@ -2547,8 +2547,9 @@ \section{Girder} Girder supporting three elements labeled \vn{A}, \vn{B}, and \vn{C}. $\calO_A$ is the reference frame at the upstream end of element \vn{A} (\sref{s:ref.construct}), $\calO_C$ is the reference frame at the downstream end of element \vn{C}, and $\calO_G$ is the default \vn{origin} reference -frame of the girder. $r_{CA}$ is the vector from $\calO_A$ to $\calO_C$. The length \vn{l} of the -girder is the difference in $s$ between points $\calO_C$ and $\calO_A$. +frame of the girder if the \vn{origin_ele} parameter is not set. $\bfr_{CA}$ is the vector from +$\calO_A$ to $\calO_C$. The length \vn{l} of the girder is set to be the difference in $s$ between +points $\calO_C$ and $\calO_A$. } \label{f:girder} \end{figure} @@ -2657,7 +2658,11 @@ \section{Girder} to \vn{center} results in the reference frame being the frame of the surface (cf.~\fig{f:surface}). To specify that the global coordinates (\sref{s:global}) are to be used for a girder set -\vn{origin_ele} to \vn{global_coordinates}. Typically this is the same as using the \vn{beginning} +\vn{origin_ele} to +\begin{example} + global_coordinates +\end{example} +Typically this is the same as using the \vn{beginning} element (\sref{s:begin.ele}) as the \vn{origin_ele} except when the \vn{beginning} element is offset or reoriented (\sref{s:beginning}). @@ -2667,10 +2672,9 @@ \section{Girder} \vn{A} as shown in the figure. Let $\calO_C$ be the downstream end of the last element in the list of supported elements. In this example this is the downstream end of element \vn{C}. The origin of the \vn{girder}'s reference frame, marked $\calO_G$ in the figure, will be half way along the vector -$r_{CA}$ from the origin of $\calO_A$ to the origin of $\calO_B$. The orientation of $\calO_G$ is -constructed by rotating the $\calO_A$ coordinate system along an axis in $\calO_A$'s $x$-$y$ plane -such that $\calO_A$'s $z$ axis ends up parallel with $r_{CA}$. In the example above, the rotation -axis will be along $\calO_A$'s $y$-axis. +$r_{CA}$ from the origin of $\calO_A$ to the origin of $\calO_B$. The orientation of $\calO_G$ is +constructed by rotating the $\calO_A$ coordinates about an axis perpendicular to the $z$-axis of +$\calO_A$ and $\bfr_{CA}$ such that the $z$-axis of $\calO_G$ is parallel with $r_{CA}$. Once the \vn{origin} reference frame is established, the reference frame of the girder can be offset from the \vn{origin} frame using the parameters diff --git a/bmad/geometry/ele_geometry.f90 b/bmad/geometry/ele_geometry.f90 index c0d35b29d7..58869afbe0 100644 --- a/bmad/geometry/ele_geometry.f90 +++ b/bmad/geometry/ele_geometry.f90 @@ -39,14 +39,13 @@ recursive subroutine ele_geometry (floor_start, ele, floor_end, len_scale, ignor implicit none type (ele_struct), target :: ele -type (ele_struct), pointer :: ele0, ele00, slave0, slave1, ele2, this_ele, lord +type (ele_struct), pointer :: ele0, ele00, slave0, slave1, ele2, this_ele, slave type (floor_position_struct), optional, target :: floor_end type (floor_position_struct) :: floor_start, this_floor, old_floor, floor0 type (floor_position_struct), pointer :: floor type (ele_pointer_struct), allocatable :: eles(:) type (ele_pointer_struct), allocatable, target :: chain_ele(:) type (lat_param_struct) param -type (lat_struct), pointer :: lat real(rp), optional :: len_scale real(rp) knl(0:n_pole_maxx), tilt(0:n_pole_maxx), dtheta @@ -55,7 +54,7 @@ recursive subroutine ele_geometry (floor_start, ele, floor_end, len_scale, ignor real(rp) theta, phi, psi, tlt, dz(3), z0(3), z_cross(3), eps, signif(6) real(rp) :: w_mat(3,3), w_mat_inv(3,3), s_mat(3,3), r_vec(3), t_mat(3,3) -integer i, k, ie, key, n_loc, ix_pass, n_links, ix_pole_max, ib_to, ix, iv(6) +integer i, j, k, n, ie, key, n_loc, ix_pass, n_links, ix_pole_max, ib_to, ix, iv(6) logical err, doit, finished, has_multipole_rot_tilt, ele_floor_geometry_calc logical, optional :: ignore_patch_err @@ -144,16 +143,60 @@ recursive subroutine ele_geometry (floor_start, ele, floor_end, len_scale, ignor else ! Must have a reference element if (ele%component_name == '') then ! Must be a floor_shift element ele0 => pointer_to_next_ele(ele, -1) + else call lat_ele_locator (ele%component_name, ele%branch%lat, eles, n_loc, err) - if (n_loc /= 1) then + + ! If multiple matches but one match is a slave of ele (which must be a girder), this is OK. + if (n_loc == 0) then + call out_io (s_fatal$, r_name, 'ORIGIN_ELE NAME: ' // ele%component_name, & + 'FOR ELEMENT: ' // ele%name, & + 'DOES NOT MATCH ANY ELEMENT!') + if (global_com%exit_on_error) call err_exit + return + endif + + if (n_loc > 0) then + n = 0 + do i = 1, n_loc + do j = 1, ele%n_slave + slave => pointer_to_slave(ele, j) + if (.not. (ele_loc(eles(i)%ele) == ele_loc(slave))) cycle + select case (n) + case (0); n = j + case default; n = -1 ! Mark that there are multiple slave element matches + end select + enddo + enddo + if (n > 0) then + n_loc = 1 + eles(1)%ele => pointer_to_slave(ele, n) + endif + if (n_loc > 1) then + call out_io (s_fatal$, r_name, 'ORIGIN_ELE: ' // ele%component_name, & + 'FOR ELEMENT: ' // ele%name, & + 'IS NOT UNIQUE!') + if (global_com%exit_on_error) call err_exit + return + endif + endif + + if (ele%lord_status == multipass_lord$ .or. ele%key == ramper$) then call out_io (s_fatal$, r_name, 'ORIGIN_ELE: ' // ele%component_name, & 'FOR ELEMENT: ' // ele%name, & - 'IS NOT UNIQUE!') + 'IS A MULTIPASS_LORD OR RAMPER WHICH DOES NOT HAVE A UNIQUE POSITION') if (global_com%exit_on_error) call err_exit return endif + if (ele%n_slave > 1 .and. (ele%key == overlay$ .or. ele%key == group$)) then + call out_io (s_fatal$, r_name, 'ORIGIN_ELE: ' // ele%component_name, & + 'FOR ELEMENT: ' // ele%name, & + 'IS AN OVERLAY OR GROUP ELEMENT WHICH HAS MORE THAN ONE SLAVE SO THERE IS NO UNIQUE POSITION') + if (global_com%exit_on_error) call err_exit + return + endif + ele0 => eles(1)%ele endif @@ -237,6 +280,7 @@ recursive subroutine ele_geometry (floor_start, ele, floor_end, len_scale, ignor call update_floor_angles(floor, floor0) endif + call end_bookkeeping(ele, old_floor, floor) return endif ! Fiducial, girder, floor_shift @@ -474,67 +518,87 @@ recursive subroutine ele_geometry (floor_start, ele, floor_end, len_scale, ignor floor%w = w_mat call update_floor_angles(floor, floor0) +call end_bookkeeping(ele, old_floor, floor) + +!------------------------------------------------------------------------------------------- +contains + +subroutine end_bookkeeping(ele, old_floor, floor) -! End bookkeeping +type (ele_struct), target :: ele +type (floor_position_struct) old_floor, floor +type (ele_struct), pointer :: lord, slave, ele2 +type (lat_struct), pointer :: lat +type (ele_pointer_struct), allocatable, target :: chain_ele(:) + +integer k, ib_to, ix, ix_pass, n_links, ie + +! End bookkeeping. Only set ele%bookkeeping_state if computing +! ele%floor (ele_floor_geometry_calc = T) and element is associated with a lattice... eps = bmad_com%significant_length -if (ele_floor_geometry_calc .and. (any(abs(floor%r - old_floor%r) > eps) .or. & +if (ele_floor_geometry_calc .and. associated(ele%branch) .and. (any(abs(floor%r - old_floor%r) > eps) .or. & abs(floor%theta - old_floor%theta) > eps .or. abs(floor%phi - old_floor%phi) > eps .or. & abs(floor%psi - old_floor%psi) > eps)) then - ! If element is associated with a lattice... + lat => ele%branch%lat - if (associated(ele%branch)) then - lat => ele%branch%lat + ! If there is a girder element then *_tot attributes need to be recomputed. + do k = 1, ele%n_lord + lord => pointer_to_lord(ele, k) + if (lord%lord_status == girder_lord$) ele%bookkeeping_state%control = stale$ + enddo - ! If there is a girder element then *_tot attributes need to be recomputed. - do k = 1, ele%n_lord - lord => pointer_to_lord(ele, k) - if (lord%lord_status == girder_lord$) ele%bookkeeping_state%control = stale$ + if (ele%key == girder$) then + do k = 1, ele%n_slave + slave => pointer_to_slave(ele, k) + slave%bookkeeping_state%control = stale$ + lat%branch(slave%ix_branch)%param%bookkeeping_state%control = stale$ enddo + endif - ! Fork target branch only needs to be recomputed if target branch index is greater than present branch. - if (ele%key == fork$ .or. ele%key == photon_fork$) then - ib_to = nint(ele%value(ix_to_branch$)) - if (ib_to > ele%ix_branch) then - ix = nint(ele%value(ix_to_element$)) - lat%branch(ib_to)%ele(ix)%bookkeeping_state%floor_position = stale$ - lat%branch(ib_to)%param%bookkeeping_state%floor_position = stale$ - endif - endif - - call multipass_chain(ele, ix_pass, n_links, chain_ele, use_super_lord = .true.) - if (ix_pass > 0) then - do k = ix_pass+1, n_links - this_ele => chain_ele(k)%ele - this_ele%bookkeeping_state%floor_position = stale$ - lat%branch(this_ele%ix_branch)%param%bookkeeping_state%floor_position = stale$ - if (this_ele%lord_status == super_lord$) then - do ie = 1, this_ele%n_slave - ele2 => pointer_to_slave(this_ele, ie) - ele2%bookkeeping_state%floor_position = stale$ - enddo - endif - enddo + ! Fork target branch only needs to be recomputed if target branch index is greater than present branch. + if (ele%key == fork$ .or. ele%key == photon_fork$) then + ib_to = nint(ele%value(ix_to_branch$)) + if (ib_to > ele%ix_branch) then + ix = nint(ele%value(ix_to_element$)) + lat%branch(ib_to)%ele(ix)%bookkeeping_state%floor_position = stale$ + lat%branch(ib_to)%param%bookkeeping_state%floor_position = stale$ endif + endif - if (ele%slave_status == super_slave$) then - do k = 1, ele%n_lord - lord => pointer_to_lord(ele, k) - if (lord%lord_status /= super_lord$) exit - lord%bookkeeping_state%floor_position = stale$ - if (lord%slave_status == multipass_slave$) then - lord => pointer_to_lord(lord, 1) ! multipass lord - lord%bookkeeping_state%floor_position = stale$ - endif - enddo + call multipass_chain(ele, ix_pass, n_links, chain_ele, use_super_lord = .true.) + if (ix_pass > 0) then + do k = ix_pass+1, n_links + this_ele => chain_ele(k)%ele + this_ele%bookkeeping_state%floor_position = stale$ + lat%branch(this_ele%ix_branch)%param%bookkeeping_state%floor_position = stale$ + if (this_ele%lord_status == super_lord$) then + do ie = 1, this_ele%n_slave + ele2 => pointer_to_slave(this_ele, ie) + ele2%bookkeeping_state%floor_position = stale$ + enddo + endif + enddo + endif - elseif (ele%slave_status == multipass_slave$) then - lord => pointer_to_lord(ele, 1) + if (ele%slave_status == super_slave$) then + do k = 1, ele%n_lord + lord => pointer_to_lord(ele, k) + if (lord%lord_status /= super_lord$) exit lord%bookkeeping_state%floor_position = stale$ - endif + if (lord%slave_status == multipass_slave$) then + lord => pointer_to_lord(lord, 1) ! multipass lord + lord%bookkeeping_state%floor_position = stale$ + endif + enddo + elseif (ele%slave_status == multipass_slave$) then + lord => pointer_to_lord(ele, 1) + lord%bookkeeping_state%floor_position = stale$ endif endif +end subroutine end_bookkeeping + end subroutine ele_geometry diff --git a/bmad/output/type_ele.f90 b/bmad/output/type_ele.f90 index 507ef1a85e..0c8d3080c6 100644 --- a/bmad/output/type_ele.f90 +++ b/bmad/output/type_ele.f90 @@ -1506,24 +1506,36 @@ subroutine type_ele (ele, type_zero_attrib, type_mat6, type_taylor, twiss_out, t nl=nl+1; write (li(nl), '(a)') ' X Y Z Theta Phi Psi' nl=nl+1; write (li(nl), '(a, 6f12.5, 3x, a)') 'Reference', floor2%r, floor2%theta, floor2%phi, floor2%psi, '! Position without misalignments' nl=nl+1; write (li(nl), '(a, 6f12.5, 3x, a)') 'Actual ', floor%r, floor%theta, floor%phi, floor%psi, '! Position with offset/pitch/tilt misalignments' + + case (girder$) + floor = ele_geometry_with_misalignments (ele) + nl=nl+1; li(nl) = '' + nl=nl+1; li(nl) = 'Global Floor Coords at Reference Point:' + nl=nl+1; write (li(nl), '(a)') ' X Y Z Theta Phi Psi' + nl=nl+1; write (li(nl), '(a, 6f12.5, 3x, a)') 'Reference', ele%floor%r, ele%floor%theta, ele%floor%phi, ele%floor%psi, '! Position without misalignments' + nl=nl+1; write (li(nl), '(a, 6f12.5, 3x, a)') 'Actual ', floor%r, floor%theta, floor%phi, floor%psi, '! Position with offset/pitch/tilt misalignments' end select ! - floor = ele_geometry_with_misalignments (ele) + select case (ele%key) + case (girder$) + case default + floor = ele_geometry_with_misalignments (ele) - nl=nl+1; li(nl) = '' - nl=nl+1; li(nl) = 'Global Floor Coords at End of Element:' - nl=nl+1; write (li(nl), '(a)') ' X Y Z Theta Phi Psi' - nl=nl+1; write (li(nl), '(a, 6f12.5, 3x, a)') 'Reference', ele%floor%r, ele%floor%theta, ele%floor%phi, ele%floor%psi, '! Position without misalignments' - nl=nl+1; write (li(nl), '(a, 6f12.5, 3x, a)') 'Actual ', floor%r, floor%theta, floor%phi, floor%psi, '! Position with offset/pitch/tilt misalignments' + nl=nl+1; li(nl) = '' + nl=nl+1; li(nl) = 'Global Floor Coords at End of Element:' + nl=nl+1; write (li(nl), '(a)') ' X Y Z Theta Phi Psi' + nl=nl+1; write (li(nl), '(a, 6f12.5, 3x, a)') 'Reference', ele%floor%r, ele%floor%theta, ele%floor%phi, ele%floor%psi, '! Position without misalignments' + nl=nl+1; write (li(nl), '(a, 6f12.5, 3x, a)') 'Actual ', floor%r, floor%theta, floor%phi, floor%psi, '! Position with offset/pitch/tilt misalignments' + end select ! if (associated(ele0) .and. (ele%ix_ele /= 0 .or. branch%param%geometry == closed$)) then f0 = ele0%floor nl=nl+1; write (li(nl), '(a, 6f12.5, 3x, a)') 'delta Ref', floor%r-f0%r, floor%theta-f0%theta, floor%phi-f0%phi, floor%psi-f0%psi, & - '! Delta with respect to last element' + '! Delta of reference with respect to last element' endif endif endif diff --git a/regression_tests/girder_test/girder_test.bmad b/regression_tests/girder_test/girder_test.bmad index 918ec802c4..3e11f7a819 100644 --- a/regression_tests/girder_test/girder_test.bmad +++ b/regression_tests/girder_test/girder_test.bmad @@ -11,7 +11,7 @@ q3: quadrupole, l = 1, tilt = 0.6, x_offset = 0.4, x_pitch = 0.5, tilt = 3.3, y_ b: sbend, l = 1, angle = 0.1, ref_tilt = 0.2 d: drift, l = 1 -g1: girder = {q1, q2}, tilt = 0.4, x_offset = 0.2, x_pitch = 0.3, tilt = 1.3, y_offset = 0.2, y_pitch = 0.3 +g1: girder = {q1, q2}, tilt = 0.4, x_offset = 0.2, x_pitch = 0.3, tilt = 1.3, y_offset = 0.2, y_pitch = 0.3, origin_ele = q1 g2: girder = {g1, q3}, tilt = 0.5, x_offset = 0.3, x_pitch = 0.4, tilt = 3.3, y_offset = 1.2, y_pitch = 0.01 m_line: line[multipass] = (b, q1, q2, q3, b) @@ -19,7 +19,33 @@ g_line: line = (m_line, m_line) m:marker, superimpose, ref = q1 -use, g_line +! + + +dd: drift, L = 0.5 + +bb: sbend, L = 0.5, g = 1, e1 = 0.1, dg = 0.001, roll = 0.001, x_offset = 0.002, + y_offset = 0.003, x_pitch = 0.004, y_pitch = 0.005, ref_tilt = 0.006 + +qq: quadrupole, L = 0.6, tilt = 0.0013, x_offset = 0.0023, + y_offset = 0.0033, x_pitch = 0.0043, y_pitch = 0.0053 + +gg: girder = {bb, qq}, tilt = 0.0017, x_offset = 0.0027, + y_offset = 0.0037, x_pitch = 0.0047, y_pitch = 0.0057, + dx_origin = 0.0015, dy_origin = 0.0025, dz_origin = 0.0035, + dtheta_origin = 0.0045, dphi_origin = 0.0055, dpsi_origin = 0.0065 + +g1_line: line = (dd, bb, qq) +g1_line[beta_a] = 10.0 +g1_line[beta_b] = 10.0 +g1_line[e_tot] = 10e6 +g1_line[geometry] = open + +! + +use, g_line, g1_line + + ! superimpose including overlapping superimpose diff --git a/regression_tests/girder_test/girder_test.f90 b/regression_tests/girder_test/girder_test.f90 index 0fd9aa4bb7..ddb0a6c0e1 100644 --- a/regression_tests/girder_test/girder_test.f90 +++ b/regression_tests/girder_test/girder_test.f90 @@ -11,11 +11,12 @@ program girder_test implicit none type (lat_struct), target :: lat +type (branch_struct), pointer :: branch type (ele_struct), pointer :: girder, slave, slave2, slave3 type (floor_position_struct), pointer :: floor real(rp) w_mat(3,3), w_mat_inv(3,3), mat3(3,3) -integer i, ig, j, k, nargs +integer i, ib, ig, j, k, nargs character(40) fmt character(100) lat_file diff --git a/regression_tests/girder_test/output.correct b/regression_tests/girder_test/output.correct index 707ad3c6cf..68622e9259 100644 --- a/regression_tests/girder_test/output.correct +++ b/regression_tests/girder_test/output.correct @@ -1,56 +1,56 @@ -"Floor-r: G1" ABS 1e-14 -0.146805901401513 -0.029759029485983 1.993338331746307 +"Floor-r: G1" ABS 1e-14 -0.097884203897885 -0.019842110447878 1.495836249107295 "Floor-ang: G1" ABS 1e-14 -0.098019529307013 -0.019835138682740 -0.000972926375666 -"Offset: Q1" ABS 1e-14 0.046371781923988 0.921400396528106 0.041105459519432 +"Offset: Q1" ABS 1e-14 -0.076897964491108 0.752794559086786 0.047642849828237 "Angle: Q1" ABS 1e-14 0.485457598537965 -0.635811218537202 -0.174207470732373 -"Offset: Q1\1" ABS 1e-14 0.046371781923988 0.921400396528106 0.041105459519432 +"Offset: Q1\1" ABS 1e-14 -0.076897964491108 0.752794559086786 0.047642849828237 "Angle: Q1\1" ABS 1e-14 0.485457598537965 -0.635811218537202 -0.174207470732373 -"Offset: Q1\1#1" ABS 1e-14 -0.047486311384804 1.069857998575694 0.113198183910146 +"Offset: Q1\1#1" ABS 1e-14 -0.170756057799899 0.901252161134374 0.119735574218951 "Angle: Q1\1#1" ABS 1e-14 0.485457598537965 -0.635811218537202 -0.174207470732373 -"Offset: Q1\1#2" ABS 1e-14 0.140229875232779 0.772942794480519 -0.030987264871282 +"Offset: Q1\1#2" ABS 1e-14 0.016960128817683 0.604336957039199 -0.024449874562478 "Angle: Q1\1#2" ABS 1e-14 0.485457598537965 -0.635811218537202 -0.174207470732373 -"Offset: Q1\2" ABS 1e-14 0.046371781923988 0.921400396528106 0.041105459519432 +"Offset: Q1\2" ABS 1e-14 -0.076897964491108 0.752794559086786 0.047642849828237 "Angle: Q1\2" ABS 1e-14 0.485457598537965 -0.635811218537202 -0.174207470732373 -"Offset: Q1\2#1" ABS 1e-14 -0.047486311384804 1.069857998575694 0.113198183910146 +"Offset: Q1\2#1" ABS 1e-14 -0.170756057799899 0.901252161134374 0.119735574218951 "Angle: Q1\2#1" ABS 1e-14 0.485457598537965 -0.635811218537202 -0.174207470732373 -"Offset: Q1\2#2" ABS 1e-14 0.140229875232779 0.772942794480519 -0.030987264871282 +"Offset: Q1\2#2" ABS 1e-14 0.016960128817683 0.604336957039199 -0.024449874562478 "Angle: Q1\2#2" ABS 1e-14 0.485457598537965 -0.635811218537202 -0.174207470732373 -"Offset: Q2" ABS 1e-14 0.271459219068249 0.490102571515717 -0.073842094701556 +"Offset: Q2" ABS 1e-14 0.148189472653153 0.321496734074396 -0.067304704392752 "Angle: Q2" ABS 1e-14 0.630840660487297 -0.712913774464071 0.951092701798358 -"Offset: Q2\1" ABS 1e-14 0.271459219068249 0.490102571515717 -0.073842094701556 +"Offset: Q2\1" ABS 1e-14 0.148189472653153 0.321496734074396 -0.067304704392752 "Angle: Q2\1" ABS 1e-14 0.630840660487297 -0.712913774464071 0.951092701798358 -"Offset: Q2\2" ABS 1e-14 0.271459219068249 0.490102571515717 -0.073842094701556 +"Offset: Q2\2" ABS 1e-14 0.148189472653153 0.321496734074396 -0.067304704392752 "Angle: Q2\2" ABS 1e-14 0.630840660487297 -0.712913774464071 0.951092701798358 "Floor-r: G2" ABS 1e-14 -0.195727598905141 -0.039675948524088 2.490840414385320 "Floor-ang: G2" ABS 1e-14 -0.098019529307013 -0.019835138682740 -0.000972926375666 -"Offset: G1" ABS 1e-14 -0.046654645555535 0.965966442681700 0.106224872847830 +"Offset: G1" ABS 1e-14 -0.241354081332431 0.960966526014617 0.145717402179350 "Angle: G1" ABS 1e-14 0.151763688412446 -0.333351476811979 -1.678268787813487 -"Offset: Q1" ABS 1e-14 0.046371781923988 0.921400396528106 0.041105459519432 +"Offset: Q1" ABS 1e-14 -0.076897964491108 0.752794559086786 0.047642849828237 "Angle: Q1" ABS 1e-14 0.485457598537965 -0.635811218537202 -0.174207470732373 -"Offset: Q1\1" ABS 1e-14 0.046371781923988 0.921400396528106 0.041105459519432 +"Offset: Q1\1" ABS 1e-14 -0.076897964491108 0.752794559086786 0.047642849828237 "Angle: Q1\1" ABS 1e-14 0.485457598537965 -0.635811218537202 -0.174207470732373 -"Offset: Q1\2" ABS 1e-14 0.046371781923988 0.921400396528106 0.041105459519432 +"Offset: Q1\2" ABS 1e-14 -0.076897964491108 0.752794559086786 0.047642849828237 "Angle: Q1\2" ABS 1e-14 0.485457598537965 -0.635811218537202 -0.174207470732373 -"Offset: Q2" ABS 1e-14 0.271459219068249 0.490102571515717 -0.073842094701556 +"Offset: Q2" ABS 1e-14 0.148189472653153 0.321496734074396 -0.067304704392752 "Angle: Q2" ABS 1e-14 0.630840660487297 -0.712913774464071 0.951092701798358 -"Offset: Q2\1" ABS 1e-14 0.271459219068249 0.490102571515717 -0.073842094701556 +"Offset: Q2\1" ABS 1e-14 0.148189472653153 0.321496734074396 -0.067304704392752 "Angle: Q2\1" ABS 1e-14 0.630840660487297 -0.712913774464071 0.951092701798358 -"Offset: Q2\2" ABS 1e-14 0.271459219068249 0.490102571515717 -0.073842094701556 +"Offset: Q2\2" ABS 1e-14 0.148189472653153 0.321496734074396 -0.067304704392752 "Angle: Q2\2" ABS 1e-14 0.630840660487297 -0.712913774464071 0.951092701798358 "Offset: Q3" ABS 1e-14 0.385488451996512 0.751932552031731 0.054479628369578 @@ -62,4 +62,12 @@ "Offset: Q3\2" ABS 1e-14 0.385488451996512 0.751932552031731 0.054479628369578 "Angle: Q3\2" ABS 1e-14 -0.013010576012546 -0.561036225925625 0.328377045720919 +"Floor-r: GG" ABS 1e-14 -0.204965922435703 0.001261189599625 1.006800471861731 +"Floor-ang: GG" ABS 1e-14 -0.382564007673231 0.003233160803172 0.006066312847914 +"Offset: BB" ABS 1e-14 0.003277143202213 0.005017917788674 -0.000159202167634 +"Angle: BB" ABS 1e-14 0.008668972933337 0.010905255504261 0.001882415766599 0.006000000000000 + +"Offset: QQ" ABS 1e-14 0.006055817539732 0.008459935538016 -0.000637544419745 +"Angle: QQ" ABS 1e-14 0.008959870698940 0.010804891564617 0.003607414073122 + "W_mat_inv" ABS 1E-14 3.47E-17 diff --git a/tao/code/tao_show_this.f90 b/tao/code/tao_show_this.f90 index d500ae4520..94fb228b13 100644 --- a/tao/code/tao_show_this.f90 +++ b/tao/code/tao_show_this.f90 @@ -3286,9 +3286,9 @@ subroutine tao_show_this (what, result_id, lines, nl) else select case (where) - case ('exit'); line1 = '# Values shown are for the Downstream End of each Element:' - case ('middle'); line1 = '# Values shown are for the Center of each Element:' - case ('beginning'); line1 = '# Values shown are for the Upstream of each Element:' + case ('exit'); line1 = '# Values shown are for the Downstream End of each Element (Girder at ref point):' + case ('middle'); line1 = '# Values shown are for the Center of each Element (Girder at ref point):' + case ('beginning'); line1 = '# Values shown are for the Upstream of each Element (Girder at ref point):' end select if (size(lat%branch) > 1) line1 = '# Branch ' // int_str(branch%ix_branch) // '.' // line1(2:) @@ -5260,7 +5260,7 @@ subroutine tao_show_this (what, result_id, lines, nl) i0 = ele%ix_ele-1 call transfer_map_calc (lat, taylor, err, i0, ele%ix_ele, u%model%tao_branch(ix_branch)%orbit(i0), ele%ix_branch) call truncate_taylor_to_order (taylor, n_order, taylor) - call type_taylors (taylor, lines = alloc_lines, n_lines = n, out_style = disp_fmt, clean = .true.) + call type_taylors (taylor, lines = alloc_lines, n_lines = n, clean = .true.) do j = 1, n nl=nl+1; lines(nl) = alloc_lines(j) enddo @@ -5271,12 +5271,12 @@ subroutine tao_show_this (what, result_id, lines, nl) if (n_order > 1) then if (angle_units) call map_to_angle_coords (taylor, taylor) if (n_order > 1) call truncate_taylor_to_order (taylor, n_order, taylor) - call type_taylors (taylor, lines = lines, n_lines = nl, out_style = disp_fmt, clean = .true.) + call type_taylors (taylor, lines = lines, n_lines = nl, clean = .true.) if (print_eigen) call taylor_to_mat6 (taylor, taylor%ref, vec0, mat6) elseif (disp_fmt == 'BMAD') then call mat6_to_taylor (vec0, mat6, taylor, ref_vec) - call type_taylors (taylor, lines = lines, n_lines = nl, out_style = disp_fmt, clean = .true.) + call type_taylors (taylor, lines = lines, n_lines = nl, clean = .true.) else if (angle_units) then diff --git a/tao/version/tao_version_mod.f90 b/tao/version/tao_version_mod.f90 index 8212858b20..73ed43d166 100644 --- a/tao/version/tao_version_mod.f90 +++ b/tao/version/tao_version_mod.f90 @@ -6,5 +6,5 @@ !- module tao_version_mod -character(*), parameter :: tao_version_date = "2024/08/04 00:48:43" +character(*), parameter :: tao_version_date = "2024/08/04 18:58:36" end module