diff --git a/.gitignore b/.gitignore index bdebc56194..4f7e6cdaa3 100644 --- a/.gitignore +++ b/.gitignore @@ -62,6 +62,7 @@ bmad-doc/tutorial_ring_design/doc/tutorial_ring_design.pdf **/doit regression_tests/*/output.now +regression_tests/write_foreign_test/write_foreign_test.*.now regression_tests/*/lat.bmad regression_tests/*/r regression_tests/*/rr diff --git a/bmad/doc/attributes.tex b/bmad/doc/attributes.tex index 1f02854a39..998a928a0c 100644 --- a/bmad/doc/attributes.tex +++ b/bmad/doc/attributes.tex @@ -506,15 +506,34 @@ \section{Orientation: Offset, Pitch, Tilt, and Roll Attributes} \item\vn{Girder Elements} (\sref{s:girder.orient}) \Newline % \item\vn{Control Elements} \Newline -Control elements are elements that control attributes of other -elements. The control elements are: +Control elements are elements that control attributes of other elements. Except for \vn{girder} +control elements, these elements do not have orientational attributes. Control elements that fall +into this list are: \begin{example} group overlay + ramper \end{example} -These elements do not have orientational attributes. \end{enumerate} +%----------------------------------------------------------------- +\subsection{Global Random Misalignment of Elements} +\label{s:global.mis} + +It is often convenient to randomly misalign sets of elements. This can be done using the \vn{ran} +and \vn{ran_gauss} functions (\sref{s:functions}). For example: +\begin{example} + quadrupole::bnd10:bnd20[y_offset] = 1.4e-6*ran_gauss(5) +\end{example} +The above line sets the \vn{y_offset} of all the quadrupoles in the range from element \vn{BND10} to +element \vn{BND20}. + +When \vn{ran} or \vn{ran_gauss} is used in a lattice file, each time the file is read in, a new set +of random numbers are generated unless \vn{parameter[ran_seed]} is set to a non-zero value in the +lattice file before \vn{ran} or \vn{ran_gauss} is used. To save a particular set of generated +random values, write out the lattice file (the \vn{write bmad} command can be used if running \tao) +after it has been read in. + %----------------------------------------------------------------- \subsection{Straight Line Element Orientation} \label{s:straight.orient} @@ -1154,7 +1173,7 @@ \section{X-Rays Crystal \& Compound Materials} \section{X-Ray Reflectivity Tables} \label{s:reflect} -Reflectivity tables are used to define reflectivity propabilities as functions of incidence angle and +Reflectivity tables are used to define reflectivity probabilities as functions of incidence angle and photon energy for \vn{crystal} and \vn{mirror} elements. The general syntax is: @@ -1181,7 +1200,7 @@ \section{X-Ray Reflectivity Tables} \begin{example} pi ! Table is for pi mode sigma ! Table is for sigma mode - both ! Table is for both polarizations. Defalut. + both ! Table is for both polarizations. Default. \end{example} An element needs a single table with \vn{polarization} marked as \vn{both} or two tables, one for \vn{sigma} and the other for \vn{pi}. diff --git a/bmad/doc/cover-page.tex b/bmad/doc/cover-page.tex index 4bd34e891f..98b7c8f783 100644 --- a/bmad/doc/cover-page.tex +++ b/bmad/doc/cover-page.tex @@ -3,7 +3,7 @@ \begin{flushright} \large - Revision: September 6, 2024 \\ + Revision: September 13, 2024 \\ \end{flushright} \pdfbookmark[0]{Preamble}{Preamble} diff --git a/bmad/interface/opal_interface_mod.f90 b/bmad/interface/opal_interface_mod.f90 index 91e14a52d9..0c78418046 100644 --- a/bmad/interface/opal_interface_mod.f90 +++ b/bmad/interface/opal_interface_mod.f90 @@ -1,6 +1,6 @@ module opal_interface_mod -use write_lat_file_mod +use write_lattice_file_mod private write_opal_line diff --git a/bmad/modules/bmad_routine_interface.f90 b/bmad/modules/bmad_routine_interface.f90 index 5e9f9bea42..7a0a6287a0 100644 --- a/bmad/modules/bmad_routine_interface.f90 +++ b/bmad/modules/bmad_routine_interface.f90 @@ -3362,12 +3362,48 @@ subroutine write_lattice_in_foreign_format (out_type, out_file_name, lat, ref_or logical, optional :: use_matrix_model, include_apertures, err end subroutine -subroutine write_lattice_in_julia (bmad_name, lat, julia_name) +subroutine write_lattice_in_mad_format (out_type, out_file_name, lat, ref_orbit, use_matrix_model, & + include_apertures, dr12_drift_max, ix_branch, converted_lat, err) + import + implicit none + type (lat_struct), target :: lat + type (lat_struct), optional, target :: converted_lat + type (coord_struct), allocatable, optional :: ref_orbit(:) + real(rp), optional :: dr12_drift_max + integer, optional :: ix_branch + character(*) out_type, out_file_name + logical, optional :: use_matrix_model, include_apertures, err +end subroutine + +subroutine write_lattice_in_elegant_format (out_file_name, lat, ref_orbit, use_matrix_model, & + include_apertures, dr12_drift_max, ix_branch, converted_lat, err) import implicit none type (lat_struct), target :: lat - character(*) bmad_name - character(*), optional :: julia_name + type (lat_struct), optional, target :: converted_lat + type (coord_struct), allocatable, optional :: ref_orbit(:) + real(rp), optional :: dr12_drift_max + integer, optional :: ix_branch + character(*) out_file_name + logical, optional :: use_matrix_model, include_apertures, err +end subroutine + +subroutine write_lattice_in_sad_format (out_file_name, lat, include_apertures, ix_branch, converted_lat, err) + import + implicit none + type (lat_struct), target :: lat + type (lat_struct), optional, target :: converted_lat + integer, optional :: ix_branch + character(*) out_file_name + logical, optional :: include_apertures, err +end subroutine + +subroutine write_lattice_in_julia (julia_name, lat, err_flag) + import + implicit none + type (lat_struct), target :: lat + character(*) :: julia_name + logical, optional :: err_flag end subroutine subroutine xsif_parser (xsif_file, lat, make_mats6, digested_read_ok, use_line, err_flag) diff --git a/bmad/modules/bookkeeper_mod.f90 b/bmad/modules/bookkeeper_mod.f90 index 885fbda8d2..994b1a617c 100644 --- a/bmad/modules/bookkeeper_mod.f90 +++ b/bmad/modules/bookkeeper_mod.f90 @@ -1080,11 +1080,15 @@ subroutine makeup_super_slave (lat, slave, err_flag) T_end(4,1) = ks / 2 T_end(2,3) = -ks / 2 - call init_ele (sol_quad) + + call transfer_ele (slave, sol_quad) sol_quad%key = sol_quad$ sol_quad%value(ks$) = ks sol_quad%value(k1$) = k1 sol_quad%value(l$) = l_slave + call set_flags_for_changed_attribute(sol_quad, sol_quad%value(ks$)) + call set_flags_for_changed_attribute(sol_quad, sol_quad%value(k1$)) + call set_flags_for_changed_attribute(sol_quad, sol_quad%value(l$)) call make_mat6 (sol_quad, branch%param) T_tot = sol_quad%mat6(1:4,1:4) diff --git a/bmad/output/write_bmad_lattice_file.f90 b/bmad/output/write_bmad_lattice_file.f90 index 740be6184e..613a968b9c 100644 --- a/bmad/output/write_bmad_lattice_file.f90 +++ b/bmad/output/write_bmad_lattice_file.f90 @@ -25,7 +25,7 @@ subroutine write_bmad_lattice_file (bmad_file, lat, err, output_form, orbit0) -use write_lat_file_mod, dummy => write_bmad_lattice_file +use write_lattice_file_mod, dummy => write_bmad_lattice_file use expression_mod, only: end_stack$, variable$, split_expression_string, expression_stack_to_string implicit none diff --git a/bmad/output/write_lattice_file_mod.f90 b/bmad/output/write_lattice_file_mod.f90 new file mode 100644 index 0000000000..9ac23539eb --- /dev/null +++ b/bmad/output/write_lattice_file_mod.f90 @@ -0,0 +1,509 @@ +module write_lattice_file_mod + +use element_modeling_mod +use binary_parser_mod +use multipole_mod + +type multipass_region_ele_struct + integer ix_region + logical region_start_pt + logical region_stop_pt +end type + +type multipass_region_branch_struct + type (multipass_region_ele_struct), allocatable :: ele(:) +end type + +type multipass_region_lat_struct + type (multipass_region_branch_struct), allocatable :: branch(:) +end type + +logical, save :: write_lat_debug_flag = .false. + +contains + +!------------------------------------------------------- +!------------------------------------------------------- +!------------------------------------------------------- +! Create the information on multipass regions. + +subroutine multipass_region_info(lat, mult_lat, m_info) + +implicit none + +type (lat_struct), target :: lat +type (branch_struct), pointer :: branch +type (ele_struct), pointer :: ele +type (multipass_region_lat_struct), target :: mult_lat +type (multipass_all_info_struct), target :: m_info + +type (multipass_region_ele_struct), pointer :: mult_ele(:), m_ele +type (multipass_ele_info_struct), pointer :: e_info +type (ele_pointer_struct), pointer :: ss1(:), ss2(:) + +integer ib, ix_r, ie, ix_pass, ix_lord, ix_super +logical in_multi_region, need_new_region + +! + +allocate (mult_lat%branch(0:ubound(lat%branch, 1))) +do ib = 0, ubound(lat%branch, 1) + branch => lat%branch(ib) + allocate (mult_lat%branch(ib)%ele(0:branch%n_ele_max)) + mult_lat%branch(ib)%ele(:)%ix_region = 0 + mult_lat%branch(ib)%ele(:)%region_start_pt = .false. + mult_lat%branch(ib)%ele(:)%region_stop_pt = .false. +enddo + +call multipass_all_info (lat, m_info) + +if (size(m_info%lord) == 0) return + +! Go through and mark all 1st pass regions +! In theory the original lattice file could have something like: +! lat: line = (..., m1, m2, ..., m1, -m2, ...) +! where m1 and m2 are multipass lines. The first pass region (m1, m2) looks +! like this is one big region but the later (m1, -m2) signals that this +! is not so. +! We thus go through all the first pass regions and compare them to the +! corresponding higher pass regions. If we find two elements that are contiguous +! in the first pass region but not contiguous in some higher pass region, +! we need to break the first pass region into two. + +ix_r = 0 +do ib = 0, ubound(lat%branch, 1) + branch => lat%branch(ib) + mult_ele => mult_lat%branch(ib)%ele + + in_multi_region = .false. + + do ie = 1, branch%n_ele_track + ele => branch%ele(ie) + e_info => m_info%branch(ib)%ele(ie) + ix_pass = e_info%ix_pass + + if (ix_pass /= 1) then ! Not a first pass region + if (in_multi_region) mult_ele(ie-1)%region_stop_pt = .true. + in_multi_region = .false. + cycle + endif + + ! If start of a new region... + if (.not. in_multi_region) then + ix_r = ix_r + 1 + mult_ele(ie)%ix_region = ix_r + mult_ele(ie)%region_start_pt = .true. + in_multi_region = .true. + ix_lord = e_info%ix_lord(1) + ix_super = e_info%ix_super(1) + ss1 => m_info%lord(ix_lord)%slave(:,ix_super) + cycle + endif + ix_lord = e_info%ix_lord(1) + ix_super = e_info%ix_super(1) + ss2 => m_info%lord(ix_lord)%slave(:, ix_super) + + need_new_region = .false. + if (size(ss1) /= size(ss2)) then + need_new_region = .true. + else + do ix_pass = 2, size(ss1) + if (abs(ss1(ix_pass)%ele%ix_ele - ss2(ix_pass)%ele%ix_ele) == 1) cycle + ! not contiguous then need a new region + need_new_region = .true. + exit + enddo + endif + + if (need_new_region) then + ix_r = ix_r + 1 + mult_ele(ie-1)%region_stop_pt = .true. + mult_ele(ie)%region_start_pt = .true. + endif + + ss1 => ss2 + mult_ele(ie)%ix_region = ix_r + enddo + +enddo + +if (in_multi_region) mult_ele(branch%n_ele_track)%region_stop_pt = .true. + +end subroutine multipass_region_info + +!------------------------------------------------------- +!------------------------------------------------------- +!------------------------------------------------------- + +subroutine write_line_element (line, iu, ele, lat) + +implicit none + +type (lat_struct), target :: lat +type (ele_struct) :: ele +type (ele_struct), pointer :: lord, m_lord, slave + +character(*) line +character(40) lord_name + +integer iu, ix + +! + +if (ele%slave_status == super_slave$) then + if (ele%orientation == 1) then + write (line, '(a, 2(a, i0), a)') trim(line), ' slave_drift_', ele%ix_branch, '_', ele%ix_ele, ',' + else + write (line, '(a, 2(a, i0), a)') trim(line), ' --slave_drift_', ele%ix_branch, '_', ele%ix_ele, ',' + endif + +elseif (ele%slave_status == multipass_slave$) then + lord => pointer_to_lord(ele, 1) + write (line, '(4a)') trim(line), ' ', trim(lord%name), ',' + +else + if (ele%orientation == 1) then + write (line, '(4a)') trim(line), ' ', trim(ele%name), ',' + else + write (line, '(4a)') trim(line), ' --', trim(ele%name), ',' + endif +endif + +if (len_trim(line) > 100) call write_lat_line(line, iu, .false.) + +end subroutine write_line_element + +!------------------------------------------------------- +!------------------------------------------------------- +!------------------------------------------------------- + +function re_str(rel) result (str_out) + +implicit none + +real(rp) rel +integer pl, n +character(:), allocatable :: str_out +character(24) str +character(16) fmt + +! + +if (rel == 0) then + allocate(character(1):: str_out) + str_out = '0' + return +endif + +pl = floor(log10(abs(rel))) + +if (pl > 5) then + fmt = '(2a, i0)' + write (str, fmt) trim(rchomp(rel/10.0_rp**pl, 0)), 'E', pl + +elseif (pl > -3) then + str = rchomp(rel, pl) + +else + fmt = '(2a, i0)' + write (str, fmt) trim(rchomp(rel*10.0_rp**(-pl), 0)), 'E', pl +endif + +n = len_trim(str) +allocate(character(n):: str_out) +str_out = str(1:n) + + +end function re_str + +!------------------------------------------------------- +!------------------------------------------------------- +!------------------------------------------------------- + +function array_re_str(arr, parens_in) result (str_out) + +real(rp) arr(:) +integer i +character(120) str_out +character(*), optional :: parens_in +character(2) parens + +! + +parens = '()' +if (present(parens_in)) parens = parens_in + +str_out = parens(1:1) // re_str(arr(1)) +do i = 2, size(arr) + str_out = trim(str_out) // ', ' // re_str(arr(i)) +enddo +str_out = trim(str_out) // parens(2:2) + +end function array_re_str + +!------------------------------------------------------- +!------------------------------------------------------- +!------------------------------------------------------- + +function cmplx_re_str(cmp) result (str_out) + +complex(rp) cmp +character(40) str_out + +! + +if (imag(cmp) == 0) then + str_out = re_str(real(cmp)) +else + str_out = '(' // re_str(real(cmp)) // ', ' // re_str(imag(cmp)) // ')' +endif + +end function cmplx_re_str + +!------------------------------------------------------- +!------------------------------------------------------- +!------------------------------------------------------- + +function rchomp (rel, plc) result (out) + +implicit none + +real(rp) rel +character(25) out +character(8) :: fmt = '(f24.xx)' +integer it, plc, ix + +! The output when running with debug has less precision to prevent slight shifts in numbers (which happens +! when the translation code is run with different compilers) from changing the output. Output produced +! when running debug is used in regression testing. + +if (write_lat_debug_flag) then + write (fmt(6:7), '(i2.2)') 5-plc ! 6 digits of accuracy +else + write (fmt(6:7), '(i2.2)') 14-plc ! 15 digits of accuracy +endif + +write (out, fmt) rel +do it = len(out), 1, -1 + if (out(it:it) == ' ') cycle + if (out(it:it) == '0') then + out(it:it) = ' ' + cycle + endif + if (out(it:it) == '.') out(it:it) = ' ' + call string_trim(out, out, ix) + return +enddo + +end function rchomp + +!------------------------------------------------------- +!------------------------------------------------------- +!------------------------------------------------------- +!+ +! Subroutine write_lat_line (line, iu, end_is_neigh, do_split) +! +! Routine to write strings to a lattice file. +! This routine will break the string up into multiple lines +! if the string is too long and add a continuation character if needed. +! +! If the "line" arg does not represent a full "sentence" (end_is_neigh = False), +! then only part of the line may be written and the part not written will be returned. +! +! Input: +! line -- character(*): String of text. +! iu -- integer: Unit number to write to. +! end_is_neigh -- logical: If true then write out everything. +! Otherwise wait for a full line of max_char characters or so. +! do_split -- logical, optional: Split line if overlength? Default is True. +! False is used when line has already been split for expressions since +! the expression splitting routine does a much better job of it. +! julia -- logical, optional: Default False. If True then do not include "&" line continuation +! +! Output: +! line -- character(*): part of the string not written. +! If end_is_neigh = T then line will be blank. +!- + +subroutine write_lat_line (line, iu, end_is_neigh, do_split, julia) + +implicit none + +character(*) line +integer i, iu, n +integer, parameter :: max_char = 105 +logical end_is_neigh +logical, save :: init = .true. +logical, optional :: do_split, julia + +! + +if (.not. logic_option(.true., do_split)) then + n = len_trim(line) + if (end_is_neigh) then + call write_this (line) + init = .true. + elseif (index(',[{(=', line(n:n)) /= 0) then + call write_this (line) + else + if (logic_option(.false., julia)) then + call write_this (trim(line)) + else + call write_this (trim(line) // ' &') + endif + endif + + line = '' + return +endif + +! + +outer_loop: do + + if (len_trim(line) <= max_char) then + if (end_is_neigh) then + call write_this (line) + line = '' + init = .true. + endif + return + endif + + i = index(line(1:max_char), ',', back = .true.) + if (i /= 0) then + call write_this (line(:i)) + line = line(i+1:) + cycle outer_loop + endif + + i = index(line, ',', back = .true.) + if (i /= 0) then + call write_this (line(:i)) + line = line(i+1:) + cycle outer_loop + endif + + if (end_is_neigh) then + call write_this (line) + init = .true. + return + endif + + if (logic_option(.false., julia)) then + call write_this (trim(line)) + else + call write_this (trim(line) // ' &') + endif + line = '' + return + +enddo outer_loop + +!----------------------------------- + +contains + +subroutine write_this (line2) + +character(*) line2 +character(20) fmt + +! + +if (init) then + fmt = '(a, 1x, a)' + init = .false. +else + fmt = '(2x, a, 1x, a)' +endif + +write (iu, fmt) trim(line2) + +end subroutine write_this + +end subroutine write_lat_line + +!-------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------- + +subroutine value_to_line (line, value, str, typ, ignore_if_zero, use_comma) + +use precision_def + +implicit none + +character(*) line, str +character(40) fmt, val_str +character(*) typ + +real(rp) value + +integer ix + +logical, optional :: ignore_if_zero, use_comma + +! + +if (value == 0 .and. logic_option(.true., ignore_if_zero)) return + +if (logic_option(.true., use_comma)) then + if (str == '') then + line = trim(line) // ',' + else + line = trim(line) // ', ' // trim(str) // ' =' + endif +else + if (str /= '') then + line = trim(line) // ' ' // trim(str) // ' =' + endif +endif + +if (value == 0) then + line = trim(line) // ' 0' + return +endif + +if (typ == 'R') then + val_str = re_str(value) +elseif (typ == 'I') then + write (val_str, '(i0)') nint(value) +else + print *, 'ERROR IN VALUE_TO_LINE. BAD "TYP": ', typ + if (global_com%exit_on_error) call err_exit +endif + +call string_trim(val_str, val_str, ix) +line = trim(line) // ' ' // trim(val_str) + +end subroutine value_to_line + +!-------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------- + +subroutine add_this_name_to_list (ele, names, an_indexx, n_names, ix_match, has_been_added, named_eles) + +type (ele_struct), target :: ele +type (ele_pointer_struct), allocatable :: named_eles(:) ! List of unique element names + +integer, allocatable :: an_indexx(:) +integer n_names, ix_match +logical has_been_added +character(40), allocatable :: names(:) + +! + +if (size(names) < n_names + 1) then + call re_allocate(names, 2*size(names)) + call re_allocate(an_indexx, 2*size(names)) + call re_allocate_eles(named_eles, 2*size(names), .true.) +endif +call find_index (ele%name, names, an_indexx, n_names, ix_match, add_to_list = .true., has_been_added = has_been_added) +if (has_been_added) named_eles(n_names)%ele => ele + +end subroutine add_this_name_to_list + +end module + diff --git a/bmad/output/write_lattice_in_elegant_format.f90 b/bmad/output/write_lattice_in_elegant_format.f90 new file mode 100644 index 0000000000..61f55d5ec8 --- /dev/null +++ b/bmad/output/write_lattice_in_elegant_format.f90 @@ -0,0 +1,944 @@ +!+ +! Subroutine write_lattice_in_elegant_format (out_file_name, lat, ref_orbit, & +! use_matrix_model, include_apertures, dr12_drift_max, ix_branch, converted_lat, err) +! +! Subroutine to write an Elegant lattice file using the +! information in a lat_struct. Optionally, only part of the lattice can be generated. +! +! To write a Bmad lattice file, use: write_bmad_lattice_file +! +! Note: sol_quad elements are replaced by a drift-matrix-drift or solenoid-quad model. +! Note: wiggler elements are replaced by a drift-matrix-drift or drift-bend model. +! +! Input: +! out_file_name -- character(*): Name of the mad output lattice file. +! lat -- lat_struct: Holds the lattice information. +! ref_orbit(0:) -- coord_struct, allocatable, optional: Referece orbit for sad_mult and patch elements. +! This argument must be present if the lattice has sad_mult or patch elements and is +! being translated to MAD-8 or SAD. +! use_matrix_model -- logical, optional: Use a drift-matrix_drift model for wigglers/undulators? +! [A MAD "matrix" is a 2nd order Taylor map.] This switch is ignored for SAD conversion. +! Default is False -> Use a bend-drift-bend model. +! Note: sol_quad elements always use a drift-matrix-drift model. +! include_apertures -- logical, optional: If True (the default), add to the output lattice a zero length +! collimator element next to any non-collimator element that has an aperture. +! Note: MADX translations for non-drift elements can handle non-collimator elements +! with an aperture so in this case this argument is ignored. +! dr12_drift_max -- real(rp), optional: Max deviation for drifts allowed before a correction matrix element +! is added. Default value is 1d-5. A negative number means use default. +! ix_branch -- Integer, optional: Index of lattice branch to use. Default = 0. +! +! Output: +! converted_lat -- lat_struct, optional: Equivalent Bmad lattice with wiggler and +! sol_quad elements replaced by their respective models. +! err -- logical, optional: Set True if, say a file could not be opened. +!- + +subroutine write_lattice_in_elegant_format (out_file_name, lat, ref_orbit, & + use_matrix_model, include_apertures, dr12_drift_max, ix_branch, converted_lat, err) + +use bmad, dummy => write_lattice_in_elegant_format +use write_lattice_file_mod, dummy3 => write_lattice_in_elegant_format +use ptc_interface_mod, only: taylor_inverse, concat_taylor + +implicit none + +type (lat_struct), target :: lat, lat_model, lat_out +type (lat_struct), optional, target :: converted_lat +type (ele_struct), pointer :: ele, ele1, ele2, lord, sol_ele, first_sol_edge +type (ele_struct) :: drift_ele, ab_ele, taylor_ele, col_ele, kicker_ele, null_ele, bend_ele, quad_ele +type (coord_struct) orb_start, orb_end, orb_center +type (coord_struct), allocatable, optional :: ref_orbit(:) +type (coord_struct), allocatable :: orbit_out(:) +type (taylor_term_struct) :: term +type (branch_struct), pointer :: branch, branch_out +type (taylor_struct) taylor_a(6), taylor_b(6) +type (taylor_struct), pointer :: taylor_ptr(:) +type (all_pointer_struct) a_ptr + +real(rp), optional :: dr12_drift_max +real(rp) field, hk, vk, limit(2), length, a, b, f, e2, beta, r_max, r0, dr12_max +real(rp), pointer :: val(:) +real(rp) knl(0:n_pole_maxx), tilts(0:n_pole_maxx), a_pole(0:n_pole_maxx), b_pole(0:n_pole_maxx) +real(rp) tilt, x_pitch, y_pitch, etilt, epitch, eyaw, offset(3), w_mat(3,3) + +integer, optional :: ix_branch +integer, allocatable :: n_repeat(:), an_indexx(:) +integer i, j, ib, j2, k, n, ix, i_unique, i_line, iout, iu, n_names, j_count, f_count, ix_ele +integer ie, ios, a_count, ix_lord, ix_match, iv, ifa, ix_pole_max +integer ix1, ix2, n_lord, aperture_at, n_name_change_warn, n_elsep_warn, n_taylor_order_saved +integer :: ix_line_min, ix_line_max, n_warn_max, n_wig_model_err, print_wig_model_err_max + +character(*), parameter :: r_name = "write_lattice_in_elegant_format" +character(*) out_file_name +character(300) line, knl_str, ksl_str +character(40) orig_name, str, bmad_params(20), elegant_params(20) +character(40), allocatable :: names(:) +character(4000) line_out ! Can be this large for taylor maps. +character(2) continue_char, eol_char, comment_char, separator_char +character(1), parameter :: num(9) = ['1', '2', '3', '4', '5', '6', '7', '8', '9'] + +logical, optional :: use_matrix_model, include_apertures, err +logical init_needed, err_flag, monopole +logical parsing, warn_printed, converted, ptc_exact_model +logical print_err + +! Use ptc exact_model = True since this is needed to get the drift nonlinear terms + +ptc_exact_model = ptc_com%exact_model +ptc_com%exact_model = .true. +dr12_max = real_option(1d-5, dr12_drift_max) +if (dr12_max < 0) dr12_max = 1d-5 + +! Init + +n_warn_max = 10 +n_wig_model_err = 0 +print_wig_model_err_max = 5 + +ix = integer_option(0, ix_branch) +if (ix < 0 .or. ix > ubound(lat%branch, 1)) then + call out_io (s_error$, r_name, 'BRANCH INDEX OUT OF RANGE: /i0/ ', i_array = [ix]) + return +endif + +branch => lat%branch(ix) + +comment_char = '!' +continue_char = ' &' +eol_char = '' +separator_char = ',' +ix_line_max = 80 + +call out_io (s_info$, r_name, '! NOTE: ELEGANT TRANSLATION IN DEVELOPMENT. PLEASE USE WITH CAUTION!.') + +ix_line_min = ix_line_max - 20 + +call init_ele (col_ele) +call init_ele (drift_ele, drift$) +call init_ele (taylor_ele, taylor$) +call init_ele (ab_ele, ab_multipole$) +call init_ele (kicker_ele, kicker$) +call init_ele (quad_ele, quadrupole$) +call init_ele (bend_ele, sbend$) +call multipole_init (ab_ele, magnetic$) +null_ele%key = null_ele$ + +allocate (names(branch%n_ele_max+10), an_indexx(branch%n_ele_max+10)) ! list of element names + +call out_io (s_info$, r_name, & + 'Note: In general, Bmad lattice elements can have attributes that cannot be translated. ', & + ' For example, higher order terms in a Taylor element.', & + ' Please use caution when using a translated lattice.') + + +! open file + +if (present(err)) err = .true. +n_taylor_order_saved = ptc_private%taylor_order_ptc + +iu = lunget() +call fullfilename (out_file_name, line) +open (iu, file = line, iostat = ios) +if (ios /= 0) then + call out_io (s_error$, r_name, 'CANNOT OPEN FILE: ' // trim(out_file_name)) + return +endif + +!----------------------------------------------------------------------------- +! Translation is a two step process: +! 1) Create a new lattice called lat_out making substitutions for sol_quad and wiggler elements, etc.. +! 2) Use lat_out to create the lattice file. + +lat_out = lat +call allocate_lat_ele_array(lat_out, 2*branch%n_ele_max, branch%ix_branch) +branch_out => lat_out%branch(branch%ix_branch) + +if (present(ref_orbit)) then + call reallocate_coord(orbit_out, size(ref_orbit)) + orbit_out = ref_orbit +else + call reallocate_coord(orbit_out, branch%n_ele_max) +endif + +f_count = 0 ! fringe around bends and quads. Also drift nonlinearities. +j_count = 0 ! drift around solenoid or sol_quad index. Also z shift count. +a_count = 0 ! Aperture count +i_unique = 1000 + +! Loop over all input elements + +nullify(first_sol_edge) +n_name_change_warn = 0 +n_elsep_warn = 0 +ix_ele = 0 + +do + ix_ele = ix_ele + 1 + if (ix_ele > branch_out%n_ele_track) exit + ele => branch_out%ele(ix_ele) + if (ele%key == -1) cycle ! Has been marked for delection + + val => ele%value + + ! If there is an aperture with an element that is not an ecoll or rcoll then need to make a separate + + if ((val(x1_limit$) /= 0 .or. val(x2_limit$) /= 0 .or. val(y1_limit$) /= 0 .or. val(y2_limit$) /= 0) .and. & + ele%key /= ecollimator$ .and. ele%key /= rcollimator$ .and. logic_option(.true., include_apertures) .and. & + (ele%key == drift$)) then + + if (val(x1_limit$) /= val(x2_limit$)) then + call out_io (s_warn$, r_name, 'Asymmetric x_limits cannot be converted for: ' // ele%name, & + 'Will use largest limit here.') + val(x1_limit$) = max(val(x1_limit$), val(x2_limit$)) + endif + + if (val(y1_limit$) /= val(y2_limit$)) then + call out_io (s_warn$, r_name, 'Asymmetric y_limits cannot be converted for: ' // ele%name, & + 'Will use largest limit here.') + val(y1_limit$) = max(val(y1_limit$), val(y2_limit$)) + endif + + ! create ecoll and rcoll elements. + + if (ele%aperture_type == rectangular$) then + col_ele%key = rcollimator$ + else + col_ele%key = ecollimator$ + endif + a_count = a_count + 1 + write (col_ele%name, '(a, i0)') 'COLLIMATOR_N', a_count + col_ele%value = val + col_ele%value(l$) = 0 + val(x1_limit$) = 0; val(x2_limit$) = 0; val(y1_limit$) = 0; val(y2_limit$) = 0; + aperture_at = ele%aperture_at ! Save since ele pointer will be invalid after the insert + if (aperture_at == both_ends$ .or. aperture_at == downstream_end$ .or. aperture_at == continuous$) then + call insert_element (lat_out, col_ele, ix_ele+1, branch_out%ix_branch, orbit_out) + endif + if (aperture_at == both_ends$ .or. aperture_at == upstream_end$ .or. aperture_at == continuous$) then + call insert_element (lat_out, col_ele, ix_ele, branch_out%ix_branch, orbit_out) + endif + ix_ele = ix_ele - 1 ! Want to process the element again on the next loop. + + cycle ! cycle since ele pointer is invalid + + endif + + ! If the bend has a roll then put kicker elements just before and just after + + if (ele%key == sbend$ .and. val(roll$) /= 0) then + j_count = j_count + 1 + write (kicker_ele%name, '(a, i0)') 'ROLL_Z', j_count + kicker_ele%value(hkick$) = val(angle$) * (1 - cos(val(roll$))) / 2 + kicker_ele%value(vkick$) = -val(angle$) * sin(val(roll$)) / 2 + val(roll$) = 0 ! So on next iteration will not create extra kickers. + call insert_element (lat_out, kicker_ele, ix_ele, branch_out%ix_branch, orbit_out) + call insert_element (lat_out, kicker_ele, ix_ele+2, branch_out%ix_branch, orbit_out) + cycle + endif + + ! If there is a multipole component then put multipole elements at half strength + ! just before and just after the element. Exception: With Elegant if there is only one multipole for a quad, sextupole, or octupole + + monopole = .false. + select case (ele%key) + case (quadrupole$, sextupole$, octupole$, thick_multipole$) ! Elegant + call multipole_ele_to_kt(ele, .true., ix_pole_max, knl, tilts, magnetic$, include_kicks$) + if (count(knl /= 0) == 1 .and. all(knl(0:3) == 0)) monopole = .true. + end select + + if (.not. monopole .and. ele%key /= multipole$ .and. ele%key /= ab_multipole$ .and. ele%key /= null_ele$ .and. ele%key /= sad_mult$) then + call multipole_ele_to_ab (ele, .true., ix_pole_max, ab_ele%a_pole, ab_ele%b_pole) + if (ix_pole_max > -1) then + ab_ele%a_pole = ab_ele%a_pole / 2 + ab_ele%b_pole = ab_ele%b_pole / 2 + if (associated(ele%a_pole)) then + deallocate (ele%a_pole, ele%b_pole) + call attribute_bookkeeper(ele, .true.) + endif + j_count = j_count + 1 + write (ab_ele%name, '(a1, a, i0)') key_name(ele%key), 'MULTIPOLE_', j_count + call insert_element (lat_out, ab_ele, ix_ele, branch_out%ix_branch, orbit_out) + call insert_element (lat_out, ab_ele, ix_ele+2, branch_out%ix_branch, orbit_out) + cycle + endif + endif + + ! If there are nonzero kick values and this is not a kick type element then put + ! kicker elements at half strength just before and just after the element. + ! Also add a matrix element to get the change in z correct. + ! A sad_mult gets translated to a matrix element which has kick components so no extra kickers needed here. + + if (has_hkick_attributes(ele%key)) then + if (ele%key /= kicker$ .and. ele%key /= hkicker$ .and. ele%key /= vkicker$ .and. ele%key /= sad_mult$) then + if (val(hkick$) /= 0 .or. val(vkick$) /= 0) then + j_count = j_count + 1 + write (kicker_ele%name, '(a1, a, i0)') key_name(ele%key), '_KICKER_', j_count + kicker_ele%value(hkick$) = val(hkick$) / 2 + kicker_ele%value(vkick$) = val(vkick$) / 2 + val(hkick$) = 0; val(vkick$) = 0 + if (ele%key == sbend$) then + f = val(dg$) * val(l$) / 2 + kicker_ele%value(hkick$) = kicker_ele%value(hkick$) - cos(ele%value(ref_tilt_tot$)) * f + kicker_ele%value(vkick$) = kicker_ele%value(vkick$) - sin(ele%value(ref_tilt_tot$)) * f + val(dg$) = 0 + endif + !!! write (taylor_ele%name, '(a, i0)') 'Z_SHIFTER', j_count + taylor_ele%name = ele%name + call taylor_make_unit(taylor_ele%taylor) + orb_start = orbit_out(ix_ele-1) + orb_start%vec(2) = orb_start%vec(2) - kicker_ele%value(hkick$) + orb_start%vec(4) = orb_start%vec(4) - kicker_ele%value(vkick$) + call track1 (orb_start, ele, branch_out%param, orb_end) + ele%key = -1 ! Mark to ignore + f = (ele%map_ref_orb_out%vec(5) - ele%map_ref_orb_in%vec(5)) - (orb_end%vec(5) - orb_start%vec(5)) + call add_taylor_term (taylor_ele%taylor(5), f, [0, 0, 0, 0, 0, 0]) + call insert_element (lat_out, kicker_ele, ix_ele+1, branch_out%ix_branch, orbit_out) + call insert_element (lat_out, taylor_ele, ix_ele+2, branch_out%ix_branch, orbit_out) + call insert_element (lat_out, kicker_ele, ix_ele+3, branch_out%ix_branch, orbit_out) + cycle + endif + endif + endif + + ! Convert sol_quad_and wiggler elements to an "equivalent" set of elements. + ! NOTE: FOR NOW, SOL_QUAD USES DRIFT-MATRIX-DRIFT MODEL! + + if (ele%key == wiggler$ .or. ele%key == undulator$ .or. ele%key == sol_quad$) then + if (logic_option(.false., use_matrix_model) .or. ele%key == sol_quad$) then + call out_io (s_warn$, r_name, 'Converting element to drift-matrix-drift model: ' // ele%name) + drift_ele%value = ele%value + drift_ele%value(l$) = -val(l$) / 2 + call make_mat6 (drift_ele, branch_out%param) + taylor_ele%mat6 = matmul(matmul(drift_ele%mat6, ele%mat6), drift_ele%mat6) + call mat6_to_taylor (taylor_ele%vec0, taylor_ele%mat6, taylor_ele%taylor) + + ! Add drifts before and after wigglers and sol_quads so total length is invariant + j_count = j_count + 1 + write (drift_ele%name, '(a, i0)') 'DRIFT_Z', j_count + taylor_ele%name = ele%name + drift_ele%value(l$) = val(l$) / 2 + ele%key = -1 ! Mark to ignore + call insert_element (lat_out, drift_ele, ix_ele+1, branch_out%ix_branch, orbit_out) + call insert_element (lat_out, taylor_ele, ix_ele+2, branch_out%ix_branch, orbit_out) + call insert_element (lat_out, drift_ele, ix_ele+3, branch_out%ix_branch, orbit_out) + ix_ele = ix_ele + 2 + cycle + + ! Non matrix model... + ! If the wiggler has been sliced due to superposition, throw + ! out the markers that caused the slicing. + + else + if (ele%key == wiggler$ .or. ele%key == undulator$) then ! Not a sol_quad + if (ele%slave_status == super_slave$) then + ! Create the wiggler model using the super_lord + lord => pointer_to_lord(ele, 1) + call out_io (s_warn$, r_name, 'Converting element to drift-bend-drift model: ' // lord%name) + call create_planar_wiggler_model (lord, lat_model) + ! Remove all the slave elements and markers in between. + call out_io (s_warn$, r_name, & + 'Note: Not translating to MAD/XSIF the markers within wiggler: ' // lord%name) + call find_element_ends (lord, ele1, ele2) + ix1 = ele1%ix_ele; ix2 = ele2%ix_ele + lord%key = -1 ! mark for deletion + ! If the wiggler wraps around the origin we are in trouble. + if (ix2 < ix1) then + call out_io (s_fatal$, r_name, 'Wiggler wraps around origin. Cannot translate this!') + if (global_com%exit_on_error) call err_exit + endif + do i = ix1+1, ix2 + branch_out%ele(i)%key = -1 ! mark for deletion + enddo + ix_ele = ix_ele + (ix2 - ix1 - 1) + else + call out_io (s_warn$, r_name, 'Converting element to drift-bend-drift model: ' // ele%name) + call create_planar_wiggler_model (ele, lat_model) + ele%key = -1 ! Mark to ignore + endif + + else ! sol_quad + call create_sol_quad_model (ele, lat_model) ! NOT YET IMPLEMENTED! + ele%key = -1 ! Mark to ignore + endif + + do j = 1, lat_model%n_ele_track + call insert_element (lat_out, lat_model%ele(j), ix_ele+j, branch_out%ix_branch, orbit_out) + enddo + + ix_ele = ix_ele + lat_model%n_ele_track - 1 + cycle + endif + endif + +enddo + +! For a patch that is *not* associated with the edge of a solenoid: A z_offset must be split into a drift + patch + +ix_ele = 0 + +do + ix_ele = ix_ele + 1 + if (ix_ele > branch_out%n_ele_track) exit + ele => branch_out%ele(ix_ele) + if (ele%key == -1) cycle + + ! If the name has more than 16 characters then replace the name by something shorter and unique. + + orig_name = ele%name + + if (len_trim(ele%name) > 16) then + i_unique = i_unique + 1 + write (ele%name, '(a, i0)') ele%name(1:11), i_unique + endif + + ! Replace element name containing "/" or "#" with "_" + + do + j = max(index(ele%name, '\'), index(ele%name, '#')) ! ' + if (j == 0) exit + ele%name(j:j) = '_' + enddo + + if (ele%name /= orig_name .and. n_name_change_warn <= n_warn_max) then + call out_io (s_info$, r_name, 'Element name changed from: ' // trim(orig_name) // ' to: ' // ele%name) + if (n_name_change_warn == n_warn_max) call out_io (s_info$, r_name, & + 'Enough name change warnings. Will stop issuing them now.') + n_name_change_warn = n_name_change_warn + 1 + endif + + ! + + val => ele%value + + if (ele%key == patch$ .and. ele%value(z_offset$) /= 0) then + drift_ele%name = 'DRIFT_' // ele%name + drift_ele%value(l$) = val(z_offset$) + call insert_element (lat_out, drift_ele, ix_ele, branch_out%ix_branch, orbit_out) + ix_ele = ix_ele + 1 + ele => branch_out%ele(ix_ele) + val => ele%value + val(z_offset$) = 0 + endif +enddo + +!------------------------------------------------------------------------------------------------- +! Now write info to the output file... +! lat lattice name + +write (iu, '(3a)') comment_char, ' File generated by: write_lattice_in_elegant_format', trim(eol_char) +write (iu, '(4a)') comment_char, ' Bmad Lattice File: ', trim(lat%input_file_name), trim(eol_char) +if (lat%lattice /= '') write (iu, '(4a)') comment_char, ' Bmad Lattice: ', trim(lat%lattice), trim(eol_char) +write (iu, '(a)') + +! write element parameters + +n_names = 0 ! number of names stored in the list +ix_ele = 0 + +do + ix_ele = ix_ele + 1 + if (ix_ele > branch_out%n_ele_track) exit + ele => branch_out%ele(ix_ele) + if (ele%key == -1) cycle + + val => ele%value + + if (ele%key == elseparator$) then + n_elsep_warn = n_elsep_warn + 1 + ele%key = drift$ + call out_io (s_info$, r_name, 'Elseparator being converted into a drift for ELEGANT conversion: ' // ele%name) + endif + + ! Do not make duplicate specs + + call find_index (ele%name, names, an_indexx, n_names, ix_match) + if (ix_match > 0) cycle + + ! Add to the list of elements + + if (size(names) < n_names + 10) then + call re_allocate(names, 2*size(names)) + call re_allocate(an_indexx, 2*size(names)) + endif + + call find_index (ele%name, names, an_indexx, n_names, ix_match, add_to_list = .true.) + + !------------------------------------------------------------------------------------------- + + bmad_params = '' + elegant_params = '' + + ! Special case where element is a pure thick N-pole of order greater than octupole. + select case (ele%key) + case (quadrupole$, sextupole$, octupole$, thick_multipole$) ! Elegant + call multipole_ele_to_kt(ele, .true., ix_pole_max, knl, tilts, magnetic$, include_kicks$) + if (count(knl /= 0) == 1 .and. all(knl(0:3) == 0)) then + n = find_location(knl /= 0, .true.) - 1 + write (line_out, '(2a)') trim(ele%name) // ': mult' + call value_to_line(line_out, knl(n), 'knl', 'R') + write (line_out, '(2a, i0)') trim(line_out), ', order = ', n + bmad_params(:5) = [character(40):: 'l', 'tilt', 'x_offset', 'y_offset', 'z_offset'] + elegant_params(:5) = [character(40):: 'l', 'tilt', 'dx', 'dy', 'dz'] + + do i = 1, size(bmad_params) + if (bmad_params(i) == '') exit + call pointer_to_attribute (ele, upcase(bmad_params(i)), .true., a_ptr, err_flag) + call value_to_line (line_out, a_ptr%r, elegant_params(i), 'R') + enddo + call write_line(line_out) + cycle + endif + end select + + ! + + select case (ele%key) + + case (instrument$, detector$, monitor$) ! Elegant + write (line_out, '(2a)') trim(ele%name) // ': moni' + bmad_params(:4) = [character(40):: 'l', 'tilt', 'x_offset', 'y_offset'] + elegant_params(:4) = [character(40):: 'l', 'tilt', 'dx', 'dy'] + + + case (drift$, pipe$) ! Elegant + if (ele%csr_method == off$) then + write (line_out, '(2a)') trim(ele%name) // ': edrift' + else + write (line_out, '(2a)') trim(ele%name) // ': csredrift' + endif + + bmad_params(:1) = [character(40):: 'l'] + elegant_params(:1) = [character(40):: 'l'] + + case (gkicker$) + write (line_out, '(2a)') trim(ele%name) // ': malign' + bmad_params(:6) = [character(40):: 'x_kick', 'y_kick', 'z_kick', 'px_kick', 'py_kick', 'pz_kick'] + elegant_params(:6) = [character(40):: 'dx', 'dy', 'dz', 'dxp', 'dyp', 'dp'] + + case (hkicker$) ! Elegant + write (line_out, '(2a)') trim(ele%name) // ': ehkick' + bmad_params(:6) = [character(40):: 'l', 'kick', 'tilt', 'x_offset', 'y_offset', 'z_offset'] + elegant_params(:6) = [character(40):: 'l', 'kick', 'tilt', 'dx', 'dy', 'dz'] + + case (vkicker$) ! Elegant + write (line_out, '(2a)') trim(ele%name) // ': evkick' + bmad_params(:6) = [character(40):: 'l', 'kick', 'tilt', 'x_offset', 'y_offset', 'z_offset'] + elegant_params(:6) = [character(40):: 'l', 'kick', 'tilt', 'dx', 'dy', 'dz'] + + case (kicker$) ! Elegant + write (line_out, '(2a)') trim(ele%name) // ': ekicker' + bmad_params(:7) = [character(40):: 'l', 'hkick', 'vkick', 'tilt', 'x_offset', 'y_offset', 'z_offset'] + elegant_params(:7) = [character(40):: 'l', 'hkick', 'vkick', 'tilt', 'dx', 'dy', 'dz'] + + case (sbend$) ! Elegant + if (ele%csr_method == off$) then + write (line_out, '(2a)') trim(ele%name) // ': csbend' + else + write (line_out, '(2a)') trim(ele%name) // ': csrcsbend' + endif + + if (ele%value(x_pitch$) /= 0 .or. ele%value(y_pitch$) /= 0) line_out = trim(line_out) // ', malign_method = 2' + + select case (nint(ele%value(fringe_at$))) + case (entrance_end$); line_out = trim(line_out) // ', edge2_effects = 0' + case (exit_end$); line_out = trim(line_out) // ', edge1_effects = 0' + case (no_end$); line_out = trim(line_out) // ', edge1_effects = 0, edge2_effects = 0' + end select + + call multipole_ele_to_ab(ele, .false., ix_pole_max, a_pole, b_pole, magnetic$, include_kicks$) + call value_to_line (line_out, ele%value(dg$)*ele%value(rho$), 'fse_dipole', 'R') + call value_to_line (line_out, b_pole(0) - ele%value(dg$)*ele%value(l$), 'xkick', 'R') + do n = 1, 8 + call value_to_line (line_out, b_pole(n)*factorial(n)/ele%value(l$), 'k' // int_str(n), 'R') + enddo + + + if (ele%value(fint$) == ele%value(fintx$)) then + if (ele%value(fint$) /= 0.5_rp) call value_to_line (line_out, ele%value(fint$), 'fint', 'R', .false.) + else + if (ele%value(fint$) /= 0.5_rp) call value_to_line (line_out, ele%value(fint$), 'fint1', 'R', .false.) + if (ele%value(fintx$) /= 0.5_rp) call value_to_line (line_out, ele%value(fintx$), 'fint2', 'R', .false.) + endif + + bmad_params(:12) = [character(40):: 'l', 'angle', 'e1', 'e2', 'ref_tilt', 'roll', 'h1', 'h2', & + 'vkick', 'x_offset', 'y_offset', 'z_offset'] + elegant_params(:12) = [character(40):: 'l', 'angle', 'e1', 'e2', 'tilt', 'etilt', 'h1', 'h2', 'ykick', 'dx', 'dy', 'dz'] + + case (quadrupole$) ! Elegant + knl = knl / ele%value(l$) + if (knl(2) == 0) then + write (line_out, '(2a)') trim(ele%name) // ': kquad' + if (ele%value(x_pitch$) /= 0 .or. ele%value(y_pitch$) /= 0) line_out = trim(line_out) // ', malign_method = 2' + else + write (line_out, '(2a)') trim(ele%name) // ': kquse' + call value_to_line (line_out, 0.5_rp*knl(2)*cos(3*(tilts(2)-tilts(1))), 'k2', 'R') + endif + + tilt = tilts(1) + call value_to_line (line_out, knl(1), 'k1', 'R') + + bmad_params(:1) = [character(40):: 'l'] + elegant_params(:1) = [character(40):: 'l'] + + case (sextupole$) ! Elegant + knl = knl / ele%value(l$) + write (line_out, '(2a)') trim(ele%name) // ': ksext' + if (ele%value(x_pitch$) /= 0 .or. ele%value(y_pitch$) /= 0) line_out = trim(line_out) // ', malign_method = 2' + call value_to_line (line_out, knl(2), 'k2', 'R') + call value_to_line (line_out, knl(1)*cos(0.5_rp*(tilts(1)-tilts(2))), 'k1', 'R') + call value_to_line (line_out, knl(1)*sin(0.5_rp*(tilts(1)-tilts(2))), 'j1', 'R') + call value_to_line (line_out, knl(0)*cos(tilts(0)), 'hkick', 'R') + call value_to_line (line_out, knl(0)*sin(tilts(0)), 'vkick', 'R') + + tilt = tilts(2) + bmad_params(:1) = [character(40):: 'l'] + elegant_params(:1) = [character(40):: 'l'] + + case (octupole$) ! Elegant + knl = knl / ele%value(l$) + write (line_out, '(2a)') trim(ele%name) // ': koct' + call value_to_line (line_out, knl(3), 'k3', 'R') + call value_to_line (line_out, knl(0)*cos(tilts(0)), 'hkick', 'R') + call value_to_line (line_out, knl(0)*sin(tilts(0)), 'vkick', 'R') + + tilt = tilts(3) + bmad_params(:1) = [character(40):: 'l'] + elegant_params(:1) = [character(40):: 'l'] + + case (solenoid$) ! Elegant + write (line_out, '(2a)') trim(ele%name) // ': sole' + bmad_params(:5) = [character(40):: 'l', 'ks', 'x_offset', 'y_offset', 'z_offset'] + elegant_params(:5) = [character(40):: 'l', 'ks', 'dx', 'dy', 'dz'] + + case (taylor$) ! Elegant + write (line_out, '(2a)') trim(ele%name) // ': ematrix' + do i = 1, 6 + f = taylor_coef(ele%taylor(i), [0,0,0,0,0,0]) + call value_to_line (line_out, f, 'c' // int_str(i), 'R') + + do j = 1, 6 + f = taylor_coef(ele%taylor(i), taylor_expn([j])) + call value_to_line (line_out, f, 'r' // int_str(i) // int_str(j), 'R') + + do k = 1, j + f = taylor_coef(ele%taylor(i), taylor_expn([j,k])) + call value_to_line (line_out, f, 'r' // int_str(i) // int_str(j), 'R') + enddo + enddo + enddo + + tilt = ele%value(tilt$) + bmad_params(:1) = [character(40):: 'l'] + elegant_params(:1) = [character(40):: 'l'] + + case (beambeam$) ! Elegant + write (line_out, '(2a)') trim(ele%name) // ': beambeam' + call value_to_line (line_out, strong_beam_strength(ele)*e_charge, 'charge', 'R') + bmad_params(:4) = [character(40):: 'x_offset', 'y_offset', 'sig_x', 'sig_y'] + elegant_params(:4) = [character(40):: 'xcenter', 'ycenter', 'xsize', 'ysize'] + + case (marker$) ! Elegant + write (line_out, '(2a)') trim(ele%name) // ': mark' + bmad_params(:2) = [character(40):: 'x_offset', 'y_offset'] + elegant_params(:2) = [character(40):: 'dx', 'dy'] + + case (ab_multipole$, multipole$) ! Elegant + call multipole_ele_to_kt(ele, .true., ix_pole_max, knl, tilts, include_kicks$) + orig_name = ele%name + ab_ele = ele + do i = 1, ix_pole_max + if (knl(i) == 0) cycle + ab_ele%name = trim(orig_name) // '__' // int_str(i) + write (line_out, '(2a)') trim(ab_ele%name) // ': mult' + call insert_element(lat_out, ab_ele, ix_ele+1, branch_out%ix_branch, orbit_out) + ix_ele = ix_ele + 1 + call value_to_line (line_out, knl(i), 'knl', 'R') + call value_to_line (line_out, tilts(i), 'tilt', 'R') + line_out = trim(line_out) // ', order = ' // int_str(i) + call value_to_line (line_out, ab_ele%value(x_offset$), 'dx', 'R') + call value_to_line (line_out, ab_ele%value(y_offset$), 'dy', 'R') + call value_to_line (line_out, ab_ele%value(z_offset$), 'dz', 'R') + call write_line (line_out) + enddo + cycle + + case (ecollimator$, rcollimator$) ! Elegant + if (ele%key == ecollimator$) then + write (line_out, '(2a)') trim(ele%name) // ': ecol' + else + write (line_out, '(2a)') trim(ele%name) // ': rcol' + endif + call value_to_line (line_out, ab_ele%value(l$), 'l', 'R') + + r_max = (ele%value(x2_limit$) + ele%value(x1_limit$)) / 2 + r0 = (ele%value(x2_limit$) - ele%value(x1_limit$)) / 2 + if (ele%offset_moves_aperture) r0 = r0 + ele%value(x_offset$) + call value_to_line (line_out, r_max, 'x_max', 'R') + call value_to_line (line_out, r0, 'dx', 'R') + + r_max = (ele%value(y2_limit$) + ele%value(y1_limit$)) / 2 + r0 = (ele%value(y2_limit$) - ele%value(y1_limit$)) / 2 + if (ele%offset_moves_aperture) r0 = r0 + ele%value(y_offset$) + call value_to_line (line_out, r_max, 'y_max', 'R') + call value_to_line (line_out, r0, 'dy', 'R') + + case (wiggler$, undulator$) ! Elegant + write (line_out, '(2a)') trim(ele%name) // ': wiggler' + bmad_params(:7) = [character(40):: 'l', 'b_max', 'x_offset', 'y_offset', 'z_offset', 'tilt', 'n_pole'] + elegant_params(:7) = [character(40):: 'l', 'b', 'dx', 'dy', 'dz', 'tilt', 'poles'] + + case (rfcavity$, lcavity$) ! Elegant + if (ele%key == rfcavity$) then + write (line_out, '(2a)') trim(ele%name) // ': rfca' + call value_to_line (line_out, 360.0_rp*(ele%value(phi0$)+ele%value(phi0_multipass$)), 'phase', 'R') + else + write (line_out, '(2a)') trim(ele%name) // ': rfca, change_p0 = 1' + call value_to_line (line_out, 360.0_rp*(ele%value(phi0$)+ele%value(phi0_multipass$))+90.0_rp, 'phase', 'R') + endif + + if (nint(ele%value(cavity_type$)) == standing_wave$) then + line_out = trim(line_out) // ', body_focus_model="SRS", standing_wave = 1, end1_focus=1, end2_focus=1' + endif + + bmad_params(:3) = [character(40):: 'l', 'voltage', 'rf_frequency'] + elegant_params(:3) = [character(40):: 'l', 'volt', 'freq'] + + case (crab_cavity$) ! Elegant + write (line_out, '(2a)') trim(ele%name) // ': rfdf' + call value_to_line (line_out, 360.0_rp*(ele%value(phi0$)+ele%value(phi0_multipass$)), 'phase', 'R') + bmad_params(:7) = [character(40):: 'l', 'voltage', 'rf_frequency', 'tilt', 'x_offset', 'y_offset', 'z_offset'] + elegant_params(:7) = [character(40):: 'l', 'voltage', 'frequency', 'tilt', 'dx', 'dy', 'dz'] + + case (patch$) ! Elegant + if (ele%value(tilt$) /= 0) then + write (line_out, '(2a)') trim(ele%name) // '_rot: rotate' + call value_to_line (line_out, ele%value(tilt$), 'tilt', 'R') + endif + + write (line_out, '(2a)') trim(ele%name) // ': malign' + bmad_params(:7) = [character(40):: 'x_offset', 'y_offset', 'z_offset', 't_offset', 'e_tot_offset', 'x_pitch', 'y_pitch'] + elegant_params(:7) = [character(40):: 'dx', 'dy', 'dz', 'dt', 'de', 'dxp', 'dyp'] + + case (floor_shift$) ! Elegant + write (line_out, '(2a)') trim(ele%name) // ': floor' + call value_to_line (line_out, ele%floor%r(1), 'x', 'R') + call value_to_line (line_out, ele%floor%r(2), 'y', 'R') + call value_to_line (line_out, ele%floor%r(3), 'z', 'R') + call value_to_line (line_out, ele%floor%theta, 'theta', 'R') + call value_to_line (line_out, ele%floor%phi, 'phi', 'R') + call value_to_line (line_out, ele%floor%psi, 'psi', 'R') + + case (match$) ! Elegant + write (line_out, '(2a)') trim(ele%name) // ': ematrix' + call value_to_line (line_out, ele%vec0(1), 'C1', 'R') + call value_to_line (line_out, ele%vec0(2), 'C2', 'R') + call value_to_line (line_out, ele%vec0(3), 'C3', 'R') + call value_to_line (line_out, ele%vec0(4), 'C4', 'R') + call value_to_line (line_out, ele%vec0(5), 'C5', 'R') + call value_to_line (line_out, ele%vec0(6), 'C6', 'R') + do i = 1, 6; do j = 1, 6 + call value_to_line (line_out, ele%mat6(i,j), 'R' // num(i) // num(j), 'R') + enddo; enddo + + case default + call out_io (s_error$, r_name, 'I DO NOT KNOW HOW TO TRANSLATE ELEMENT: ' // ele%name, & + 'WHICH IS OF TYPE: ' // key_name(ele%key), & + 'CONVERTING TO DRIFT') + write (line_out, '(2a)') trim(ele%name) // ': drift' + bmad_params(:1) = [character(40):: 'l'] + elegant_params(:1) = [character(40):: 'l'] + end select + + !-------------------------------------------------------- + + select case (ele%key) + case (sbend$, patch$, drift$) ! Elegant + ! Pass + + case (quadrupole$, sextupole$, octupole$, taylor$) ! Elegant + x_pitch = ele%value(x_pitch$) + y_pitch = ele%value(y_pitch$) + call floor_angles_to_w_mat(x_pitch, y_pitch, tilt, w_mat) + + if (x_pitch == 0 .or. y_pitch == 0) then + epitch = -y_pitch ! alpha_x + eyaw = x_pitch ! alpha_y + etilt = tilt ! alpha_z + else + epitch = -atan2(w_mat(2,3), w_mat(3,3)) + etilt = -atan2(w_mat(1,2), w_mat(1,1)) + eyaw = -atan2(w_mat(1,3), w_mat(2,3)/sin(epitch)) + endif + + offset = matmul(w_mat, [ele%value(x_offset$), ele%value(y_offset$), ele%value(z_offset$)]) + call value_to_line (line_out, etilt, 'tilt', 'R') + call value_to_line (line_out, epitch, 'pitch', 'R') + call value_to_line (line_out, eyaw, 'yaw', 'R') + call value_to_line (line_out, offset(1), 'dx', 'R') + call value_to_line (line_out, offset(2), 'dy', 'R') + call value_to_line (line_out, offset(3), 'dz', 'R') + + ! Elegant + + case (instrument$, detector$, monitor$, hkicker$, vkicker$, kicker$) ! Has tilt but not pitches. + if (has_orientation_attributes(ele) .and. (ele%value(x_pitch$) /= 0 .or. ele%value(y_pitch$) /= 0)) then + call out_io (s_warn$, r_name, 'X_PITCH OR Y_PITCH PARAMETERS OF A ' // trim(key_name(ele%key)) // ' CANNOT BE TRANSLATED TO ELEGANT: ' // ele%name) + endif + case default + if (has_orientation_attributes(ele) .and. (ele%value(x_pitch$) /= 0 .or. ele%value(y_pitch$) /= 0 .or. ele%value(tilt$) /= 0)) then + call out_io (s_warn$, r_name, 'TILT, X_PITCH OR Y_PITCH PARAMETERS OF A ' // trim(key_name(ele%key)) // ' CANNOT BE TRANSLATED TO ELEGANT: ' // ele%name) + endif + end select + + !-------------------------------------------------------- + + do i = 1, size(bmad_params) + if (bmad_params(i) == '') exit + call pointer_to_attribute (ele, upcase(bmad_params(i)), .true., a_ptr, err_flag) + call value_to_line (line_out, a_ptr%r, elegant_params(i), 'R') + enddo + + call write_line(line_out) + cycle +enddo + +!--------------------------------------------------------------------------------------- +! Write the lattice line + +i_unique = 1000 +i_line = 0 +init_needed = .true. +line = ' ' + +do n = 1, branch_out%n_ele_track + ele => branch_out%ele(n) + if (ele%key == -1) cycle + + if (init_needed) then + write (iu, '(a)') + write (iu, '(3a)') comment_char, '---------------------------------', trim(eol_char) + write (iu, '(a)') + i_line = i_line + 1 + write (line_out, '(a, i0, 2a)') 'line_', i_line, ': line = (', ele%name + iout = 0 + init_needed = .false. + + else + ix = len_trim(line_out) + len_trim(ele%name) + + if (ix > 75) then + write (iu, '(3a)') trim(line_out), trim(separator_char), trim(continue_char) + iout = iout + 1 + line_out = ' ' // ele%name + else + line_out = trim(line_out) // trim(separator_char) // ' ' // ele%name + endif + endif + + if (ele%key == patch$ .and. ele%value(tilt$) /= 0) then + line_out = trim(line_out) // ', ' // trim(ele%name) // '_rot' + endif + + ! Output line if long enough or at end + + if (n == branch_out%n_ele_track .or. iout > 48) then + line_out = trim(line_out) // ')' + write (iu, '(2a)') trim(line_out), trim(eol_char) + line_out = ' ' + init_needed = .true. + endif + +enddo + +!------------------------------------------ +! Use statement + +write (iu, '(a)') +write (iu, '(3a)') comment_char, '---------------------------------', trim(eol_char) +write (iu, '(a)') + +line_out = 'lat: line = (line_1' + +do i = 2, i_line + write (line_out, '(3a, i0)') trim(line_out), trim(separator_char), ' line_', i +enddo + +line_out = trim(line_out) // ')' +call write_line (line_out) + +! Write twiss parameters for a non-closed lattice. + +! End stuff + +call out_io (s_info$, r_name, 'Written ELEGANT lattice file: ' // trim(out_file_name)) + +deallocate (names) +if (present(err)) err = .false. + +if (present(converted_lat)) then + converted_lat = lat + converted_lat%branch(branch%ix_branch) = branch_out + converted_lat%n_ele_max = converted_lat%n_ele_track + do ib = 0, ubound(converted_lat%branch, 1) + branch => converted_lat%branch(ib) + do i = 1, branch%n_ele_track + branch%ele(i)%slave_status = free$ + branch%ele(i)%n_lord = 0 + enddo + enddo + converted_lat%n_control_max = 0 + converted_lat%n_ic_max = 0 +endif + +call deallocate_lat_pointers (lat_out) +call deallocate_lat_pointers (lat_model) + +! Restore ptc settings + +if (n_taylor_order_saved /= ptc_private%taylor_order_ptc) call set_ptc (taylor_order = n_taylor_order_saved) +ptc_com%exact_model = ptc_exact_model + +close(iu) + +!------------------------------------------------------------------------ +contains + +subroutine write_line (line_out) + +implicit none + +character(*) line_out +integer ix, ix1, ix2, ix3 + +! Prefer to breakup a line after a comma + +do + if (len_trim(line_out) < ix_line_max) exit + ix1 = index(line_out(ix_line_min+1:), ',') + ix2 = index(line_out(ix_line_min+1:), '=') + ix3 = index(line_out(ix_line_min+1:), ' ') + + if (ix1 /= 0 .and. ix1+ix_line_min < ix_line_max) then + ix = ix1 + ix_line_min + elseif (ix2 /= 0 .and. ix2+ix_line_min < ix_line_max) then + ix = ix2 + ix_line_min + elseif (ix3 /= 0 .and. ix3+ix_line_min < ix_line_max) then + ix = ix3 + ix_line_min + elseif (ix1 /= 0) then + ix = ix1 + ix_line_min + elseif (ix2 /= 0) then + ix = ix2 + ix_line_min + else + ix = ix3 + ix_line_min + endif + + write (iu, '(2a)') line_out(:ix), trim(continue_char) + line_out = ' ' // line_out(ix+1:) +enddo + +write (iu, '(2a)') trim(line_out), trim(eol_char) + +end subroutine write_line + +end subroutine write_lattice_in_elegant_format diff --git a/bmad/output/write_lattice_in_foreign_format.f90 b/bmad/output/write_lattice_in_foreign_format.f90 index 4e2836c5b7..a90e3a55f3 100644 --- a/bmad/output/write_lattice_in_foreign_format.f90 +++ b/bmad/output/write_lattice_in_foreign_format.f90 @@ -2,18 +2,13 @@ ! Subroutine write_lattice_in_foreign_format (out_type, out_file_name, lat, ref_orbit, & ! use_matrix_model, include_apertures, dr12_drift_max, ix_branch, converted_lat, err) ! -! Subroutine to write a Elegant, MAD-8, MAD-X, OPAL, SAD, JULIA, or XSIF lattice file using the +! Subroutine to write a Elegant, MAD-8, MAD-X, OPAL, SAD, or JULIA, lattice file using the ! information in a lat_struct. Optionally, only part of the lattice can be generated. -! [XSIF is a variant of MAD8 used by SLAC.] -! -!========================================================================================= -! NOTE: ELEGANT TRANSLATION IN DEVELOPMENT. PLEASE CONTACT DAVID SAGAN IF YOU WANT TO USE! -!========================================================================================= ! ! To write a Bmad lattice file, use: write_bmad_lattice_file ! -! Note: When translating to XSIF or MAD8: sad_mult and patch element are translated -! to a XSIF/MAD8 matrix element (which is a 2nd order map). In this case, the ref_orbit orbit is +! Note: When translating to MAD8: sad_mult and patch element are translated +! to a MAD8 matrix element (which is a 2nd order map). In this case, the ref_orbit orbit is ! used as the reference orbit for construction of the 2nd order map. ! ! If a sad_mult or patch element is translated to a matrix element, and the referece orbit @@ -29,7 +24,7 @@ ! Note: wiggler elements are replaced by a drift-matrix-drift or drift-bend model. ! ! Input: -! out_type -- character(*): Either 'ELEGANT', 'XSIF', 'MAD-8', 'MAD-X', 'SAD', or 'OPAL-T', 'JULIA'. +! out_type -- character(*): Either 'ELEGANT', 'MAD-8', 'MAD-X', 'SAD', or 'OPAL-T', 'JULIA'. ! out_file_name -- character(*): Name of the mad output lattice file. ! lat -- lat_struct: Holds the lattice information. ! ref_orbit(0:) -- coord_struct, allocatable, optional: Referece orbit for sad_mult and patch elements. @@ -56,1586 +51,62 @@ subroutine write_lattice_in_foreign_format (out_type, out_file_name, lat, ref_orbit, & use_matrix_model, include_apertures, dr12_drift_max, ix_branch, converted_lat, err) -use mad_mod, dummy2 => write_lattice_in_foreign_format -use bmad, dummy => write_lattice_in_foreign_format -use write_lat_file_mod, dummy3 => write_lattice_in_foreign_format -use ptc_interface_mod, only: taylor_inverse, concat_taylor +use bmad_interface, dummy => write_lattice_in_foreign_format +use opal_interface_mod, only: write_opal_lattice_file implicit none -type (lat_struct), target :: lat, lat_model, lat_out +type (lat_struct), target :: lat type (lat_struct), optional, target :: converted_lat -type (ele_struct), pointer :: ele, ele1, ele2, lord, sol_ele, first_sol_edge -type (ele_struct) :: drift_ele, ab_ele, taylor_ele, col_ele, kicker_ele, null_ele, bend_ele, quad_ele -type (coord_struct) orb_start, orb_end, orb_center type (coord_struct), allocatable, optional :: ref_orbit(:) -type (coord_struct), allocatable :: orbit_out(:) -type (taylor_term_struct) :: term -type (branch_struct), pointer :: branch, branch_out -type (mad_energy_struct) energy -type (mad_map_struct) mad_map -type (taylor_struct) taylor_a(6), taylor_b(6) -type (taylor_struct), pointer :: taylor_ptr(:) -type (all_pointer_struct) a_ptr real(rp), optional :: dr12_drift_max -real(rp) field, hk, vk, limit(2), length, a, b, f, e2, beta, r_max, r0, dr12_max -real(rp), pointer :: val(:) -real(rp) knl(0:n_pole_maxx), tilts(0:n_pole_maxx), a_pole(0:n_pole_maxx), b_pole(0:n_pole_maxx) -real(rp) tilt, x_pitch, y_pitch, etilt, epitch, eyaw, offset(3), w_mat(3,3) integer, optional :: ix_branch -integer, allocatable :: n_repeat(:), an_indexx(:) -integer i, j, ib, j2, k, n, ix, i_unique, i_line, iout, iu, n_names, j_count, f_count, ix_ele -integer ie, ios, a_count, ix_lord, ix_match, iv, ifa, ix_pole_max -integer ix1, ix2, n_lord, aperture_at, n_name_change_warn, n_elsep_warn, n_taylor_order_saved -integer :: ix_line_min, ix_line_max, n_warn_max, n_wig_model_err, print_wig_model_err_max +integer iu, ios character(*), parameter :: r_name = "write_lattice_in_foreign_format" character(*) out_type, out_file_name -character(300) line, knl_str, ksl_str -character(40) orig_name, str, bmad_params(20), elegant_params(20) -character(40), allocatable :: names(:) -character(4000) line_out ! Can be this large for taylor maps. -character(2) continue_char, eol_char, comment_char, separator_char -character(1), parameter :: num(9) = ['1', '2', '3', '4', '5', '6', '7', '8', '9'] +character(300) line logical, optional :: use_matrix_model, include_apertures, err -logical init_needed, mad_out, err_flag, monopole -logical parsing, warn_printed, converted, ptc_exact_model -logical print_err - -! Julia translation - -if (out_type == 'JULIA') then - call write_lattice_in_julia (out_file_name, lat) - if (present(converted_lat)) converted_lat = lat - return -endif -! SAD translation +! -if (out_type == 'SAD') then - call write_lat_in_sad_format (out_file_name, lat, include_apertures, ix_branch, converted_lat, err) - return -endif - -! Use ptc exact_model = True since this is needed to get the drift nonlinear terms - -ptc_exact_model = ptc_com%exact_model -ptc_com%exact_model = .true. -dr12_max = real_option(1d-5, dr12_drift_max) -if (dr12_max < 0) dr12_max = 1d-5 +select case (out_type) -! Init +case ('JULIA') + call write_lattice_in_julia (out_file_name, lat) -n_warn_max = 10 -n_wig_model_err = 0 -print_wig_model_err_max = 5 +case ('ELEGANT') + call write_lattice_in_elegant_format (out_file_name, lat, ref_orbit, use_matrix_model, & + include_apertures, dr12_drift_max, ix_branch, converted_lat, err) -ix = integer_option(0, ix_branch) -if (ix < 0 .or. ix > ubound(lat%branch, 1)) then - call out_io (s_error$, r_name, 'BRANCH INDEX OUT OF RANGE: /i0/ ', i_array = [ix]) - return -endif +case ('MAD-8', 'MAD-X') + call write_lattice_in_mad_format (out_type, out_file_name, lat, ref_orbit, use_matrix_model, & + include_apertures, dr12_drift_max, ix_branch, converted_lat, err) -branch => lat%branch(ix) +case ('SAD') + call write_lattice_in_sad_format (out_file_name, lat, include_apertures, ix_branch, converted_lat, err) -if (out_type == 'MAD-X' .or. out_type == 'OPAL-T') then - comment_char = '//' - continue_char = '' - eol_char = ';' - separator_char = ',' - ix_line_max = 100 +case ('OPAL-T') + iu = lunget() + call fullfilename (out_file_name, line) + open (iu, file = line, iostat = ios) + if (ios /= 0) then + call out_io (s_error$, r_name, 'CANNOT OPEN FILE: ' // trim(out_file_name)) + return + endif -elseif (out_type == 'MAD-8' .or. out_type == 'XSIF' .or. out_type == 'ELEGANT') then - comment_char = '!' - continue_char = ' &' - eol_char = '' - separator_char = ',' - ix_line_max = 80 + call write_opal_lattice_file (iu, lat, err) + close (iu) -else +case default call out_io (s_error$, r_name, 'BAD OUT_TYPE: ' // out_type) return -endif - -if (out_type == 'ELEGANT') call out_io (s_warn$, r_name, '! NOTE: ELEGANT TRANSLATION IN DEVELOPMENT. PLEASE CONTACT DAVID SAGAN IF YOU WANT TO USE!') - -mad_out = .false. -if (out_type == 'MAD-X' .or. out_type == 'MAD-8') mad_out = .true. - -ix_line_min = ix_line_max - 20 - -call init_ele (col_ele) -call init_ele (drift_ele, drift$) -call init_ele (taylor_ele, taylor$) -call init_ele (ab_ele, ab_multipole$) -call init_ele (kicker_ele, kicker$) -call init_ele (quad_ele, quadrupole$) -call init_ele (bend_ele, sbend$) -call multipole_init (ab_ele, magnetic$) -null_ele%key = null_ele$ - -allocate (names(branch%n_ele_max+10), an_indexx(branch%n_ele_max+10)) ! list of element names - -call out_io (s_info$, r_name, & - 'Note: In general, Bmad lattice elements can have attributes that cannot be translated. ', & - ' For example, higher order terms in a Taylor element.', & - ' Please use caution when using a translated lattice.') - - -! open file - -if (present(err)) err = .true. -n_taylor_order_saved = ptc_private%taylor_order_ptc - -iu = lunget() -call fullfilename (out_file_name, line) -open (iu, file = line, iostat = ios) -if (ios /= 0) then - call out_io (s_error$, r_name, 'CANNOT OPEN FILE: ' // trim(out_file_name)) - return -endif - -!----------------------------------------------------------------------------- -! Translation is a two step process: -! 1) Create a new lattice called lat_out making substitutions for sol_quad and wiggler elements, etc.. -! 2) Use lat_out to create the lattice file. - -lat_out = lat -call allocate_lat_ele_array(lat_out, 2*branch%n_ele_max, branch%ix_branch) -branch_out => lat_out%branch(branch%ix_branch) - -if (present(ref_orbit)) then - call reallocate_coord(orbit_out, size(ref_orbit)) - orbit_out = ref_orbit -else - call reallocate_coord(orbit_out, branch%n_ele_max) -endif - -f_count = 0 ! fringe around bends and quads. Also drift nonlinearities. -j_count = 0 ! drift around solenoid or sol_quad index. Also z shift count. -a_count = 0 ! Aperture count -i_unique = 1000 - -! Loop over all input elements - -nullify(first_sol_edge) -n_name_change_warn = 0 -n_elsep_warn = 0 -ix_ele = 0 - -do - ix_ele = ix_ele + 1 - if (ix_ele > branch_out%n_ele_track) exit - ele => branch_out%ele(ix_ele) - if (ele%key == -1) cycle ! Has been marked for delection - - val => ele%value - - ! If there is an aperture with an element that is not an ecoll or rcoll then need to make a separate - ! element with the aperture info. Exception: MAD-X can handle apertures on non-collimator elements. - - if ((val(x1_limit$) /= 0 .or. val(x2_limit$) /= 0 .or. val(y1_limit$) /= 0 .or. val(y2_limit$) /= 0) .and. & - ele%key /= ecollimator$ .and. ele%key /= rcollimator$ .and. logic_option(.true., include_apertures) .and. & - (ele%key == drift$ .or. out_type /= 'MAD-X')) then - - if (val(x1_limit$) /= val(x2_limit$)) then - call out_io (s_warn$, r_name, 'Asymmetric x_limits cannot be converted for: ' // ele%name, & - 'Will use largest limit here.') - val(x1_limit$) = max(val(x1_limit$), val(x2_limit$)) - endif - - if (val(y1_limit$) /= val(y2_limit$)) then - call out_io (s_warn$, r_name, 'Asymmetric y_limits cannot be converted for: ' // ele%name, & - 'Will use largest limit here.') - val(y1_limit$) = max(val(y1_limit$), val(y2_limit$)) - endif - - ! create ecoll and rcoll elements. - - if (ele%aperture_type == rectangular$) then - col_ele%key = rcollimator$ - else - col_ele%key = ecollimator$ - endif - a_count = a_count + 1 - write (col_ele%name, '(a, i0)') 'COLLIMATOR_N', a_count - col_ele%value = val - col_ele%value(l$) = 0 - val(x1_limit$) = 0; val(x2_limit$) = 0; val(y1_limit$) = 0; val(y2_limit$) = 0; - aperture_at = ele%aperture_at ! Save since ele pointer will be invalid after the insert - if (aperture_at == both_ends$ .or. aperture_at == downstream_end$ .or. aperture_at == continuous$) then - call insert_element (lat_out, col_ele, ix_ele+1, branch_out%ix_branch, orbit_out) - endif - if (aperture_at == both_ends$ .or. aperture_at == upstream_end$ .or. aperture_at == continuous$) then - call insert_element (lat_out, col_ele, ix_ele, branch_out%ix_branch, orbit_out) - endif - ix_ele = ix_ele - 1 ! Want to process the element again on the next loop. - - cycle ! cycle since ele pointer is invalid - - endif - - ! If the bend has a roll then put kicker elements just before and just after - - if (ele%key == sbend$ .and. val(roll$) /= 0) then - j_count = j_count + 1 - write (kicker_ele%name, '(a, i0)') 'ROLL_Z', j_count - kicker_ele%value(hkick$) = val(angle$) * (1 - cos(val(roll$))) / 2 - kicker_ele%value(vkick$) = -val(angle$) * sin(val(roll$)) / 2 - val(roll$) = 0 ! So on next iteration will not create extra kickers. - call insert_element (lat_out, kicker_ele, ix_ele, branch_out%ix_branch, orbit_out) - call insert_element (lat_out, kicker_ele, ix_ele+2, branch_out%ix_branch, orbit_out) - cycle - endif - - ! If there is a multipole component then put multipole elements at half strength - ! just before and just after the element. Exception: With Elegant if there is only one multipole for a quad, sextupole, or octupole - - monopole = .false. - if (out_type == 'ELEGANT') then - select case (ele%key) - case (quadrupole$, sextupole$, octupole$, thick_multipole$) ! Elegant - call multipole_ele_to_kt(ele, .true., ix_pole_max, knl, tilts, magnetic$, include_kicks$) - if (count(knl /= 0) == 1 .and. all(knl(0:3) == 0)) monopole = .true. - end select - endif - - if (.not. monopole .and. ele%key /= multipole$ .and. ele%key /= ab_multipole$ .and. ele%key /= null_ele$ .and. ele%key /= sad_mult$) then - call multipole_ele_to_ab (ele, .true., ix_pole_max, ab_ele%a_pole, ab_ele%b_pole) - if (ix_pole_max > -1) then - ab_ele%a_pole = ab_ele%a_pole / 2 - ab_ele%b_pole = ab_ele%b_pole / 2 - if (associated(ele%a_pole)) then - deallocate (ele%a_pole, ele%b_pole) - call attribute_bookkeeper(ele, .true.) - endif - j_count = j_count + 1 - write (ab_ele%name, '(a1, a, i0)') key_name(ele%key), 'MULTIPOLE_', j_count - call insert_element (lat_out, ab_ele, ix_ele, branch_out%ix_branch, orbit_out) - call insert_element (lat_out, ab_ele, ix_ele+2, branch_out%ix_branch, orbit_out) - cycle - endif - endif - - ! If there are nonzero kick values and this is not a kick type element then put - ! kicker elements at half strength just before and just after the element. - ! Also add a matrix element to get the change in z correct. - ! A sad_mult gets translated to a matrix element which has kick components so no extra kickers needed here. - ! Exception: MAD-X sbend has K0 and K0S attributes. - - if (has_hkick_attributes(ele%key) .and. .not. (ele%key == sbend$ .and. out_type == 'MAD-X')) then - if (ele%key /= kicker$ .and. ele%key /= hkicker$ .and. ele%key /= vkicker$ .and. ele%key /= sad_mult$) then - if (val(hkick$) /= 0 .or. val(vkick$) /= 0) then - j_count = j_count + 1 - write (kicker_ele%name, '(a1, a, i0)') key_name(ele%key), '_KICKER_', j_count - kicker_ele%value(hkick$) = val(hkick$) / 2 - kicker_ele%value(vkick$) = val(vkick$) / 2 - val(hkick$) = 0; val(vkick$) = 0 - if (ele%key == sbend$) then - f = val(dg$) * val(l$) / 2 - kicker_ele%value(hkick$) = kicker_ele%value(hkick$) - cos(ele%value(ref_tilt_tot$)) * f - kicker_ele%value(vkick$) = kicker_ele%value(vkick$) - sin(ele%value(ref_tilt_tot$)) * f - val(dg$) = 0 - endif - !!! write (taylor_ele%name, '(a, i0)') 'Z_SHIFTER', j_count - taylor_ele%name = ele%name - call taylor_make_unit(taylor_ele%taylor) - orb_start = orbit_out(ix_ele-1) - orb_start%vec(2) = orb_start%vec(2) - kicker_ele%value(hkick$) - orb_start%vec(4) = orb_start%vec(4) - kicker_ele%value(vkick$) - call track1 (orb_start, ele, branch_out%param, orb_end) - ele%key = -1 ! Mark to ignore - f = (ele%map_ref_orb_out%vec(5) - ele%map_ref_orb_in%vec(5)) - (orb_end%vec(5) - orb_start%vec(5)) - call add_taylor_term (taylor_ele%taylor(5), f, [0, 0, 0, 0, 0, 0]) - call insert_element (lat_out, kicker_ele, ix_ele+1, branch_out%ix_branch, orbit_out) - call insert_element (lat_out, taylor_ele, ix_ele+2, branch_out%ix_branch, orbit_out) - call insert_element (lat_out, kicker_ele, ix_ele+3, branch_out%ix_branch, orbit_out) - cycle - endif - endif - endif - - ! A quadrupole with fringe = full or soft_edge_only has its fringe kicks modeled as a 2nd order map. - - iv = nint(ele%value(fringe_type$)) - if (mad_out .and. ele%key == quadrupole$ .and. (iv == full$ .or. iv == soft_edge_only$)) then - quad_ele = ele - ele%value(fringe_type$) = none$ - - if (ptc_private%taylor_order_ptc /= 2) call set_ptc (taylor_order = 2) - - f_count = f_count + 1 - ie = ix_ele - - ifa = nint(ele%value(fringe_at$)) - if (ifa == entrance_end$ .or. ifa == both_ends$) then - quad_ele%value(fringe_at$) = entrance_end$ - quad_ele%value(l$) = 1d-30 - call ele_to_taylor (quad_ele, branch_out%param, orbit_out(ie-1), orbital_taylor = taylor_ele%taylor) - write (taylor_ele%name, '(a, i0)') 'Q_FRINGE_IN', f_count - call insert_element (lat_out, taylor_ele, ie, branch_out%ix_branch, orbit_out) - ie = ie + 1 - endif - - if (ifa == exit_end$ .or. ifa == both_ends$) then - quad_ele%value(fringe_at$) = exit_end$ - quad_ele%value(l$) = 1d-30 - call ele_to_taylor (quad_ele, branch_out%param, orbit_out(ie), orbital_taylor = taylor_ele%taylor) - write (taylor_ele%name, '(a, i0)') 'Q_FRINGE_OUT', f_count - call insert_element (lat_out, taylor_ele, ie+1, branch_out%ix_branch, orbit_out) - endif - - cycle - endif - - ! A bend with fringe = sad_full or has non-zero dg has its fringe kicks modeled as a 1st order map. - - iv = nint(ele%value(fringe_type$)) - if (ele%key == sbend$ .and. ((mad_out .and. iv == sad_full$) .or. (out_type == 'MAD-8' .and. ele%value(dg$) /= 0))) then - - if (ptc_private%taylor_order_ptc /= 1) call set_ptc (taylor_order = 1) - - f_count = f_count + 1 - ie = ix_ele - - bend_ele = ele - bend_ele%value(l$) = ele%value(l$)/2 - bend_ele%value(angle$) = ele%value(angle$)/2 - bend_ele%value(e2$) = 0 - call set_fringe_on_off (bend_ele%value(fringe_at$), exit_end$, off$) - call track1 (orbit_out(ie-1), bend_ele, branch_out%param, orb_center) - - if (at_this_ele_end(entrance_end$, nint(ele%value(fringe_at$))) .or. ele%value(dg$) /= 0) then - call ele_to_taylor (bend_ele, branch_out%param, orbit_out(ie-1), orbital_taylor = taylor_a) - - bend_ele%value(fringe_type$) = basic_bend$ - bend_ele%value(dg$) = 0 - orb_start = orb_center - orb_start%direction = -1 - orb_start%species = antiparticle(orb_center%species) - call track1 (orb_start, bend_ele, branch_out%param, orb_start) ! bactrack to entrance end - call ele_to_taylor (bend_ele, branch_out%param, orb_start, orbital_taylor = taylor_b) - - call taylor_inverse (taylor_b, taylor_b) - call concat_taylor (taylor_a, taylor_b, taylor_ele%taylor) - write (taylor_ele%name, '(a, i0)') 'B_FRINGE_IN', f_count - call insert_element (lat_out, taylor_ele, ie, branch_out%ix_branch, orbit_out) - ele => branch_out%ele(ix_ele+1) - call kill_taylor (taylor_a) - call kill_taylor (taylor_b) - ie = ie + 1 - endif - - if (at_this_ele_end(exit_end$, nint(ele%value(fringe_at$))) .or. ele%value(dg$) /= 0) then - bend_ele = ele - bend_ele%value(l$) = ele%value(l$)/2 - bend_ele%value(angle$) = ele%value(angle$)/2 - bend_ele%value(e1$) = 0 - call set_fringe_on_off (bend_ele%value(fringe_at$), entrance_end$, off$) - - call ele_to_taylor (bend_ele, branch_out%param, orb_center, orbital_taylor = taylor_a) - - bend_ele%value(fringe_type$) = basic_bend$ - bend_ele%value(dg$) = 0 - call ele_to_taylor (bend_ele, branch_out%param, orb_center, orbital_taylor = taylor_b) - call taylor_inverse (taylor_b, taylor_b) - - call concat_taylor (taylor_b, taylor_a, taylor_ele%taylor) - write (taylor_ele%name, '(a, i0)') 'B_FRINGE_OUT', f_count - call insert_element (lat_out, taylor_ele, ie+1, branch_out%ix_branch, orbit_out) - call kill_taylor (taylor_a) - call kill_taylor (taylor_b) - endif - - ele%value(fringe_type$) = basic_bend$ - ele%value(dg$) = 0 - cycle - endif - - ! A drift where the ref orbit is too large needs an added 1st order matrix element - - f = ele%value(l$) / (1 + orbit_out(ele%ix_ele)%vec(6)) - if (mad_out .and. ele%key == drift$ .and. ele%name(1:7) /= 'DRIFT_Z' .and. abs(ele%mat6(1,2) - f) > dr12_max) then - if (ptc_private%taylor_order_ptc /= 1) call set_ptc (taylor_order = 1) - - drift_ele = ele - drift_ele%value(l$) = -ele%value(l$) - call make_mat6_mad (drift_ele, branch_out%param, orbit_out(ix_ele), orb_end) - call mat6_to_taylor (drift_ele%vec0, drift_ele%mat6, taylor_a) - - drift_ele%value(l$) = ele%value(l$) - call ele_to_taylor (drift_ele, branch_out%param, orbit_out(ix_ele-1), orbital_taylor = taylor_b) - call concat_taylor (taylor_a, taylor_b, taylor_ele%taylor) - call kill_taylor (taylor_a) - call kill_taylor (taylor_b) - - taylor_ele%name = 'TAYLOR_' // ele%name - call insert_element (lat_out, taylor_ele, ix_ele+1, branch_out%ix_branch, orbit_out) - ix_ele = ix_ele + 1 - cycle - endif - - ! Convert sol_quad_and wiggler elements to an "equivalent" set of elements. - ! NOTE: FOR NOW, SOL_QUAD USES DRIFT-MATRIX-DRIFT MODEL! - - if (ele%key == wiggler$ .or. ele%key == undulator$ .or. ele%key == sol_quad$) then - if (logic_option(.false., use_matrix_model) .or. ele%key == sol_quad$) then - call out_io (s_warn$, r_name, 'Converting element to drift-matrix-drift model: ' // ele%name) - drift_ele%value = ele%value - drift_ele%value(l$) = -val(l$) / 2 - call make_mat6 (drift_ele, branch_out%param) - taylor_ele%mat6 = matmul(matmul(drift_ele%mat6, ele%mat6), drift_ele%mat6) - call mat6_to_taylor (taylor_ele%vec0, taylor_ele%mat6, taylor_ele%taylor) - - ! Add drifts before and after wigglers and sol_quads so total length is invariant - j_count = j_count + 1 - write (drift_ele%name, '(a, i0)') 'DRIFT_Z', j_count - taylor_ele%name = ele%name - drift_ele%value(l$) = val(l$) / 2 - ele%key = -1 ! Mark to ignore - call insert_element (lat_out, drift_ele, ix_ele+1, branch_out%ix_branch, orbit_out) - call insert_element (lat_out, taylor_ele, ix_ele+2, branch_out%ix_branch, orbit_out) - call insert_element (lat_out, drift_ele, ix_ele+3, branch_out%ix_branch, orbit_out) - cycle - - ! Non matrix model... - ! If the wiggler has been sliced due to superposition, throw - ! out the markers that caused the slicing. - - else - if (ele%key == wiggler$ .or. ele%key == undulator$) then ! Not a sol_quad - if (ele%slave_status == super_slave$) then - ! Create the wiggler model using the super_lord - lord => pointer_to_lord(ele, 1) - print_err = (n_wig_model_err <= print_wig_model_err_max) - !!! if (print_err) call out_io (s_warn$, r_name, 'Converting element to drift-bend-drift model: ' // lord%name) - call create_planar_wiggler_model (lord, lat_model, err_flag, print_err = print_err) - if (err_flag) n_wig_model_err = n_wig_model_err + 1 - if (n_wig_model_err == print_wig_model_err_max + 1) call out_io (s_warn$, r_name, & - 'Max number of wiggler error messages generated. Will not generate any more!') - ! Remove all the slave elements and markers in between. - call out_io (s_warn$, r_name, & - 'Note: Not translating to MAD/XSIF the markers within wiggler: ' // lord%name) - call find_element_ends (lord, ele1, ele2) - ix1 = ele1%ix_ele; ix2 = ele2%ix_ele - lord%key = -1 ! mark for deletion - ! If the wiggler wraps around the origin we are in trouble. - if (ix2 < ix1) then - call out_io (s_fatal$, r_name, 'Wiggler wraps around origin. Cannot translate this!') - if (global_com%exit_on_error) call err_exit - endif - do i = ix1+1, ix2 - branch_out%ele(i)%key = -1 ! mark for deletion - enddo - ix_ele = ix_ele + (ix2 - ix1 - 1) - else - print_err = (n_wig_model_err <= print_wig_model_err_max) - !!! if (print_err) call out_io (s_warn$, r_name, 'Converting element to drift-bend-drift model: ' // ele%name) - call create_planar_wiggler_model (ele, lat_model, err_flag, print_err = print_err) - if (err_flag) n_wig_model_err = n_wig_model_err + 1 - if (n_wig_model_err == print_wig_model_err_max + 1) call out_io (s_warn$, r_name, & - 'Max number of wiggler error messages generated. Will not generate any more!') - ele%key = -1 ! Mark to ignore - endif - - else ! sol_quad - call create_sol_quad_model (ele, lat_model) ! NOT YET IMPLEMENTED! - ele%key = -1 ! Mark to ignore - endif - - do j = 1, lat_model%n_ele_track - call insert_element (lat_out, lat_model%ele(j), ix_ele+j, branch_out%ix_branch, orbit_out) - enddo - cycle - endif - endif - -enddo - -! For a patch that is *not* associated with the edge of a solenoid: A z_offset must be split into a drift + patch - -ix_ele = 0 - -do - ix_ele = ix_ele + 1 - if (ix_ele > branch_out%n_ele_track) exit - ele => branch_out%ele(ix_ele) - if (ele%key == -1) cycle - - ! If the name has more than 16 characters then replace the name by something shorter and unique. - - orig_name = ele%name - - if (len_trim(ele%name) > 16) then - i_unique = i_unique + 1 - write (ele%name, '(a, i0)') ele%name(1:11), i_unique - endif - - ! Replace element name containing "/" or "#" with "_" - - do - j = max(index(ele%name, '\'), index(ele%name, '#')) ! ' - if (j == 0) exit - ele%name(j:j) = '_' - enddo - - if (ele%name /= orig_name .and. n_name_change_warn <= n_warn_max) then - call out_io (s_info$, r_name, 'Element name changed from: ' // trim(orig_name) // ' to: ' // ele%name) - if (n_name_change_warn == n_warn_max) call out_io (s_info$, r_name, & - 'Enough name change warnings. Will stop issuing them now.') - n_name_change_warn = n_name_change_warn + 1 - endif - - ! - - val => ele%value - - if (ele%key == patch$ .and. ele%value(z_offset$) /= 0) then - drift_ele%name = 'DRIFT_' // ele%name - drift_ele%value(l$) = val(z_offset$) - call insert_element (lat_out, drift_ele, ix_ele, branch_out%ix_branch, orbit_out) - ix_ele = ix_ele + 1 - ele => branch_out%ele(ix_ele) - val => ele%value - val(z_offset$) = 0 - endif -enddo - -!------------------------------------------------------------------------------------------------- -! Now write info to the output file... -! lat lattice name - -write (iu, '(3a)') comment_char, ' File generated by: write_lattice_in_foreign_format', trim(eol_char) -write (iu, '(4a)') comment_char, ' Bmad Lattice File: ', trim(lat%input_file_name), trim(eol_char) -if (lat%lattice /= '') write (iu, '(4a)') comment_char, ' Bmad Lattice: ', trim(lat%lattice), trim(eol_char) -write (iu, '(a)') - -! beam definition - -select case (out_type) -case ('MAD-8', 'MAD-X', 'XSIF') - ele => branch_out%ele(0) - - write (line_out, '(7a)') 'beam_def: Beam, Particle = ', trim(species_name(branch_out%param%particle)), & - ', Energy = ', re_str(1d-9*ele%value(E_TOT$)), ', Npart = ', re_str(branch_out%param%n_part), trim(eol_char) - call write_line (line_out) - write (iu, '(a)') end select -! write element parameters - -n_names = 0 ! number of names stored in the list -ix_ele = 0 - -do - ix_ele = ix_ele + 1 - if (ix_ele > branch_out%n_ele_track) exit - ele => branch_out%ele(ix_ele) - if (ele%key == -1) cycle - - val => ele%value - - if (out_type == 'XSIF' .or. out_type == 'ELEGANT') then - if (ele%key == elseparator$) then - n_elsep_warn = n_elsep_warn + 1 - ele%key = drift$ ! XSIF does not have elsep elements. - call out_io (s_info$, r_name, 'Elseparator being converted into a drift for ' //out_type // ' conversion: ' // ele%name) - endif - endif - - ! Do not make duplicate specs - - call find_index (ele%name, names, an_indexx, n_names, ix_match) - if (ix_match > 0) cycle - - ! Add to the list of elements - - if (size(names) < n_names + 10) then - call re_allocate(names, 2*size(names)) - call re_allocate(an_indexx, 2*size(names)) - endif - - call find_index (ele%name, names, an_indexx, n_names, ix_match, add_to_list = .true.) - - !------------------------------------------------------------------------------------------- - ! ELEGANT conversion - - if (out_type == 'ELEGANT') then - - bmad_params = '' - elegant_params = '' - - ! Special case where element is a pure thick N-pole of order greater than octupole. - select case (ele%key) - case (quadrupole$, sextupole$, octupole$, thick_multipole$) ! Elegant - call multipole_ele_to_kt(ele, .true., ix_pole_max, knl, tilts, magnetic$, include_kicks$) - if (count(knl /= 0) == 1 .and. all(knl(0:3) == 0)) then - n = find_location(knl /= 0, .true.) - 1 - write (line_out, '(2a)') trim(ele%name) // ': mult' - call value_to_line(line_out, knl(n), 'knl', 'R') - write (line_out, '(2a, i0)') trim(line_out), ', order = ', n - bmad_params(:5) = [character(40):: 'l', 'tilt', 'x_offset', 'y_offset', 'z_offset'] - elegant_params(:5) = [character(40):: 'l', 'tilt', 'dx', 'dy', 'dz'] - - do i = 1, size(bmad_params) - if (bmad_params(i) == '') exit - call pointer_to_attribute (ele, upcase(bmad_params(i)), .true., a_ptr, err_flag) - call value_to_line (line_out, a_ptr%r, elegant_params(i), 'R') - enddo - call write_line(line_out) - cycle - endif - end select - - ! - - select case (ele%key) - - case (instrument$, detector$, monitor$) ! Elegant - write (line_out, '(2a)') trim(ele%name) // ': moni' - bmad_params(:4) = [character(40):: 'l', 'tilt', 'x_offset', 'y_offset'] - elegant_params(:4) = [character(40):: 'l', 'tilt', 'dx', 'dy'] - - - case (drift$, pipe$) ! Elegant - if (ele%csr_method == off$) then - write (line_out, '(2a)') trim(ele%name) // ': edrift' - else - write (line_out, '(2a)') trim(ele%name) // ': csredrift' - endif - - bmad_params(:1) = [character(40):: 'l'] - elegant_params(:1) = [character(40):: 'l'] - - case (gkicker$) - write (line_out, '(2a)') trim(ele%name) // ': malign' - bmad_params(:6) = [character(40):: 'x_kick', 'y_kick', 'z_kick', 'px_kick', 'py_kick', 'pz_kick'] - elegant_params(:6) = [character(40):: 'dx', 'dy', 'dz', 'dxp', 'dyp', 'dp'] - - case (hkicker$) ! Elegant - write (line_out, '(2a)') trim(ele%name) // ': ehkick' - bmad_params(:6) = [character(40):: 'l', 'kick', 'tilt', 'x_offset', 'y_offset', 'z_offset'] - elegant_params(:6) = [character(40):: 'l', 'kick', 'tilt', 'dx', 'dy', 'dz'] - - case (vkicker$) ! Elegant - write (line_out, '(2a)') trim(ele%name) // ': evkick' - bmad_params(:6) = [character(40):: 'l', 'kick', 'tilt', 'x_offset', 'y_offset', 'z_offset'] - elegant_params(:6) = [character(40):: 'l', 'kick', 'tilt', 'dx', 'dy', 'dz'] - - case (kicker$) ! Elegant - write (line_out, '(2a)') trim(ele%name) // ': ekicker' - bmad_params(:7) = [character(40):: 'l', 'hkick', 'vkick', 'tilt', 'x_offset', 'y_offset', 'z_offset'] - elegant_params(:7) = [character(40):: 'l', 'hkick', 'vkick', 'tilt', 'dx', 'dy', 'dz'] - - case (sbend$) ! Elegant - if (ele%csr_method == off$) then - write (line_out, '(2a)') trim(ele%name) // ': csbend' - else - write (line_out, '(2a)') trim(ele%name) // ': csrcsbend' - endif - - if (ele%value(x_pitch$) /= 0 .or. ele%value(y_pitch$) /= 0) line_out = trim(line_out) // ', malign_method = 2' - - select case (nint(ele%value(fringe_at$))) - case (entrance_end$); line_out = trim(line_out) // ', edge2_effects = 0' - case (exit_end$); line_out = trim(line_out) // ', edge1_effects = 0' - case (no_end$); line_out = trim(line_out) // ', edge1_effects = 0, edge2_effects = 0' - end select - - call multipole_ele_to_ab(ele, .false., ix_pole_max, a_pole, b_pole, magnetic$, include_kicks$) - call value_to_line (line_out, ele%value(dg$)*ele%value(rho$), 'fse_dipole', 'R') - call value_to_line (line_out, b_pole(0) - ele%value(dg$)*ele%value(l$), 'xkick', 'R') - do n = 1, 8 - call value_to_line (line_out, b_pole(n)*factorial(n)/ele%value(l$), 'k' // int_str(n), 'R') - enddo - - - if (ele%value(fint$) == ele%value(fintx$)) then - if (ele%value(fint$) /= 0.5_rp) call value_to_line (line_out, ele%value(fint$), 'fint', 'R', .false.) - else - if (ele%value(fint$) /= 0.5_rp) call value_to_line (line_out, ele%value(fint$), 'fint1', 'R', .false.) - if (ele%value(fintx$) /= 0.5_rp) call value_to_line (line_out, ele%value(fintx$), 'fint2', 'R', .false.) - endif - - bmad_params(:12) = [character(40):: 'l', 'angle', 'e1', 'e2', 'ref_tilt', 'roll', 'h1', 'h2', & - 'vkick', 'x_offset', 'y_offset', 'z_offset'] - elegant_params(:12) = [character(40):: 'l', 'angle', 'e1', 'e2', 'tilt', 'etilt', 'h1', 'h2', 'ykick', 'dx', 'dy', 'dz'] - - case (quadrupole$) ! Elegant - knl = knl / ele%value(l$) - if (knl(2) == 0) then - write (line_out, '(2a)') trim(ele%name) // ': kquad' - if (ele%value(x_pitch$) /= 0 .or. ele%value(y_pitch$) /= 0) line_out = trim(line_out) // ', malign_method = 2' - else - write (line_out, '(2a)') trim(ele%name) // ': kquse' - call value_to_line (line_out, 0.5_rp*knl(2)*cos(3*(tilts(2)-tilts(1))), 'k2', 'R') - endif - - tilt = tilts(1) - call value_to_line (line_out, knl(1), 'k1', 'R') - - bmad_params(:1) = [character(40):: 'l'] - elegant_params(:1) = [character(40):: 'l'] - - case (sextupole$) ! Elegant - knl = knl / ele%value(l$) - write (line_out, '(2a)') trim(ele%name) // ': ksext' - if (ele%value(x_pitch$) /= 0 .or. ele%value(y_pitch$) /= 0) line_out = trim(line_out) // ', malign_method = 2' - call value_to_line (line_out, knl(2), 'k2', 'R') - call value_to_line (line_out, knl(1)*cos(0.5_rp*(tilts(1)-tilts(2))), 'k1', 'R') - call value_to_line (line_out, knl(1)*sin(0.5_rp*(tilts(1)-tilts(2))), 'j1', 'R') - call value_to_line (line_out, knl(0)*cos(tilts(0)), 'hkick', 'R') - call value_to_line (line_out, knl(0)*sin(tilts(0)), 'vkick', 'R') - - tilt = tilts(2) - bmad_params(:1) = [character(40):: 'l'] - elegant_params(:1) = [character(40):: 'l'] - - case (octupole$) ! Elegant - knl = knl / ele%value(l$) - write (line_out, '(2a)') trim(ele%name) // ': koct' - call value_to_line (line_out, knl(3), 'k3', 'R') - call value_to_line (line_out, knl(0)*cos(tilts(0)), 'hkick', 'R') - call value_to_line (line_out, knl(0)*sin(tilts(0)), 'vkick', 'R') - - tilt = tilts(3) - bmad_params(:1) = [character(40):: 'l'] - elegant_params(:1) = [character(40):: 'l'] - - case (solenoid$) ! Elegant - write (line_out, '(2a)') trim(ele%name) // ': sole' - bmad_params(:5) = [character(40):: 'l', 'ks', 'x_offset', 'y_offset', 'z_offset'] - elegant_params(:5) = [character(40):: 'l', 'ks', 'dx', 'dy', 'dz'] - - case (taylor$) ! Elegant - write (line_out, '(2a)') trim(ele%name) // ': ematrix' - do i = 1, 6 - f = taylor_coef(ele%taylor(i), [0,0,0,0,0,0]) - call value_to_line (line_out, f, 'c' // int_str(i), 'R') - - do j = 1, 6 - f = taylor_coef(ele%taylor(i), taylor_expn([j])) - call value_to_line (line_out, f, 'r' // int_str(i) // int_str(j), 'R') - - do k = 1, j - f = taylor_coef(ele%taylor(i), taylor_expn([j,k])) - call value_to_line (line_out, f, 'r' // int_str(i) // int_str(j), 'R') - enddo - enddo - enddo - - tilt = ele%value(tilt$) - bmad_params(:1) = [character(40):: 'l'] - elegant_params(:1) = [character(40):: 'l'] - - case (beambeam$) ! Elegant - write (line_out, '(2a)') trim(ele%name) // ': beambeam' - call value_to_line (line_out, strong_beam_strength(ele)*e_charge, 'charge', 'R') - bmad_params(:4) = [character(40):: 'x_offset', 'y_offset', 'sig_x', 'sig_y'] - elegant_params(:4) = [character(40):: 'xcenter', 'ycenter', 'xsize', 'ysize'] - - case (marker$) ! Elegant - write (line_out, '(2a)') trim(ele%name) // ': mark' - bmad_params(:2) = [character(40):: 'x_offset', 'y_offset'] - elegant_params(:2) = [character(40):: 'dx', 'dy'] - - case (ab_multipole$, multipole$) ! Elegant - call multipole_ele_to_kt(ele, .true., ix_pole_max, knl, tilts, include_kicks$) - orig_name = ele%name - ab_ele = ele - do i = 1, ix_pole_max - if (knl(i) == 0) cycle - ab_ele%name = trim(orig_name) // '__' // int_str(i) - write (line_out, '(2a)') trim(ab_ele%name) // ': mult' - call insert_element(lat_out, ab_ele, ix_ele+1, branch_out%ix_branch, orbit_out) - ix_ele = ix_ele + 1 - call value_to_line (line_out, knl(i), 'knl', 'R') - call value_to_line (line_out, tilts(i), 'tilt', 'R') - line_out = trim(line_out) // ', order = ' // int_str(i) - call value_to_line (line_out, ab_ele%value(x_offset$), 'dx', 'R') - call value_to_line (line_out, ab_ele%value(y_offset$), 'dy', 'R') - call value_to_line (line_out, ab_ele%value(z_offset$), 'dz', 'R') - call write_line (line_out) - enddo - cycle - - case (ecollimator$, rcollimator$) ! Elegant - if (ele%key == ecollimator$) then - write (line_out, '(2a)') trim(ele%name) // ': ecol' - else - write (line_out, '(2a)') trim(ele%name) // ': rcol' - endif - call value_to_line (line_out, ab_ele%value(l$), 'l', 'R') - - r_max = (ele%value(x2_limit$) + ele%value(x1_limit$)) / 2 - r0 = (ele%value(x2_limit$) - ele%value(x1_limit$)) / 2 - if (ele%offset_moves_aperture) r0 = r0 + ele%value(x_offset$) - call value_to_line (line_out, r_max, 'x_max', 'R') - call value_to_line (line_out, r0, 'dx', 'R') - - r_max = (ele%value(y2_limit$) + ele%value(y1_limit$)) / 2 - r0 = (ele%value(y2_limit$) - ele%value(y1_limit$)) / 2 - if (ele%offset_moves_aperture) r0 = r0 + ele%value(y_offset$) - call value_to_line (line_out, r_max, 'y_max', 'R') - call value_to_line (line_out, r0, 'dy', 'R') - - case (wiggler$, undulator$) ! Elegant - write (line_out, '(2a)') trim(ele%name) // ': wiggler' - bmad_params(:7) = [character(40):: 'l', 'b_max', 'x_offset', 'y_offset', 'z_offset', 'tilt', 'n_pole'] - elegant_params(:7) = [character(40):: 'l', 'b', 'dx', 'dy', 'dz', 'tilt', 'poles'] - - case (rfcavity$, lcavity$) ! Elegant - if (ele%key == rfcavity$) then - write (line_out, '(2a)') trim(ele%name) // ': rfca' - call value_to_line (line_out, 360.0_rp*(ele%value(phi0$)+ele%value(phi0_multipass$)), 'phase', 'R') - else - write (line_out, '(2a)') trim(ele%name) // ': rfca, change_p0 = 1' - call value_to_line (line_out, 360.0_rp*(ele%value(phi0$)+ele%value(phi0_multipass$))+90.0_rp, 'phase', 'R') - endif - - if (nint(ele%value(cavity_type$)) == standing_wave$) then - line_out = trim(line_out) // ', body_focus_model="SRS", standing_wave = 1, end1_focus=1, end2_focus=1' - endif - - bmad_params(:3) = [character(40):: 'l', 'voltage', 'rf_frequency'] - elegant_params(:3) = [character(40):: 'l', 'volt', 'freq'] - - case (crab_cavity$) ! Elegant - write (line_out, '(2a)') trim(ele%name) // ': rfdf' - call value_to_line (line_out, 360.0_rp*(ele%value(phi0$)+ele%value(phi0_multipass$)), 'phase', 'R') - bmad_params(:7) = [character(40):: 'l', 'voltage', 'rf_frequency', 'tilt', 'x_offset', 'y_offset', 'z_offset'] - elegant_params(:7) = [character(40):: 'l', 'voltage', 'frequency', 'tilt', 'dx', 'dy', 'dz'] - - case (patch$) ! Elegant - if (ele%value(tilt$) /= 0) then - write (line_out, '(2a)') trim(ele%name) // '_rot: rotate' - call value_to_line (line_out, ele%value(tilt$), 'tilt', 'R') - endif - - write (line_out, '(2a)') trim(ele%name) // ': malign' - bmad_params(:7) = [character(40):: 'x_offset', 'y_offset', 'z_offset', 't_offset', 'e_tot_offset', 'x_pitch', 'y_pitch'] - elegant_params(:7) = [character(40):: 'dx', 'dy', 'dz', 'dt', 'de', 'dxp', 'dyp'] - - case (floor_shift$) ! Elegant - write (line_out, '(2a)') trim(ele%name) // ': floor' - call value_to_line (line_out, ele%floor%r(1), 'x', 'R') - call value_to_line (line_out, ele%floor%r(2), 'y', 'R') - call value_to_line (line_out, ele%floor%r(3), 'z', 'R') - call value_to_line (line_out, ele%floor%theta, 'theta', 'R') - call value_to_line (line_out, ele%floor%phi, 'phi', 'R') - call value_to_line (line_out, ele%floor%psi, 'psi', 'R') - - case (match$) ! Elegant - write (line_out, '(2a)') trim(ele%name) // ': ematrix' - call value_to_line (line_out, ele%vec0(1), 'C1', 'R') - call value_to_line (line_out, ele%vec0(2), 'C2', 'R') - call value_to_line (line_out, ele%vec0(3), 'C3', 'R') - call value_to_line (line_out, ele%vec0(4), 'C4', 'R') - call value_to_line (line_out, ele%vec0(5), 'C5', 'R') - call value_to_line (line_out, ele%vec0(6), 'C6', 'R') - do i = 1, 6; do j = 1, 6 - call value_to_line (line_out, ele%mat6(i,j), 'R' // num(i) // num(j), 'R') - enddo; enddo - - case default - call out_io (s_error$, r_name, 'I DO NOT KNOW HOW TO TRANSLATE ELEMENT: ' // ele%name, & - 'WHICH IS OF TYPE: ' // key_name(ele%key), & - 'CONVERTING TO DRIFT') - write (line_out, '(2a)') trim(ele%name) // ': drift' - bmad_params(:1) = [character(40):: 'l'] - elegant_params(:1) = [character(40):: 'l'] - end select - - !-------------------------------------------------------- - - select case (ele%key) - case (sbend$, patch$, drift$) ! Elegant - ! Pass - - case (quadrupole$, sextupole$, octupole$, taylor$) ! Elegant - x_pitch = ele%value(x_pitch$) - y_pitch = ele%value(y_pitch$) - call floor_angles_to_w_mat(x_pitch, y_pitch, tilt, w_mat) - - if (x_pitch == 0 .or. y_pitch == 0) then - epitch = -y_pitch ! alpha_x - eyaw = x_pitch ! alpha_y - etilt = tilt ! alpha_z - else - epitch = -atan2(w_mat(2,3), w_mat(3,3)) - etilt = -atan2(w_mat(1,2), w_mat(1,1)) - eyaw = -atan2(w_mat(1,3), w_mat(2,3)/sin(epitch)) - endif - - offset = matmul(w_mat, [ele%value(x_offset$), ele%value(y_offset$), ele%value(z_offset$)]) - call value_to_line (line_out, etilt, 'tilt', 'R') - call value_to_line (line_out, epitch, 'pitch', 'R') - call value_to_line (line_out, eyaw, 'yaw', 'R') - call value_to_line (line_out, offset(1), 'dx', 'R') - call value_to_line (line_out, offset(2), 'dy', 'R') - call value_to_line (line_out, offset(3), 'dz', 'R') - - ! Elegant - - case (instrument$, detector$, monitor$, hkicker$, vkicker$, kicker$) ! Has tilt but not pitches. - if (has_orientation_attributes(ele) .and. (ele%value(x_pitch$) /= 0 .or. ele%value(y_pitch$) /= 0)) then - call out_io (s_warn$, r_name, 'X_PITCH OR Y_PITCH PARAMETERS OF A ' // trim(key_name(ele%key)) // ' CANNOT BE TRANSLATED TO ELEGANT: ' // ele%name) - endif - case default - if (has_orientation_attributes(ele) .and. (ele%value(x_pitch$) /= 0 .or. ele%value(y_pitch$) /= 0 .or. ele%value(tilt$) /= 0)) then - call out_io (s_warn$, r_name, 'TILT, X_PITCH OR Y_PITCH PARAMETERS OF A ' // trim(key_name(ele%key)) // ' CANNOT BE TRANSLATED TO ELEGANT: ' // ele%name) - endif - end select - - !-------------------------------------------------------- - - do i = 1, size(bmad_params) - if (bmad_params(i) == '') exit - call pointer_to_attribute (ele, upcase(bmad_params(i)), .true., a_ptr, err_flag) - call value_to_line (line_out, a_ptr%r, elegant_params(i), 'R') - enddo - - call write_line(line_out) - cycle - endif - - !------------------------------------------------------------------------------------------------- - ! OPAL conversion - - if (out_type == 'OPAL-T') then - - select case (ele%key) - - ! OPAL-T - case (marker$) - write (line_out, '(a)') trim(ele%name) // ': marker' - call value_to_line (line_out, ele%s - val(L$), 'elemedge', 'R', .false.) - - - ! OPAL-T - case (drift$, instrument$, pipe$, detector$, monitor$) - write (line_out, '(2a)') trim(ele%name) // ': drift, l = ', re_str(val(l$)) - call value_to_line (line_out, ele%s - val(L$), 'elemedge', 'R', .false.) - - ! OPAL-T - case (sbend$) - write (line_out, '(2a)') trim(ele%name) // ': sbend, l = ', re_str(val(l$)) - call value_to_line (line_out, val(b_field$), 'k0', 'R') - call value_to_line (line_out, val(e_tot$), 'designenergy', 'R') - call value_to_line (line_out, ele%s - val(L$), 'elemedge', 'R', .false.) - - ! OPAL-T - case (quadrupole$) - write (line_out, '(2a)') trim(ele%name) // ': quadrupole, l = ', re_str(val(l$)) - !Note that OPAL-T has k1 = dBy/dx, and that bmad needs a -1 sign for electrons - call value_to_line (line_out, -1*val(b1_gradient$), 'k1', 'R') - !elemedge The edge of the field is specifieda bsolute (floor space co-ordinates) in m. - call value_to_line (line_out, ele%s - val(L$), 'elemedge', 'R', .false.) - - ! OPAL-T - case default - call out_io (s_error$, r_name, 'I DO NOT KNOW HOW TO TRANSLATE ELEMENT: ' // ele%name, & - 'WHICH IS OF TYPE: ' // key_name(ele%key), & - 'CONVERTING TO DRIFT') - write (line_out, '(2a)') trim(ele%name) // ': drift, l = ', re_str(val(l$)) - call value_to_line (line_out, ele%s - val(L$), 'elemedge', 'R', .false.) - - end select - - call write_line(line_out) - cycle - endif - - !----------------------------------- - ! For anything else but OPAL and ELEGANT - - select case (ele%key) - - ! drift MAD - - case (drift$, instrument$, pipe$, detector$, monitor$) - - write (line_out, '(2a)') trim(ele%name) // ': drift, l = ', re_str(val(l$)) - - ! beambeam MAD - - case (beambeam$) - - line_out = trim(ele%name) // ': beambeam' - call value_to_line (line_out, val(sig_x$), 'sigx', 'R') - call value_to_line (line_out, val(sig_y$), 'sigy', 'R') - call value_to_line (line_out, val(x_offset$), 'xma', 'R') - call value_to_line (line_out, val(y_offset$), 'yma', 'R') - call value_to_line (line_out, val(charge$), 'charge', 'R') - - - ! r/ecollimator MAD - - case (ecollimator$, rcollimator$) - - if (out_type == 'MAD-X') then - write (line_out, '(2a)') trim(ele%name) // ': collimator, l = ', re_str(val(l$)) - else - write (line_out, '(2a)') trim(ele%name) // ': ' // trim(key_name(ele%key)) // ', l = ', re_str(val(l$)) - call value_to_line (line_out, val(x1_limit$), 'xsize', 'R') - call value_to_line (line_out, val(y1_limit$), 'ysize', 'R') - endif - - ! elseparator MAD - - case (elseparator$) - - write (line_out, '(2a)') trim(ele%name) // ': elseparator, l = ', re_str(val(l$)) - hk = val(hkick$) - vk = val(vkick$) - - if (hk /= 0 .or. vk /= 0) then - - ix = len_trim(line_out) + 1 - field = 1.0d3 * sqrt(hk**2 + vk**2) * val(E_TOT$) / val(l$) - if (out_type == 'MAD-X') then - write (line_out(ix:), '(2a)') ', ey = ', re_str(field) - else - write (line_out(ix:), '(2a)') ', e = ',re_str(field) - endif - - if (branch_out%param%particle == positron$) then - tilt = -atan2(hk, vk) + val(tilt$) - else - tilt = -atan2(hk, vk) + val(tilt$) + pi - endif - ix = len_trim(line_out) + 1 - write (line_out(ix:), '(2a)') ', tilt = ', re_str(tilt) - - endif - - ! hkicker MAD - - case (hkicker$) - - write (line_out, '(2a)') trim(ele%name) // ': hkicker, l = ', re_str(val(l$)) - - call value_to_line (line_out, val(kick$), 'kick', 'R') - call value_to_line (line_out, val(tilt$), 'tilt', 'R') - - ! kicker MAD - - case (kicker$) - - write (line_out, '(2a)') trim(ele%name) // ': kicker, l = ', re_str(val(l$)) - - call value_to_line (line_out, val(hkick$), 'hkick', 'R') - call value_to_line (line_out, val(vkick$), 'vkick', 'R') - call value_to_line (line_out, val(tilt$), 'tilt', 'R') - - ! vkicker MAD - - case (vkicker$) - - write (line_out, '(2a)') trim(ele%name) // ': vkicker, l = ', re_str(val(l$)) - - call value_to_line (line_out, val(kick$), 'kick', 'R') - call value_to_line (line_out, val(tilt$), 'tilt', 'R') - - ! marker MAD - - case (marker$, fork$, photon_fork$) - - line_out = trim(ele%name) // ': marker' - - ! octupole MAD - - case (octupole$) - - write (line_out, '(2a)') trim(ele%name) // ': octupole, l = ', re_str(val(l$)) - - call value_to_line (line_out, val(k3$), 'k3', 'R') - call value_to_line (line_out, val(tilt$), 'tilt', 'R') - - ! quadrupole MAD - - case (quadrupole$) - - write (line_out, '(2a)') trim(ele%name) // ': quadrupole, l = ', re_str(val(l$)) - call value_to_line (line_out, val(k1$), 'k1', 'R') - call value_to_line (line_out, val(tilt$), 'tilt', 'R') - - ! sbend MAD - - case (sbend$) - - write (line_out, '(2a)') trim(ele%name) // ': sbend, l = ', re_str(val(l$)) - - call value_to_line (line_out, val(angle$), 'angle', 'R') - call value_to_line (line_out, val(e1$), 'e1', 'R') - call value_to_line (line_out, val(e2$), 'e2', 'R') - call value_to_line (line_out, val(k1$), 'k1', 'R') - call value_to_line (line_out, val(ref_tilt$), 'tilt', 'R') - if (out_type == 'MAD-X') then - call value_to_line (line_out, val(fint$), 'fint', 'R') - call value_to_line (line_out, val(fintx$), 'fintx', 'R') - call value_to_line (line_out, val(hgap$), 'hgap', 'R') - else - if (val(fintx$) /= val(fint$)) then - call out_io (s_info$, r_name, 'FINTX != FINT FOR BEND' // ele%name, 'CANNOT TRANSLATE FINTX') - endif - call value_to_line (line_out, val(fint$), 'fint', 'R') - call value_to_line (line_out, val(hgap$), 'hgap', 'R') - endif - - ! MAD-X sbend kick fields. MAD-8 conversion uses matrix elements to either side (see above). - - if (out_type == 'MAD-X' .and. ele%value(l$) /= 0) then - call multipole_ele_to_ab (ele, .false., ix, a_pole, b_pole, magnetic$, include_kicks$) - call value_to_line (line_out, val(dg$) + b_pole(0)/val(l$), 'k0', 'R') - call value_to_line (line_out, a_pole(0)/val(l$), 'k0s', 'R') - endif - - ! sextupole MAD - - case (sextupole$) - - write (line_out, '(2a)') trim(ele%name) // ': sextupole, l = ', re_str(val(l$)) - call value_to_line (line_out, val(k2$), 'k2', 'R') - call value_to_line (line_out, val(tilt$), 'tilt', 'R') - - ! taylor MAD - - case (taylor$, sad_mult$, patch$, match$) - - if (ele%key == patch$ .and. out_type == 'MAD-X') then - ele%key = null_ele$ - orig_name = ele%name - if (val(x_offset$) /= 0 .or. val(y_offset$) /= 0 .or. val(z_offset$) /= 0) then - drift_ele%name = trim(orig_name) // '__t' - call insert_element(lat_out, drift_ele, ix_ele+1, branch_out%ix_branch, orbit_out) - ix_ele = ix_ele + 1 - line_out = trim(drift_ele%name) // ': translation' - call value_to_line (line_out, val(x_offset$), 'dx', 'R') - call value_to_line (line_out, val(y_offset$), 'dy', 'R') - call value_to_line (line_out, val(z_offset$), 'ds', 'R') - call write_line(line_out) - endif - - if (val(x_pitch$) /= 0) then - drift_ele%name = trim(orig_name) // '__y' - call insert_element(lat_out, drift_ele, ix_ele+1, branch_out%ix_branch, orbit_out) - ix_ele = ix_ele + 1 - call write_line(trim(drift_ele%name) // ': yrotation, angle = ' // re_str(-val(x_pitch$))) - endif - - if (val(y_pitch$) /= 0) then - drift_ele%name = trim(orig_name) // '__x' - call insert_element(lat_out, drift_ele, ix_ele+1, branch_out%ix_branch, orbit_out) - ix_ele = ix_ele + 1 - call write_line(trim(drift_ele%name) // ': xrotation, angle = ' // re_str(-val(y_pitch$))) - endif - - if (val(tilt$) /= 0) then - drift_ele%name = trim(orig_name) // '__s' - call insert_element(lat_out, drift_ele, ix_ele+1, branch_out%ix_branch, orbit_out) - ix_ele = ix_ele + 1 - call write_line(trim(drift_ele%name) // ': srotation, angle = ' // re_str(val(tilt$))) - endif - - cycle - endif - - if (associated (ele%taylor(1)%term)) then - taylor_ptr => ele%taylor - elseif (ele%key == match$) then - allocate(taylor_ptr(6)) - call ele_to_taylor (ele, branch%param, orbital_taylor = taylor_ptr) - else - allocate(taylor_ptr(6)) - if (.not. present(ref_orbit)) then - call out_io (s_error$, r_name, & - 'ORBIT ARGUMENT NEEDS TO BE PRESENT WHEN TRANSLATING', & - 'A LATTICE WITH A SAD_MULT OR PATCH ELEMENT') - cycle - endif - if (ptc_private%taylor_order_ptc /= 2) call set_ptc (taylor_order = 2) - call ele_to_taylor (ele, branch%param, orbit_out(ix_ele-1), .true., orbital_taylor = taylor_ptr) - endif - - line_out = trim(ele%name) // ': matrix' - warn_printed = .false. - call value_to_line (line_out, val(l$), 'l', 'R') - - do i = 1, 6 - do k = 1, size(taylor_ptr(i)%term) - term = taylor_ptr(i)%term(k) - - select case (sum(term%expn)) - case (0) - select case (out_type) - case ('MAD-8') - write (str, '(a, i0, a)') 'kick(', i, ')' - case ('MAD-X') - write (str, '(a, i0)') 'kick', i - case ('XSIF') - call out_io (s_error$, r_name, 'XSIF DOES NOT HAVE A CONSTRUCT FOR ZEROTH ORDER TAYLOR TERMS NEEDED FOR: ' // ele%name) - cycle - end select - call value_to_line (line_out, term%coef, str, 'R') - - case (1) - j = maxloc(term%expn, 1) - select case (out_type) - case ('MAD-8') - write (str, '(a, i0, a, i0, a)') 'rm(', i, ',', j, ')' - case ('MAD-X') - write (str, '(a, 2i0)') 'rm', i, j - case ('XSIF') - write (str, '(a, 2i0)') 'r', i, j - end select - - if (j == i) then - call value_to_line (line_out, term%coef, str, 'R', .false.) - else - call value_to_line (line_out, term%coef, str, 'R') - endif - - case (2) - j = maxloc(term%expn, 1) - term%expn(j) = term%expn(j) - 1 - j2 = maxloc(term%expn, 1) - select case (out_type) - case ('MAD-8') - write (str, '(a, 3(i0, a))') 'tm(', i, ',', j, ',', j2, ')' - case ('MAD-X') - write (str, '(a, 3i0)') 'tm', i, j, j2 - case ('XSIF') - write (str, '(a, 3i0)') 't', i, j, j2 - end select - call value_to_line (line_out, term%coef, str, 'R') - - case default - if (.not. warn_printed .and. ele%key == taylor$) then - call out_io (s_warn$, r_name, & - 'Higher order taylor term(s) in: ' // trim(ele%name) // & - ' cannot be converted to mad matrix term') - warn_printed = .true. - endif - end select - enddo - - enddo - - if (.not. associated(ele%taylor(1)%term)) deallocate(taylor_ptr) - - ! rfcavity MAD - - case (rfcavity$) - - write (line_out, '(2a)') trim(ele%name) // ': rfcavity, l = ', re_str(val(l$)) - call value_to_line (line_out, val(voltage$)/1E6, 'volt', 'R') - call value_to_line (line_out, val(phi0$)+val(phi0_multipass$)+0.5, 'lag', 'R') - call value_to_line (line_out, val(harmon$), 'harmon', 'I') - - ! lcavity MAD - - case (lcavity$) - - write (line_out, '(2a)') trim(ele%name) // ': lcavity, l = ', re_str(val(l$)) - call value_to_line (line_out, val(gradient$)*val(l$)/1d6, 'deltae', 'R') - call value_to_line (line_out, val(rf_frequency$)/1d6, 'freq', 'R') - call value_to_line (line_out, val(phi0$)+val(phi0_multipass$), 'phi0', 'R') - if (out_type == 'MAD-8' .and. nint(ele%value(cavity_type$)) == standing_wave$) then - line_out = trim(line_out) // ', swave' - endif - - - ! solenoid MAD - - case (solenoid$) - - write (line_out, '(2a)') trim(ele%name) // ': solenoid, l = ', re_str(val(l$)) - call value_to_line (line_out, val(ks$), 'ks', 'R') - - ! multipole MAD - - case (multipole$, ab_multipole$) - - knl = 0; tilts = 0 - call multipole_ele_to_kt (ele, .true., ix_pole_max, knl, tilts) - write (line_out, '(2a)') trim(ele%name) // ': multipole' - - if (out_type == 'MAD-X') then - knl_str = ''; ksl_str = '' - call multipole_ele_to_ab (ele, .true., ix_pole_max, a_pole, b_pole) - do i = 0, 9 - if (all(knl(i:) == 0)) exit - if (abs(a_pole(i)) < 1d-12 * abs(b_pole(i))) a_pole(i) = 0 ! Round to zero insignificant value - if (abs(b_pole(i)) < 1d-12 * abs(a_pole(i))) b_pole(i) = 0 ! Round to zero insignificant value - call value_to_line (knl_str, b_pole(i) * factorial(i), '', 'R', .false.) - call value_to_line (ksl_str, -a_pole(i) * factorial(i), '', 'R', .false.) - enddo - if (any(b_pole /= 0)) line_out = trim(line_out) // ', knl = {' // trim(knl_str(3:)) // '}' - if (any(a_pole /= 0)) line_out = trim(line_out) // ', ksl = {' // trim(ksl_str(3:)) // '}' - - else - do i = 0, 9 - write (str, '(a, i0, a)') 'K', i, 'L' - call value_to_line (line_out, knl(i), str, 'R') - write (str, '(a, i0)') 'T', i - call value_to_line (line_out, tilts(i), str, 'R') - enddo - endif - - ! unknown MAD - - case default - - call out_io (s_error$, r_name, 'I DO NOT KNOW HOW TO TRANSLATE ELEMENT: ' // ele%name, & - 'WHICH IS OF TYPE: ' // key_name(ele%key), & - 'CONVERTING TO DRIFT') - line_out = trim(ele%name) // ': drift, l = ' // re_str(val(l$)) - - end select - - ! Add apertures for mad-x. Use 1 meter for unset apertures - - if (out_type == 'MAD-X' .and. logic_option(.true., include_apertures)) then - if (val(x1_limit$) /= 0 .or. val(y1_limit$) /= 0) then - limit = [val(x1_limit$), val(y1_limit$)] - where (limit == 0) limit = 1 - if (ele%aperture_type == rectangular$) then - line_out = trim(line_out) // ', apertype = rectangle' - else - line_out = trim(line_out) // ', apertype = ellipse' - endif - write (line_out, '(6a)') trim(line_out), ', aperture = {', re_str(limit(1)), ', ', re_str(limit(2)), '}' - endif - endif - - ! write element spec to file - - call write_line(line_out) - -enddo - -!--------------------------------------------------------------------------------------- -! Write the lattice line -! MAD has a limit of 4000 characters so we may need to break the lat into pieces. - -i_unique = 1000 -i_line = 0 -init_needed = .true. -line = ' ' - -do n = 1, branch_out%n_ele_track - ele => branch_out%ele(n) - if (ele%key == null_ele$) cycle ! Will happen with patch elements translated to MAD-X - if (ele%key == -1) cycle - - if (init_needed) then - write (iu, '(a)') - write (iu, '(3a)') comment_char, '---------------------------------', trim(eol_char) - write (iu, '(a)') - i_line = i_line + 1 - write (line_out, '(a, i0, 2a)') 'line_', i_line, ': line = (', ele%name - iout = 0 - init_needed = .false. - - else - ix = len_trim(line_out) + len_trim(ele%name) - - if (ix > 75) then - write (iu, '(3a)') trim(line_out), trim(separator_char), trim(continue_char) - iout = iout + 1 - line_out = ' ' // ele%name - else - line_out = trim(line_out) // trim(separator_char) // ' ' // ele%name - endif - endif - - if (out_type == 'ELEGANT' .and. ele%key == patch$ .and. ele%value(tilt$) /= 0) then - line_out = trim(line_out) // ', ' // trim(ele%name) // '_rot' - endif - - ! Output line if long enough or at end - - if (n == branch_out%n_ele_track .or. iout > 48) then - line_out = trim(line_out) // ')' - write (iu, '(2a)') trim(line_out), trim(eol_char) - line_out = ' ' - init_needed = .true. - endif - -enddo - -!------------------------------------------ -! Use statement - -write (iu, '(a)') -write (iu, '(3a)') comment_char, '---------------------------------', trim(eol_char) -write (iu, '(a)') - -line_out = 'lat: line = (line_1' - -do i = 2, i_line - write (line_out, '(3a, i0)') trim(line_out), trim(separator_char), ' line_', i -enddo - -line_out = trim(line_out) // ')' -call write_line (line_out) - -if (out_type == 'MAD-X') then - write (iu, '(a)') 'use, period = lat;' -elseif (out_type /= 'OPAL-T') then - write (iu, '(a)') 'use, lat' -endif - -!--------------------------------------------------- -! Element offsets for MAD. -! This must come after use statement. - -if (out_type(1:3) == 'MAD') then - - write (iu, '(a)') - write (iu, '(3a)') comment_char, '---------------------------------', trim(eol_char) - write (iu, '(a)') - - allocate (n_repeat(n_names)) - n_repeat = 0 - - do ix_ele = 1, branch_out%n_ele_track - - ele => branch_out%ele(ix_ele) - val => ele%value - - ! sad_mult and patch elements are translated to a matrix which does not have offsets. - ! And marker like elements also do not have offsets - - if (ele%key == sad_mult$ .or. ele%key == patch$) cycle - if (ele%key == marker$ .or. ele%key == fork$ .or. ele%key == photon_fork$) cycle - - ! - - call find_index (ele%name, names, an_indexx, n_names, ix_match) - if (ix_match == 0) cycle ! Happens for translated to MADX patch elements. - n_repeat(ix_match) = n_repeat(ix_match) + 1 - - if (val(x_pitch$) == 0 .and. val(y_pitch$) == 0 .and. & - val(x_offset_tot$) == 0 .and. val(y_offset_tot$) == 0 .and. val(z_offset_tot$) == 0) cycle - - write (iu, '(3a)') 'select, flag = error, clear', trim(eol_char) - write (iu, '(3a, i0, 2a)') 'select, flag = error, range = ', trim(ele%name), & - '[', n_repeat(ix_match), ']', trim(eol_char) - - line_out = 'ealign' - call value_to_line (line_out, val(x_pitch$), 'dtheta', 'R') - call value_to_line (line_out, -val(y_pitch$), 'dphi', 'R') - call value_to_line (line_out, val(x_offset$) - val(x_pitch$) * val(l$) / 2, 'dx', 'R') - call value_to_line (line_out, val(y_offset$) - val(y_pitch$) * val(l$) / 2, 'dy', 'R') - call value_to_line (line_out, val(z_offset$), 'ds', 'R') - call write_line (line_out) - - enddo - - deallocate (n_repeat) - -endif - -! Write twiss parameters for a non-closed lattice. - -if (branch_out%param%geometry == open$ .and. (out_type == 'MAD-8' .or. out_type == 'MAD-X' .or. out_type == 'XSIF')) then - ele => branch_out%ele(0) - orb_start = lat%particle_start - beta = ele%value(p0c$) / ele%value(E_tot$) - write (iu, '(a)') - write (iu, '(3a)') comment_char, '---------------------------------', trim(eol_char) - write (iu, '(a)') - write (iu, '(12a)') 'initial: beta0, betx = ', re_str(ele%a%beta), ', bety = ', re_str(ele%b%beta), & - ', alfx = ', re_str(ele%a%alpha), ', alfy = ', re_str(ele%b%alpha), ', ', trim(continue_char) - write (iu, '(5x, 12a)') 'dx = ', re_str(ele%a%eta), ', dpx = ', re_str(ele%a%etap), & - ', dy = ', re_str(ele%b%eta), ', dpy = ', re_str(ele%b%etap), ', ', trim(continue_char) - write (iu, '(5x, 12a)') 'x = ', re_str(orb_start%vec(1)), ', px = ', re_str(orb_start%vec(2)), & - ', y = ', re_str(orb_start%vec(3)), ', py = ', re_str(orb_start%vec(4)), & - ', t = ', re_str(orb_start%vec(5)*beta), ', pt = ', re_str(orb_start%vec(6)/beta), trim(eol_char) - - - - if (ele%a%beta /= 0 .and. ele%b%beta /= 0) then - write (iu, '(a)') 'twiss, beta0 = initial;' - endif -endif - -! End stuff - -call out_io (s_info$, r_name, 'Written ' // trim(out_type) // ' lattice file: ' // trim(out_file_name)) - -deallocate (names) -if (present(err)) err = .false. - -if (present(converted_lat)) then - converted_lat = lat - converted_lat%branch(branch%ix_branch) = branch_out - converted_lat%n_ele_max = converted_lat%n_ele_track - do ib = 0, ubound(converted_lat%branch, 1) - branch => converted_lat%branch(ib) - do i = 1, branch%n_ele_track - branch%ele(i)%slave_status = free$ - branch%ele(i)%n_lord = 0 - enddo - enddo - converted_lat%n_control_max = 0 - converted_lat%n_ic_max = 0 -endif - -call deallocate_lat_pointers (lat_out) -call deallocate_lat_pointers (lat_model) - -! Restore ptc settings - -if (n_taylor_order_saved /= ptc_private%taylor_order_ptc) call set_ptc (taylor_order = n_taylor_order_saved) -ptc_com%exact_model = ptc_exact_model - -close(iu) - -!------------------------------------------------------------------------ -contains - -subroutine write_line (line_out) - -implicit none - -character(*) line_out -integer ix, ix1, ix2, ix3 - -! Prefer to breakup a line after a comma - -do - if (len_trim(line_out) < ix_line_max) exit - ix1 = index(line_out(ix_line_min+1:), ',') - ix2 = index(line_out(ix_line_min+1:), '=') - ix3 = index(line_out(ix_line_min+1:), ' ') - - if (ix1 /= 0 .and. ix1+ix_line_min < ix_line_max) then - ix = ix1 + ix_line_min - elseif (ix2 /= 0 .and. ix2+ix_line_min < ix_line_max) then - ix = ix2 + ix_line_min - elseif (ix3 /= 0 .and. ix3+ix_line_min < ix_line_max) then - ix = ix3 + ix_line_min - elseif (ix1 /= 0) then - ix = ix1 + ix_line_min - elseif (ix2 /= 0) then - ix = ix2 + ix_line_min - else - ix = ix3 + ix_line_min - endif - - write (iu, '(2a)') line_out(:ix), trim(continue_char) - line_out = ' ' // line_out(ix+1:) -enddo - -write (iu, '(2a)') trim(line_out), trim(eol_char) - -end subroutine write_line +if (present(converted_lat)) converted_lat = lat end subroutine write_lattice_in_foreign_format diff --git a/bmad/output/write_lattice_in_julia.f90 b/bmad/output/write_lattice_in_julia.f90 index ed1210e363..faddb0956a 100644 --- a/bmad/output/write_lattice_in_julia.f90 +++ b/bmad/output/write_lattice_in_julia.f90 @@ -1,19 +1,20 @@ !+ -! Subroutine write_lattice_in_julia(bmad_file, lat, julia_file) +! Subroutine write_lattice_in_julia(julia_file, lat, err_flag) ! ! Routine to create a Bmad-Julia lattice file. ! ! Input: ! lat -- lat_struct: Lattice -! bmad_file -- character(*): Input Bmad lattice file name. -! If the name does not have a .jl suffix then this suffix will be added. +! ! Output: ! julia_file -- character(*), optional: Bmad-Julia lattice file name. +! err_flag -- logical, optional: Error flag !- -subroutine write_lattice_in_julia(bmad_file, lat, julia_file) +subroutine write_lattice_in_julia(julia_file, lat, err_flag) -use write_lat_file_mod, dummy => write_lattice_in_julia +use write_lattice_file_mod, dummy => write_lattice_in_julia +use bmad, dummy2 => write_lattice_in_julia implicit none @@ -37,9 +38,9 @@ subroutine write_lattice_in_julia(bmad_file, lat, julia_file) integer, allocatable :: an_indexx(:), index_list(:) logical has_been_added, in_multi_region, have_expand_lattice_line, err +logical, optional :: err_flag -character(*) bmad_file -character(*), optional :: julia_file +character(*) julia_file character(1) prefix character(40) name, look_for character(40), allocatable :: names(:) @@ -47,7 +48,6 @@ subroutine write_lattice_in_julia(bmad_file, lat, julia_file) character(1000) line character(*), parameter :: r_name = 'write_lattice_in_julia' - character(20), parameter :: julia_name(n_key$) = [character(20):: & 'Drift ', 'Bend ', 'Quadrupole ', 'Group ', 'Sextupole ', & 'Overlay ', 'Custom ', 'Taylor ', 'RFCavity ', 'ELSeparator ', & @@ -67,15 +67,13 @@ subroutine write_lattice_in_julia(bmad_file, lat, julia_file) ! Open file -call fullfilename(bmad_file, fname) -call file_suffixer(fname, fname, '.jl', .true.) +call fullfilename(julia_file, fname) iu = lunget() open (iu, file = fname, status = 'unknown') -if (present(julia_file)) julia_file = fname ! Write element defs -write (iu, '(a)') '# Lattice file translated from Fortran Bmad.' +write (iu, '(a)') '# Lattice file translated from Bmad.' write (iu, '(a)') n_names = 0 diff --git a/bmad/output/write_lattice_in_mad_format.f90 b/bmad/output/write_lattice_in_mad_format.f90 new file mode 100644 index 0000000000..ae8378123d --- /dev/null +++ b/bmad/output/write_lattice_in_mad_format.f90 @@ -0,0 +1,1195 @@ +!+ +! Subroutine write_lattice_in_mad_format (out_type, out_file_name, lat, ref_orbit, & +! use_matrix_model, include_apertures, dr12_drift_max, ix_branch, converted_lat, err) +! +! Subroutine to write a MAD-8, or MAD-X, lattice file using the +! information in a lat_struct. Optionally, only part of the lattice can be generated. +! +! To write a Bmad lattice file, use: write_bmad_lattice_file +! +! Note: Sad_mult and patch element are translated to a MAD8 matrix element (which is a 2nd order map). +! In this case, the ref_orbit orbit is used as the reference orbit for construction of the 2nd order map. +! +! If a sad_mult or patch element is translated to a matrix element, and the referece orbit +! is non-zero, the calculation must use 2nd order maps thourghout in order to avoid "feed down". +! If the PTC map order is different from 2, PTC will be temperarily switched to 2. +! +! The MAD drift model is approximate and this can be a problem if the reference orbit is large. +! For a drift, the value of transfer matrix element R12 is equal to L/(1+pz) for small +! deviations of the ref_orbit from zero. dr12_drift_max sets the maximum deviation of R12 beyound +! which an extra matrix element is inserted to make the MAD model better agree with Bmad. +! +! Note: sol_quad elements are replaced by a drift-matrix-drift or solenoid-quad model. +! Note: wiggler elements are replaced by a drift-matrix-drift or drift-bend model. +! +! Input: +! out_type -- character(*): Either 'MAD-8', or 'MAD-X' +! out_file_name -- character(*): Name of the mad output lattice file. +! lat -- lat_struct: Holds the lattice information. +! ref_orbit(0:) -- coord_struct, allocatable, optional: Referece orbit for sad_mult and patch elements. +! This argument must be present if the lattice has sad_mult or patch elements and is +! being translated to MAD-8 or SAD. +! use_matrix_model -- logical, optional: Use a drift-matrix_drift model for wigglers/undulators? +! [A MAD "matrix" is a 2nd order Taylor map.] This switch is ignored for SAD conversion. +! Default is False -> Use a bend-drift-bend model. +! Note: sol_quad elements always use a drift-matrix-drift model. +! include_apertures -- logical, optional: If True (the default), add to the output lattice a zero length +! collimator element next to any non-collimator element that has an aperture. +! Note: MADX translations for non-drift elements can handle non-collimator elements +! with an aperture so in this case this argument is ignored. +! dr12_drift_max -- real(rp), optional: Max deviation for drifts allowed before a correction matrix element +! is added. Default value is 1d-5. A negative number means use default. +! ix_branch -- Integer, optional: Index of lattice branch to use. Default = 0. +! +! Output: +! converted_lat -- lat_struct, optional: Equivalent Bmad lattice with wiggler and +! sol_quad elements replaced by their respective models. +! err -- logical, optional: Set True if, say a file could not be opened. +!- + +subroutine write_lattice_in_mad_format (out_type, out_file_name, lat, ref_orbit, & + use_matrix_model, include_apertures, dr12_drift_max, ix_branch, converted_lat, err) + +use mad_mod, dummy2 => write_lattice_in_mad_format +use bmad, dummy => write_lattice_in_mad_format +use write_lattice_file_mod, dummy3 => write_lattice_in_mad_format +use ptc_interface_mod, only: taylor_inverse, concat_taylor + +implicit none + +type (lat_struct), target :: lat, lat_model, lat_out +type (lat_struct), optional, target :: converted_lat +type (ele_struct), pointer :: ele, ele1, ele2, lord, sol_ele, first_sol_edge +type (ele_struct) :: drift_ele, ab_ele, taylor_ele, col_ele, kicker_ele, null_ele, bend_ele, quad_ele +type (coord_struct) orb_start, orb_end, orb_center +type (coord_struct), allocatable, optional :: ref_orbit(:) +type (coord_struct), allocatable :: orbit_out(:) +type (taylor_term_struct) :: term +type (branch_struct), pointer :: branch, branch_out +type (mad_energy_struct) energy +type (mad_map_struct) mad_map +type (taylor_struct) taylor_a(6), taylor_b(6) +type (taylor_struct), pointer :: taylor_ptr(:) +type (all_pointer_struct) a_ptr + +real(rp), optional :: dr12_drift_max +real(rp) field, hk, vk, limit(2), length, a, b, f, e2, beta, r_max, r0, dr12_max +real(rp), pointer :: val(:) +real(rp) knl(0:n_pole_maxx), tilts(0:n_pole_maxx), a_pole(0:n_pole_maxx), b_pole(0:n_pole_maxx) +real(rp) tilt, x_pitch, y_pitch, etilt, epitch, eyaw, offset(3), w_mat(3,3) + +integer, optional :: ix_branch +integer, allocatable :: n_repeat(:), an_indexx(:) +integer i, j, ib, j2, k, n, ix, i_unique, i_line, iout, iu, n_names, j_count, f_count, ix_ele +integer ie, ios, a_count, ix_lord, ix_match, iv, ifa, ix_pole_max +integer ix1, ix2, n_lord, aperture_at, n_name_change_warn, n_elsep_warn, n_taylor_order_saved +integer :: ix_line_min, ix_line_max, n_warn_max, n_wig_model_err, print_wig_model_err_max + +character(*), parameter :: r_name = "write_lattice_in_mad_format" +character(*) out_type, out_file_name +character(300) line, knl_str, ksl_str +character(40) orig_name, str, bmad_params(20) +character(40), allocatable :: names(:) +character(4000) line_out ! Can be this large for taylor maps. +character(2) continue_char, eol_char, comment_char, separator_char +character(1), parameter :: num(9) = ['1', '2', '3', '4', '5', '6', '7', '8', '9'] + +logical, optional :: use_matrix_model, include_apertures, err +logical init_needed, err_flag, monopole +logical parsing, warn_printed, converted, ptc_exact_model +logical print_err + +! Use ptc exact_model = True since this is needed to get the drift nonlinear terms + +ptc_exact_model = ptc_com%exact_model +ptc_com%exact_model = .true. +dr12_max = real_option(1d-5, dr12_drift_max) +if (dr12_max < 0) dr12_max = 1d-5 + +! Init + +n_warn_max = 10 +n_wig_model_err = 0 +print_wig_model_err_max = 5 + +ix = integer_option(0, ix_branch) +if (ix < 0 .or. ix > ubound(lat%branch, 1)) then + call out_io (s_error$, r_name, 'BRANCH INDEX OUT OF RANGE: /i0/ ', i_array = [ix]) + return +endif + +branch => lat%branch(ix) + +if (out_type == 'MAD-X') then + comment_char = '//' + continue_char = '' + eol_char = ';' + separator_char = ',' + ix_line_max = 100 + +elseif (out_type == 'MAD-8') then + comment_char = '!' + continue_char = ' &' + eol_char = '' + separator_char = ',' + ix_line_max = 80 + +else + call out_io (s_error$, r_name, 'BAD OUT_TYPE: ' // out_type) + return +endif + +ix_line_min = ix_line_max - 20 + +call init_ele (col_ele) +call init_ele (drift_ele, drift$) +call init_ele (taylor_ele, taylor$) +call init_ele (ab_ele, ab_multipole$) +call init_ele (kicker_ele, kicker$) +call init_ele (quad_ele, quadrupole$) +call init_ele (bend_ele, sbend$) +call multipole_init (ab_ele, magnetic$) +null_ele%key = null_ele$ + +allocate (names(branch%n_ele_max+10), an_indexx(branch%n_ele_max+10)) ! list of element names + +call out_io (s_info$, r_name, & + 'Note: In general, Bmad lattice elements can have attributes that cannot be translated. ', & + ' For example, higher order terms in a Taylor element.', & + ' Please use caution when using a translated lattice.') + + +! open file + +if (present(err)) err = .true. +n_taylor_order_saved = ptc_private%taylor_order_ptc + +iu = lunget() +call fullfilename (out_file_name, line) +open (iu, file = line, iostat = ios) +if (ios /= 0) then + call out_io (s_error$, r_name, 'CANNOT OPEN FILE: ' // trim(out_file_name)) + return +endif + +!----------------------------------------------------------------------------- +! Translation is a two step process: +! 1) Create a new lattice called lat_out making substitutions for sol_quad and wiggler elements, etc.. +! 2) Use lat_out to create the lattice file. + +lat_out = lat +call allocate_lat_ele_array(lat_out, 2*branch%n_ele_max, branch%ix_branch) +branch_out => lat_out%branch(branch%ix_branch) + +if (present(ref_orbit)) then + call reallocate_coord(orbit_out, size(ref_orbit)) + orbit_out = ref_orbit +else + call reallocate_coord(orbit_out, branch%n_ele_max) +endif + +f_count = 0 ! fringe around bends and quads. Also drift nonlinearities. +j_count = 0 ! drift around solenoid or sol_quad index. Also z shift count. +a_count = 0 ! Aperture count +i_unique = 1000 + +! Loop over all input elements + +nullify(first_sol_edge) +n_name_change_warn = 0 +n_elsep_warn = 0 +ix_ele = 0 + +do + ix_ele = ix_ele + 1 + if (ix_ele > branch_out%n_ele_track) exit + ele => branch_out%ele(ix_ele) + if (ele%key == -1) cycle ! Has been marked for delection + + val => ele%value + + ! If there is an aperture with an element that is not an ecoll or rcoll then need to make a separate + ! element with the aperture info. Exception: MAD-X can handle apertures on non-collimator elements. + + if ((val(x1_limit$) /= 0 .or. val(x2_limit$) /= 0 .or. val(y1_limit$) /= 0 .or. val(y2_limit$) /= 0) .and. & + ele%key /= ecollimator$ .and. ele%key /= rcollimator$ .and. logic_option(.true., include_apertures) .and. & + (ele%key == drift$ .or. out_type /= 'MAD-X')) then + + if (val(x1_limit$) /= val(x2_limit$)) then + call out_io (s_warn$, r_name, 'Asymmetric x_limits cannot be converted for: ' // ele%name, & + 'Will use largest limit here.') + val(x1_limit$) = max(val(x1_limit$), val(x2_limit$)) + endif + + if (val(y1_limit$) /= val(y2_limit$)) then + call out_io (s_warn$, r_name, 'Asymmetric y_limits cannot be converted for: ' // ele%name, & + 'Will use largest limit here.') + val(y1_limit$) = max(val(y1_limit$), val(y2_limit$)) + endif + + ! create ecoll and rcoll elements. + + if (ele%aperture_type == rectangular$) then + col_ele%key = rcollimator$ + else + col_ele%key = ecollimator$ + endif + a_count = a_count + 1 + write (col_ele%name, '(a, i0)') 'COLLIMATOR_N', a_count + col_ele%value = val + col_ele%value(l$) = 0 + val(x1_limit$) = 0; val(x2_limit$) = 0; val(y1_limit$) = 0; val(y2_limit$) = 0; + aperture_at = ele%aperture_at ! Save since ele pointer will be invalid after the insert + if (aperture_at == both_ends$ .or. aperture_at == downstream_end$ .or. aperture_at == continuous$) then + call insert_element (lat_out, col_ele, ix_ele+1, branch_out%ix_branch, orbit_out) + endif + if (aperture_at == both_ends$ .or. aperture_at == upstream_end$ .or. aperture_at == continuous$) then + call insert_element (lat_out, col_ele, ix_ele, branch_out%ix_branch, orbit_out) + endif + ix_ele = ix_ele - 1 ! Want to process the element again on the next loop. + + cycle ! cycle since ele pointer is invalid + + endif + + ! If the bend has a roll then put kicker elements just before and just after + + if (ele%key == sbend$ .and. val(roll$) /= 0) then + j_count = j_count + 1 + write (kicker_ele%name, '(a, i0)') 'ROLL_Z', j_count + kicker_ele%value(hkick$) = val(angle$) * (1 - cos(val(roll$))) / 2 + kicker_ele%value(vkick$) = -val(angle$) * sin(val(roll$)) / 2 + val(roll$) = 0 ! So on next iteration will not create extra kickers. + call insert_element (lat_out, kicker_ele, ix_ele, branch_out%ix_branch, orbit_out) + call insert_element (lat_out, kicker_ele, ix_ele+2, branch_out%ix_branch, orbit_out) + cycle + endif + + ! If there is a multipole component then put multipole elements at half strength + ! just before and just after the element. + + if (ele%key /= multipole$ .and. ele%key /= ab_multipole$ .and. ele%key /= null_ele$ .and. ele%key /= sad_mult$) then + call multipole_ele_to_ab (ele, .true., ix_pole_max, ab_ele%a_pole, ab_ele%b_pole) + if (ix_pole_max > -1) then + ab_ele%a_pole = ab_ele%a_pole / 2 + ab_ele%b_pole = ab_ele%b_pole / 2 + if (associated(ele%a_pole)) then + deallocate (ele%a_pole, ele%b_pole) + call attribute_bookkeeper(ele, .true.) + endif + j_count = j_count + 1 + write (ab_ele%name, '(a1, a, i0)') key_name(ele%key), 'MULTIPOLE_', j_count + call insert_element (lat_out, ab_ele, ix_ele, branch_out%ix_branch, orbit_out) + call insert_element (lat_out, ab_ele, ix_ele+2, branch_out%ix_branch, orbit_out) + cycle + endif + endif + + ! If there are nonzero kick values and this is not a kick type element then put + ! kicker elements at half strength just before and just after the element. + ! Also add a matrix element to get the change in z correct. + ! A sad_mult gets translated to a matrix element which has kick components so no extra kickers needed here. + ! Exception: MAD-X sbend has K0 and K0S attributes. + + if (has_hkick_attributes(ele%key) .and. .not. (ele%key == sbend$ .and. out_type == 'MAD-X')) then + if (ele%key /= kicker$ .and. ele%key /= hkicker$ .and. ele%key /= vkicker$ .and. ele%key /= sad_mult$) then + if (val(hkick$) /= 0 .or. val(vkick$) /= 0) then + j_count = j_count + 1 + write (kicker_ele%name, '(a1, a, i0)') key_name(ele%key), '_KICKER_', j_count + kicker_ele%value(hkick$) = val(hkick$) / 2 + kicker_ele%value(vkick$) = val(vkick$) / 2 + val(hkick$) = 0; val(vkick$) = 0 + if (ele%key == sbend$) then + f = val(dg$) * val(l$) / 2 + kicker_ele%value(hkick$) = kicker_ele%value(hkick$) - cos(ele%value(ref_tilt_tot$)) * f + kicker_ele%value(vkick$) = kicker_ele%value(vkick$) - sin(ele%value(ref_tilt_tot$)) * f + val(dg$) = 0 + endif + !!! write (taylor_ele%name, '(a, i0)') 'Z_SHIFTER', j_count + taylor_ele%name = ele%name + call taylor_make_unit(taylor_ele%taylor) + orb_start = orbit_out(ix_ele-1) + orb_start%vec(2) = orb_start%vec(2) - kicker_ele%value(hkick$) + orb_start%vec(4) = orb_start%vec(4) - kicker_ele%value(vkick$) + call track1 (orb_start, ele, branch_out%param, orb_end) + ele%key = -1 ! Mark to ignore + f = (ele%map_ref_orb_out%vec(5) - ele%map_ref_orb_in%vec(5)) - (orb_end%vec(5) - orb_start%vec(5)) + call add_taylor_term (taylor_ele%taylor(5), f, [0, 0, 0, 0, 0, 0]) + call insert_element (lat_out, kicker_ele, ix_ele+1, branch_out%ix_branch, orbit_out) + call insert_element (lat_out, taylor_ele, ix_ele+2, branch_out%ix_branch, orbit_out) + call insert_element (lat_out, kicker_ele, ix_ele+3, branch_out%ix_branch, orbit_out) + cycle + endif + endif + endif + + ! A quadrupole with fringe = full or soft_edge_only has its fringe kicks modeled as a 2nd order map. + + iv = nint(ele%value(fringe_type$)) + if (ele%key == quadrupole$ .and. (iv == full$ .or. iv == soft_edge_only$)) then + quad_ele = ele + ele%value(fringe_type$) = none$ + + if (ptc_private%taylor_order_ptc /= 2) call set_ptc (taylor_order = 2) + + f_count = f_count + 1 + ie = ix_ele + + ifa = nint(ele%value(fringe_at$)) + if (ifa == entrance_end$ .or. ifa == both_ends$) then + quad_ele%value(fringe_at$) = entrance_end$ + quad_ele%value(l$) = 1d-30 + call ele_to_taylor (quad_ele, branch_out%param, orbit_out(ie-1), orbital_taylor = taylor_ele%taylor) + write (taylor_ele%name, '(a, i0)') 'Q_FRINGE_IN', f_count + call insert_element (lat_out, taylor_ele, ie, branch_out%ix_branch, orbit_out) + ie = ie + 1 + endif + + if (ifa == exit_end$ .or. ifa == both_ends$) then + quad_ele%value(fringe_at$) = exit_end$ + quad_ele%value(l$) = 1d-30 + call ele_to_taylor (quad_ele, branch_out%param, orbit_out(ie), orbital_taylor = taylor_ele%taylor) + write (taylor_ele%name, '(a, i0)') 'Q_FRINGE_OUT', f_count + call insert_element (lat_out, taylor_ele, ie+1, branch_out%ix_branch, orbit_out) + endif + + cycle + endif + + ! A bend with fringe = sad_full or has non-zero dg has its fringe kicks modeled as a 1st order map. + + iv = nint(ele%value(fringe_type$)) + if (ele%key == sbend$ .and. ((iv == sad_full$) .or. (out_type == 'MAD-8' .and. ele%value(dg$) /= 0))) then + + if (ptc_private%taylor_order_ptc /= 1) call set_ptc (taylor_order = 1) + + f_count = f_count + 1 + ie = ix_ele + + bend_ele = ele + bend_ele%value(l$) = ele%value(l$)/2 + bend_ele%value(angle$) = ele%value(angle$)/2 + bend_ele%value(e2$) = 0 + call set_fringe_on_off (bend_ele%value(fringe_at$), exit_end$, off$) + call track1 (orbit_out(ie-1), bend_ele, branch_out%param, orb_center) + + if (at_this_ele_end(entrance_end$, nint(ele%value(fringe_at$))) .or. ele%value(dg$) /= 0) then + call ele_to_taylor (bend_ele, branch_out%param, orbit_out(ie-1), orbital_taylor = taylor_a) + + bend_ele%value(fringe_type$) = basic_bend$ + bend_ele%value(dg$) = 0 + orb_start = orb_center + orb_start%direction = -1 + orb_start%species = antiparticle(orb_center%species) + call track1 (orb_start, bend_ele, branch_out%param, orb_start) ! bactrack to entrance end + call ele_to_taylor (bend_ele, branch_out%param, orb_start, orbital_taylor = taylor_b) + + call taylor_inverse (taylor_b, taylor_b) + call concat_taylor (taylor_a, taylor_b, taylor_ele%taylor) + write (taylor_ele%name, '(a, i0)') 'B_FRINGE_IN', f_count + call insert_element (lat_out, taylor_ele, ie, branch_out%ix_branch, orbit_out) + ele => branch_out%ele(ix_ele+1) + call kill_taylor (taylor_a) + call kill_taylor (taylor_b) + ie = ie + 1 + endif + + if (at_this_ele_end(exit_end$, nint(ele%value(fringe_at$))) .or. ele%value(dg$) /= 0) then + bend_ele = ele + bend_ele%value(l$) = ele%value(l$)/2 + bend_ele%value(angle$) = ele%value(angle$)/2 + bend_ele%value(e1$) = 0 + call set_fringe_on_off (bend_ele%value(fringe_at$), entrance_end$, off$) + + call ele_to_taylor (bend_ele, branch_out%param, orb_center, orbital_taylor = taylor_a) + + bend_ele%value(fringe_type$) = basic_bend$ + bend_ele%value(dg$) = 0 + call ele_to_taylor (bend_ele, branch_out%param, orb_center, orbital_taylor = taylor_b) + call taylor_inverse (taylor_b, taylor_b) + + call concat_taylor (taylor_b, taylor_a, taylor_ele%taylor) + write (taylor_ele%name, '(a, i0)') 'B_FRINGE_OUT', f_count + call insert_element (lat_out, taylor_ele, ie+1, branch_out%ix_branch, orbit_out) + call kill_taylor (taylor_a) + call kill_taylor (taylor_b) + endif + + ele%value(fringe_type$) = basic_bend$ + ele%value(dg$) = 0 + cycle + endif + + ! A drift where the ref orbit is too large needs an added 1st order matrix element + + f = ele%value(l$) / (1 + orbit_out(ele%ix_ele)%vec(6)) + if (ele%key == drift$ .and. ele%name(1:7) /= 'DRIFT_Z' .and. abs(ele%mat6(1,2) - f) > dr12_max) then + if (ptc_private%taylor_order_ptc /= 1) call set_ptc (taylor_order = 1) + + drift_ele = ele + drift_ele%value(l$) = -ele%value(l$) + call make_mat6_mad (drift_ele, branch_out%param, orbit_out(ix_ele), orb_end) + call mat6_to_taylor (drift_ele%vec0, drift_ele%mat6, taylor_a) + + drift_ele%value(l$) = ele%value(l$) + call ele_to_taylor (drift_ele, branch_out%param, orbit_out(ix_ele-1), orbital_taylor = taylor_b) + call concat_taylor (taylor_a, taylor_b, taylor_ele%taylor) + call kill_taylor (taylor_a) + call kill_taylor (taylor_b) + + taylor_ele%name = 'TAYLOR_' // ele%name + call insert_element (lat_out, taylor_ele, ix_ele+1, branch_out%ix_branch, orbit_out) + ix_ele = ix_ele + 1 + cycle + endif + + ! Convert sol_quad_and wiggler elements to an "equivalent" set of elements. + ! NOTE: FOR NOW, SOL_QUAD USES DRIFT-MATRIX-DRIFT MODEL! + + if (ele%key == wiggler$ .or. ele%key == undulator$ .or. ele%key == sol_quad$) then + if (logic_option(.false., use_matrix_model) .or. ele%key == sol_quad$) then + call out_io (s_warn$, r_name, 'Converting element to drift-matrix-drift model: ' // ele%name) + drift_ele%value = ele%value + drift_ele%value(l$) = -val(l$) / 2 + call make_mat6 (drift_ele, branch_out%param) + taylor_ele%mat6 = matmul(matmul(drift_ele%mat6, ele%mat6), drift_ele%mat6) + call mat6_to_taylor (taylor_ele%vec0, taylor_ele%mat6, taylor_ele%taylor) + + ! Add drifts before and after wigglers and sol_quads so total length is invariant + j_count = j_count + 1 + write (drift_ele%name, '(a, i0)') 'DRIFT_Z', j_count + taylor_ele%name = ele%name + drift_ele%value(l$) = val(l$) / 2 + ele%key = -1 ! Mark to ignore + call insert_element (lat_out, drift_ele, ix_ele+1, branch_out%ix_branch, orbit_out) + call insert_element (lat_out, taylor_ele, ix_ele+2, branch_out%ix_branch, orbit_out) + call insert_element (lat_out, drift_ele, ix_ele+3, branch_out%ix_branch, orbit_out) + cycle + + ! Non matrix model... + ! If the wiggler has been sliced due to superposition, throw + ! out the markers that caused the slicing. + + else + if (ele%key == wiggler$ .or. ele%key == undulator$) then ! Not a sol_quad + if (ele%slave_status == super_slave$) then + ! Create the wiggler model using the super_lord + lord => pointer_to_lord(ele, 1) + print_err = (n_wig_model_err <= print_wig_model_err_max) + !!! if (print_err) call out_io (s_warn$, r_name, 'Converting element to drift-bend-drift model: ' // lord%name) + call create_planar_wiggler_model (lord, lat_model, err_flag, print_err = print_err) + if (err_flag) n_wig_model_err = n_wig_model_err + 1 + if (n_wig_model_err == print_wig_model_err_max + 1) call out_io (s_warn$, r_name, & + 'Max number of wiggler error messages generated. Will not generate any more!') + ! Remove all the slave elements and markers in between. + call out_io (s_warn$, r_name, & + 'Note: Not translating to MAD the markers within wiggler: ' // lord%name) + call find_element_ends (lord, ele1, ele2) + ix1 = ele1%ix_ele; ix2 = ele2%ix_ele + lord%key = -1 ! mark for deletion + ! If the wiggler wraps around the origin we are in trouble. + if (ix2 < ix1) then + call out_io (s_fatal$, r_name, 'Wiggler wraps around origin. Cannot translate this!') + if (global_com%exit_on_error) call err_exit + endif + do i = ix1+1, ix2 + branch_out%ele(i)%key = -1 ! mark for deletion + enddo + ix_ele = ix_ele + (ix2 - ix1 - 1) + else + print_err = (n_wig_model_err <= print_wig_model_err_max) + !!! if (print_err) call out_io (s_warn$, r_name, 'Converting element to drift-bend-drift model: ' // ele%name) + call create_planar_wiggler_model (ele, lat_model, err_flag, print_err = print_err) + if (err_flag) n_wig_model_err = n_wig_model_err + 1 + if (n_wig_model_err == print_wig_model_err_max + 1) call out_io (s_warn$, r_name, & + 'Max number of wiggler error messages generated. Will not generate any more!') + ele%key = -1 ! Mark to ignore + endif + + else ! sol_quad + call create_sol_quad_model (ele, lat_model) ! NOT YET IMPLEMENTED! + ele%key = -1 ! Mark to ignore + endif + + do j = 1, lat_model%n_ele_track + call insert_element (lat_out, lat_model%ele(j), ix_ele+j, branch_out%ix_branch, orbit_out) + enddo + + cycle + endif + endif + +enddo + +! For a patch that is *not* associated with the edge of a solenoid: A z_offset must be split into a drift + patch + +ix_ele = 0 + +do + ix_ele = ix_ele + 1 + if (ix_ele > branch_out%n_ele_track) exit + ele => branch_out%ele(ix_ele) + if (ele%key == -1) cycle + + ! If the name has more than 16 characters then replace the name by something shorter and unique. + + orig_name = ele%name + + if (len_trim(ele%name) > 16) then + i_unique = i_unique + 1 + write (ele%name, '(a, i0)') ele%name(1:11), i_unique + endif + + ! Replace element name containing "/" or "#" with "_" + + do + j = max(index(ele%name, '\'), index(ele%name, '#')) ! ' + if (j == 0) exit + ele%name(j:j) = '_' + enddo + + if (ele%name /= orig_name .and. n_name_change_warn <= n_warn_max) then + call out_io (s_info$, r_name, 'Element name changed from: ' // trim(orig_name) // ' to: ' // ele%name) + if (n_name_change_warn == n_warn_max) call out_io (s_info$, r_name, & + 'Enough name change warnings. Will stop issuing them now.') + n_name_change_warn = n_name_change_warn + 1 + endif + + ! + + val => ele%value + + if (ele%key == patch$ .and. ele%value(z_offset$) /= 0) then + drift_ele%name = 'DRIFT_' // ele%name + drift_ele%value(l$) = val(z_offset$) + call insert_element (lat_out, drift_ele, ix_ele, branch_out%ix_branch, orbit_out) + ix_ele = ix_ele + 1 + ele => branch_out%ele(ix_ele) + val => ele%value + val(z_offset$) = 0 + endif +enddo + +!------------------------------------------------------------------------------------------------- +! Now write info to the output file... +! lat lattice name + +write (iu, '(3a)') comment_char, ' File generated by: write_lattice_in_mad_format', trim(eol_char) +write (iu, '(4a)') comment_char, ' Bmad Lattice File: ', trim(lat%input_file_name), trim(eol_char) +if (lat%lattice /= '') write (iu, '(4a)') comment_char, ' Bmad Lattice: ', trim(lat%lattice), trim(eol_char) +write (iu, '(a)') + +! beam definition + +select case (out_type) +case ('MAD-8', 'MAD-X') + ele => branch_out%ele(0) + + write (line_out, '(7a)') 'beam_def: Beam, Particle = ', trim(species_name(branch_out%param%particle)), & + ', Energy = ', re_str(1d-9*ele%value(E_TOT$)), ', Npart = ', re_str(branch_out%param%n_part), trim(eol_char) + call write_line (line_out) + write (iu, '(a)') +end select + +! write element parameters + +n_names = 0 ! number of names stored in the list +ix_ele = 0 + +do + ix_ele = ix_ele + 1 + if (ix_ele > branch_out%n_ele_track) exit + ele => branch_out%ele(ix_ele) + if (ele%key == -1) cycle + + val => ele%value + + ! Do not make duplicate specs + + call find_index (ele%name, names, an_indexx, n_names, ix_match) + if (ix_match > 0) cycle + + ! Add to the list of elements + + if (size(names) < n_names + 10) then + call re_allocate(names, 2*size(names)) + call re_allocate(an_indexx, 2*size(names)) + endif + + call find_index (ele%name, names, an_indexx, n_names, ix_match, add_to_list = .true.) + + !------------------- + + select case (ele%key) + + ! drift MAD + + case (drift$, instrument$, pipe$, detector$, monitor$) + + write (line_out, '(2a)') trim(ele%name) // ': drift, l = ', re_str(val(l$)) + + ! beambeam MAD + + case (beambeam$) + + line_out = trim(ele%name) // ': beambeam' + call value_to_line (line_out, val(sig_x$), 'sigx', 'R') + call value_to_line (line_out, val(sig_y$), 'sigy', 'R') + call value_to_line (line_out, val(x_offset$), 'xma', 'R') + call value_to_line (line_out, val(y_offset$), 'yma', 'R') + call value_to_line (line_out, val(charge$), 'charge', 'R') + + + ! r/ecollimator MAD + + case (ecollimator$, rcollimator$) + + if (out_type == 'MAD-X') then + write (line_out, '(2a)') trim(ele%name) // ': collimator, l = ', re_str(val(l$)) + else + write (line_out, '(2a)') trim(ele%name) // ': ' // trim(key_name(ele%key)) // ', l = ', re_str(val(l$)) + call value_to_line (line_out, val(x1_limit$), 'xsize', 'R') + call value_to_line (line_out, val(y1_limit$), 'ysize', 'R') + endif + + ! elseparator MAD + + case (elseparator$) + + write (line_out, '(2a)') trim(ele%name) // ': elseparator, l = ', re_str(val(l$)) + hk = val(hkick$) + vk = val(vkick$) + + if (hk /= 0 .or. vk /= 0) then + + ix = len_trim(line_out) + 1 + field = 1.0d3 * sqrt(hk**2 + vk**2) * val(E_TOT$) / val(l$) + if (out_type == 'MAD-X') then + write (line_out(ix:), '(2a)') ', ey = ', re_str(field) + else + write (line_out(ix:), '(2a)') ', e = ',re_str(field) + endif + + if (branch_out%param%particle == positron$) then + tilt = -atan2(hk, vk) + val(tilt$) + else + tilt = -atan2(hk, vk) + val(tilt$) + pi + endif + ix = len_trim(line_out) + 1 + write (line_out(ix:), '(2a)') ', tilt = ', re_str(tilt) + + endif + + ! hkicker MAD + + case (hkicker$) + + write (line_out, '(2a)') trim(ele%name) // ': hkicker, l = ', re_str(val(l$)) + + call value_to_line (line_out, val(kick$), 'kick', 'R') + call value_to_line (line_out, val(tilt$), 'tilt', 'R') + + ! kicker MAD + + case (kicker$) + + write (line_out, '(2a)') trim(ele%name) // ': kicker, l = ', re_str(val(l$)) + + call value_to_line (line_out, val(hkick$), 'hkick', 'R') + call value_to_line (line_out, val(vkick$), 'vkick', 'R') + call value_to_line (line_out, val(tilt$), 'tilt', 'R') + + ! vkicker MAD + + case (vkicker$) + + write (line_out, '(2a)') trim(ele%name) // ': vkicker, l = ', re_str(val(l$)) + + call value_to_line (line_out, val(kick$), 'kick', 'R') + call value_to_line (line_out, val(tilt$), 'tilt', 'R') + + ! marker MAD + + case (marker$, fork$, photon_fork$) + + line_out = trim(ele%name) // ': marker' + + ! octupole MAD + + case (octupole$) + + write (line_out, '(2a)') trim(ele%name) // ': octupole, l = ', re_str(val(l$)) + + call value_to_line (line_out, val(k3$), 'k3', 'R') + call value_to_line (line_out, val(tilt$), 'tilt', 'R') + + ! quadrupole MAD + + case (quadrupole$) + + write (line_out, '(2a)') trim(ele%name) // ': quadrupole, l = ', re_str(val(l$)) + call value_to_line (line_out, val(k1$), 'k1', 'R') + call value_to_line (line_out, val(tilt$), 'tilt', 'R') + + ! sbend MAD + + case (sbend$) + + write (line_out, '(2a)') trim(ele%name) // ': sbend, l = ', re_str(val(l$)) + + call value_to_line (line_out, val(angle$), 'angle', 'R') + call value_to_line (line_out, val(e1$), 'e1', 'R') + call value_to_line (line_out, val(e2$), 'e2', 'R') + call value_to_line (line_out, val(k1$), 'k1', 'R') + call value_to_line (line_out, val(ref_tilt$), 'tilt', 'R') + if (out_type == 'MAD-X') then + call value_to_line (line_out, val(fint$), 'fint', 'R') + call value_to_line (line_out, val(fintx$), 'fintx', 'R') + call value_to_line (line_out, val(hgap$), 'hgap', 'R') + else + if (val(fintx$) /= val(fint$)) then + call out_io (s_info$, r_name, 'FINTX != FINT FOR BEND' // ele%name, 'CANNOT TRANSLATE FINTX') + endif + call value_to_line (line_out, val(fint$), 'fint', 'R') + call value_to_line (line_out, val(hgap$), 'hgap', 'R') + endif + + ! MAD-X sbend kick fields. MAD-8 conversion uses matrix elements to either side (see above). + + if (out_type == 'MAD-X' .and. ele%value(l$) /= 0) then + call multipole_ele_to_ab (ele, .false., ix, a_pole, b_pole, magnetic$, include_kicks$) + call value_to_line (line_out, val(dg$) + b_pole(0)/val(l$), 'k0', 'R') + call value_to_line (line_out, a_pole(0)/val(l$), 'k0s', 'R') + endif + + ! sextupole MAD + + case (sextupole$) + + write (line_out, '(2a)') trim(ele%name) // ': sextupole, l = ', re_str(val(l$)) + call value_to_line (line_out, val(k2$), 'k2', 'R') + call value_to_line (line_out, val(tilt$), 'tilt', 'R') + + ! taylor MAD + + case (taylor$, sad_mult$, patch$, match$) + + if (ele%key == patch$ .and. out_type == 'MAD-X') then + ele%key = null_ele$ + orig_name = ele%name + if (val(x_offset$) /= 0 .or. val(y_offset$) /= 0 .or. val(z_offset$) /= 0) then + drift_ele%name = trim(orig_name) // '__t' + call insert_element(lat_out, drift_ele, ix_ele+1, branch_out%ix_branch, orbit_out) + ix_ele = ix_ele + 1 + line_out = trim(drift_ele%name) // ': translation' + call value_to_line (line_out, val(x_offset$), 'dx', 'R') + call value_to_line (line_out, val(y_offset$), 'dy', 'R') + call value_to_line (line_out, val(z_offset$), 'ds', 'R') + call write_line(line_out) + endif + + if (val(x_pitch$) /= 0) then + drift_ele%name = trim(orig_name) // '__y' + call insert_element(lat_out, drift_ele, ix_ele+1, branch_out%ix_branch, orbit_out) + ix_ele = ix_ele + 1 + call write_line(trim(drift_ele%name) // ': yrotation, angle = ' // re_str(-val(x_pitch$))) + endif + + if (val(y_pitch$) /= 0) then + drift_ele%name = trim(orig_name) // '__x' + call insert_element(lat_out, drift_ele, ix_ele+1, branch_out%ix_branch, orbit_out) + ix_ele = ix_ele + 1 + call write_line(trim(drift_ele%name) // ': xrotation, angle = ' // re_str(-val(y_pitch$))) + endif + + if (val(tilt$) /= 0) then + drift_ele%name = trim(orig_name) // '__s' + call insert_element(lat_out, drift_ele, ix_ele+1, branch_out%ix_branch, orbit_out) + ix_ele = ix_ele + 1 + call write_line(trim(drift_ele%name) // ': srotation, angle = ' // re_str(val(tilt$))) + endif + + cycle + endif + + if (associated (ele%taylor(1)%term)) then + taylor_ptr => ele%taylor + elseif (ele%key == match$) then + allocate(taylor_ptr(6)) + call ele_to_taylor (ele, branch%param, orbital_taylor = taylor_ptr) + else + allocate(taylor_ptr(6)) + if (.not. present(ref_orbit)) then + call out_io (s_error$, r_name, & + 'ORBIT ARGUMENT NEEDS TO BE PRESENT WHEN TRANSLATING', & + 'A LATTICE WITH A SAD_MULT OR PATCH ELEMENT') + cycle + endif + if (ptc_private%taylor_order_ptc /= 2) call set_ptc (taylor_order = 2) + call ele_to_taylor (ele, branch%param, orbit_out(ix_ele-1), .true., orbital_taylor = taylor_ptr) + endif + + line_out = trim(ele%name) // ': matrix' + warn_printed = .false. + call value_to_line (line_out, val(l$), 'l', 'R') + + do i = 1, 6 + do k = 1, size(taylor_ptr(i)%term) + term = taylor_ptr(i)%term(k) + + select case (sum(term%expn)) + case (0) + select case (out_type) + case ('MAD-8') + write (str, '(a, i0, a)') 'kick(', i, ')' + case ('MAD-X') + write (str, '(a, i0)') 'kick', i + end select + call value_to_line (line_out, term%coef, str, 'R') + + case (1) + j = maxloc(term%expn, 1) + select case (out_type) + case ('MAD-8') + write (str, '(a, i0, a, i0, a)') 'rm(', i, ',', j, ')' + case ('MAD-X') + write (str, '(a, 2i0)') 'rm', i, j + end select + + if (j == i) then + call value_to_line (line_out, term%coef, str, 'R', .false.) + else + call value_to_line (line_out, term%coef, str, 'R') + endif + + case (2) + j = maxloc(term%expn, 1) + term%expn(j) = term%expn(j) - 1 + j2 = maxloc(term%expn, 1) + select case (out_type) + case ('MAD-8') + write (str, '(a, 3(i0, a))') 'tm(', i, ',', j, ',', j2, ')' + case ('MAD-X') + write (str, '(a, 3i0)') 'tm', i, j, j2 + end select + call value_to_line (line_out, term%coef, str, 'R') + + case default + if (.not. warn_printed .and. ele%key == taylor$) then + call out_io (s_warn$, r_name, & + 'Higher order taylor term(s) in: ' // trim(ele%name) // & + ' cannot be converted to mad matrix term') + warn_printed = .true. + endif + end select + enddo + + enddo + + if (.not. associated(ele%taylor(1)%term)) deallocate(taylor_ptr) + + ! rfcavity MAD + + case (rfcavity$) + + write (line_out, '(2a)') trim(ele%name) // ': rfcavity, l = ', re_str(val(l$)) + call value_to_line (line_out, val(voltage$)/1E6, 'volt', 'R') + call value_to_line (line_out, val(phi0$)+val(phi0_multipass$)+0.5, 'lag', 'R') + call value_to_line (line_out, val(harmon$), 'harmon', 'I') + + ! lcavity MAD + + case (lcavity$) + + write (line_out, '(2a)') trim(ele%name) // ': lcavity, l = ', re_str(val(l$)) + call value_to_line (line_out, val(gradient$)*val(l$)/1d6, 'deltae', 'R') + call value_to_line (line_out, val(rf_frequency$)/1d6, 'freq', 'R') + call value_to_line (line_out, val(phi0$)+val(phi0_multipass$), 'phi0', 'R') + if (out_type == 'MAD-8' .and. nint(ele%value(cavity_type$)) == standing_wave$) then + line_out = trim(line_out) // ', swave' + endif + + + ! solenoid MAD + + case (solenoid$) + + write (line_out, '(2a)') trim(ele%name) // ': solenoid, l = ', re_str(val(l$)) + call value_to_line (line_out, val(ks$), 'ks', 'R') + + ! multipole MAD + + case (multipole$, ab_multipole$) + + knl = 0; tilts = 0 + call multipole_ele_to_kt (ele, .true., ix_pole_max, knl, tilts) + write (line_out, '(2a)') trim(ele%name) // ': multipole' + + if (out_type == 'MAD-X') then + knl_str = ''; ksl_str = '' + call multipole_ele_to_ab (ele, .true., ix_pole_max, a_pole, b_pole) + do i = 0, 9 + if (all(knl(i:) == 0)) exit + if (abs(a_pole(i)) < 1d-12 * abs(b_pole(i))) a_pole(i) = 0 ! Round to zero insignificant value + if (abs(b_pole(i)) < 1d-12 * abs(a_pole(i))) b_pole(i) = 0 ! Round to zero insignificant value + call value_to_line (knl_str, b_pole(i) * factorial(i), '', 'R', .false.) + call value_to_line (ksl_str, -a_pole(i) * factorial(i), '', 'R', .false.) + enddo + if (any(b_pole /= 0)) line_out = trim(line_out) // ', knl = {' // trim(knl_str(3:)) // '}' + if (any(a_pole /= 0)) line_out = trim(line_out) // ', ksl = {' // trim(ksl_str(3:)) // '}' + + else + do i = 0, 9 + write (str, '(a, i0, a)') 'K', i, 'L' + call value_to_line (line_out, knl(i), str, 'R') + write (str, '(a, i0)') 'T', i + call value_to_line (line_out, tilts(i), str, 'R') + enddo + endif + + ! unknown MAD + + case default + + call out_io (s_error$, r_name, 'I DO NOT KNOW HOW TO TRANSLATE ELEMENT: ' // ele%name, & + 'WHICH IS OF TYPE: ' // key_name(ele%key), & + 'CONVERTING TO DRIFT') + line_out = trim(ele%name) // ': drift, l = ' // re_str(val(l$)) + + end select + + ! Add apertures for mad-x. Use 1 meter for unset apertures + + if (out_type == 'MAD-X' .and. logic_option(.true., include_apertures)) then + if (val(x1_limit$) /= 0 .or. val(y1_limit$) /= 0) then + limit = [val(x1_limit$), val(y1_limit$)] + where (limit == 0) limit = 1 + if (ele%aperture_type == rectangular$) then + line_out = trim(line_out) // ', apertype = rectangle' + else + line_out = trim(line_out) // ', apertype = ellipse' + endif + write (line_out, '(6a)') trim(line_out), ', aperture = {', re_str(limit(1)), ', ', re_str(limit(2)), '}' + endif + endif + + ! write element spec to file + + call write_line(line_out) + +enddo + +!--------------------------------------------------------------------------------------- +! Write the lattice line +! MAD has a limit of 4000 characters so we may need to break the lat into pieces. + +i_unique = 1000 +i_line = 0 +init_needed = .true. +line = ' ' + +do n = 1, branch_out%n_ele_track + ele => branch_out%ele(n) + if (ele%key == null_ele$) cycle ! Will happen with patch elements translated to MAD-X + if (ele%key == -1) cycle + + if (init_needed) then + write (iu, '(a)') + write (iu, '(3a)') comment_char, '---------------------------------', trim(eol_char) + write (iu, '(a)') + i_line = i_line + 1 + write (line_out, '(a, i0, 2a)') 'line_', i_line, ': line = (', ele%name + iout = 0 + init_needed = .false. + + else + ix = len_trim(line_out) + len_trim(ele%name) + + if (ix > 75) then + write (iu, '(3a)') trim(line_out), trim(separator_char), trim(continue_char) + iout = iout + 1 + line_out = ' ' // ele%name + else + line_out = trim(line_out) // trim(separator_char) // ' ' // ele%name + endif + endif + + ! Output line if long enough or at end + + if (n == branch_out%n_ele_track .or. iout > 48) then + line_out = trim(line_out) // ')' + write (iu, '(2a)') trim(line_out), trim(eol_char) + line_out = ' ' + init_needed = .true. + endif + +enddo + +!------------------------------------------ +! Use statement + +write (iu, '(a)') +write (iu, '(3a)') comment_char, '---------------------------------', trim(eol_char) +write (iu, '(a)') + +line_out = 'lat: line = (line_1' + +do i = 2, i_line + write (line_out, '(3a, i0)') trim(line_out), trim(separator_char), ' line_', i +enddo + +line_out = trim(line_out) // ')' +call write_line (line_out) + +if (out_type == 'MAD-X') then + write (iu, '(a)') 'use, period = lat;' +endif + +!--------------------------------------------------- +! Element offsets for MAD. +! This must come after use statement. + +if (out_type(1:3) == 'MAD') then + + write (iu, '(a)') + write (iu, '(3a)') comment_char, '---------------------------------', trim(eol_char) + write (iu, '(a)') + + allocate (n_repeat(n_names)) + n_repeat = 0 + + do ix_ele = 1, branch_out%n_ele_track + + ele => branch_out%ele(ix_ele) + val => ele%value + + ! sad_mult and patch elements are translated to a matrix which does not have offsets. + ! And marker like elements also do not have offsets + + if (ele%key == sad_mult$ .or. ele%key == patch$) cycle + if (ele%key == marker$ .or. ele%key == fork$ .or. ele%key == photon_fork$) cycle + + ! + + call find_index (ele%name, names, an_indexx, n_names, ix_match) + if (ix_match == 0) cycle ! Happens for translated to MADX patch elements. + n_repeat(ix_match) = n_repeat(ix_match) + 1 + + if (val(x_pitch$) == 0 .and. val(y_pitch$) == 0 .and. & + val(x_offset_tot$) == 0 .and. val(y_offset_tot$) == 0 .and. val(z_offset_tot$) == 0) cycle + + write (iu, '(3a)') 'select, flag = error, clear', trim(eol_char) + write (iu, '(3a, i0, 2a)') 'select, flag = error, range = ', trim(ele%name), & + '[', n_repeat(ix_match), ']', trim(eol_char) + + line_out = 'ealign' + call value_to_line (line_out, val(x_pitch$), 'dtheta', 'R') + call value_to_line (line_out, -val(y_pitch$), 'dphi', 'R') + call value_to_line (line_out, val(x_offset$) - val(x_pitch$) * val(l$) / 2, 'dx', 'R') + call value_to_line (line_out, val(y_offset$) - val(y_pitch$) * val(l$) / 2, 'dy', 'R') + call value_to_line (line_out, val(z_offset$), 'ds', 'R') + call write_line (line_out) + + enddo + + deallocate (n_repeat) + +endif + +! Write twiss parameters for a non-closed lattice. + +if (branch_out%param%geometry == open$ .and. (out_type == 'MAD-8' .or. out_type == 'MAD-X')) then + ele => branch_out%ele(0) + orb_start = lat%particle_start + beta = ele%value(p0c$) / ele%value(E_tot$) + write (iu, '(a)') + write (iu, '(3a)') comment_char, '---------------------------------', trim(eol_char) + write (iu, '(a)') + write (iu, '(12a)') 'initial: beta0, betx = ', re_str(ele%a%beta), ', bety = ', re_str(ele%b%beta), & + ', alfx = ', re_str(ele%a%alpha), ', alfy = ', re_str(ele%b%alpha), ', ', trim(continue_char) + write (iu, '(5x, 12a)') 'dx = ', re_str(ele%a%eta), ', dpx = ', re_str(ele%a%etap), & + ', dy = ', re_str(ele%b%eta), ', dpy = ', re_str(ele%b%etap), ', ', trim(continue_char) + write (iu, '(5x, 12a)') 'x = ', re_str(orb_start%vec(1)), ', px = ', re_str(orb_start%vec(2)), & + ', y = ', re_str(orb_start%vec(3)), ', py = ', re_str(orb_start%vec(4)), & + ', t = ', re_str(orb_start%vec(5)*beta), ', pt = ', re_str(orb_start%vec(6)/beta), trim(eol_char) + + + + if (ele%a%beta /= 0 .and. ele%b%beta /= 0) then + write (iu, '(a)') 'twiss, beta0 = initial;' + endif +endif + +! End stuff + +call out_io (s_info$, r_name, 'Written ' // trim(out_type) // ' lattice file: ' // trim(out_file_name)) + +deallocate (names) +if (present(err)) err = .false. + +if (present(converted_lat)) then + converted_lat = lat + converted_lat%branch(branch%ix_branch) = branch_out + converted_lat%n_ele_max = converted_lat%n_ele_track + do ib = 0, ubound(converted_lat%branch, 1) + branch => converted_lat%branch(ib) + do i = 1, branch%n_ele_track + branch%ele(i)%slave_status = free$ + branch%ele(i)%n_lord = 0 + enddo + enddo + converted_lat%n_control_max = 0 + converted_lat%n_ic_max = 0 +endif + +call deallocate_lat_pointers (lat_out) +call deallocate_lat_pointers (lat_model) + +! Restore ptc settings + +if (n_taylor_order_saved /= ptc_private%taylor_order_ptc) call set_ptc (taylor_order = n_taylor_order_saved) +ptc_com%exact_model = ptc_exact_model + +close(iu) + +!------------------------------------------------------------------------ +contains + +subroutine write_line (line_out) + +implicit none + +character(*) line_out +integer ix, ix1, ix2, ix3 + +! Prefer to breakup a line after a comma + +do + if (len_trim(line_out) < ix_line_max) exit + ix1 = index(line_out(ix_line_min+1:), ',') + ix2 = index(line_out(ix_line_min+1:), '=') + ix3 = index(line_out(ix_line_min+1:), ' ') + + if (ix1 /= 0 .and. ix1+ix_line_min < ix_line_max) then + ix = ix1 + ix_line_min + elseif (ix2 /= 0 .and. ix2+ix_line_min < ix_line_max) then + ix = ix2 + ix_line_min + elseif (ix3 /= 0 .and. ix3+ix_line_min < ix_line_max) then + ix = ix3 + ix_line_min + elseif (ix1 /= 0) then + ix = ix1 + ix_line_min + elseif (ix2 /= 0) then + ix = ix2 + ix_line_min + else + ix = ix3 + ix_line_min + endif + + write (iu, '(2a)') line_out(:ix), trim(continue_char) + line_out = ' ' // line_out(ix+1:) +enddo + +write (iu, '(2a)') trim(line_out), trim(eol_char) + +end subroutine write_line + +end subroutine write_lattice_in_mad_format diff --git a/bmad/output/write_lat_file_mod.f90 b/bmad/output/write_lattice_in_sad_format.f90 similarity index 73% rename from bmad/output/write_lat_file_mod.f90 rename to bmad/output/write_lattice_in_sad_format.f90 index 644aef28ed..8812b30aae 100644 --- a/bmad/output/write_lat_file_mod.f90 +++ b/bmad/output/write_lattice_in_sad_format.f90 @@ -1,486 +1,14 @@ -module write_lat_file_mod - -use element_modeling_mod -use binary_parser_mod -use multipole_mod - -type multipass_region_ele_struct - integer ix_region - logical region_start_pt - logical region_stop_pt -end type - -type multipass_region_branch_struct - type (multipass_region_ele_struct), allocatable :: ele(:) -end type - -type multipass_region_lat_struct - type (multipass_region_branch_struct), allocatable :: branch(:) -end type - -contains - -!------------------------------------------------------- -!------------------------------------------------------- -!------------------------------------------------------- -! Create the information on multipass regions. - -subroutine multipass_region_info(lat, mult_lat, m_info) - -implicit none - -type (lat_struct), target :: lat -type (branch_struct), pointer :: branch -type (ele_struct), pointer :: ele -type (multipass_region_lat_struct), target :: mult_lat -type (multipass_all_info_struct), target :: m_info - -type (multipass_region_ele_struct), pointer :: mult_ele(:), m_ele -type (multipass_ele_info_struct), pointer :: e_info -type (ele_pointer_struct), pointer :: ss1(:), ss2(:) - -integer ib, ix_r, ie, ix_pass, ix_lord, ix_super -logical in_multi_region, need_new_region - -! - -allocate (mult_lat%branch(0:ubound(lat%branch, 1))) -do ib = 0, ubound(lat%branch, 1) - branch => lat%branch(ib) - allocate (mult_lat%branch(ib)%ele(0:branch%n_ele_max)) - mult_lat%branch(ib)%ele(:)%ix_region = 0 - mult_lat%branch(ib)%ele(:)%region_start_pt = .false. - mult_lat%branch(ib)%ele(:)%region_stop_pt = .false. -enddo - -call multipass_all_info (lat, m_info) - -if (size(m_info%lord) == 0) return - -! Go through and mark all 1st pass regions -! In theory the original lattice file could have something like: -! lat: line = (..., m1, m2, ..., m1, -m2, ...) -! where m1 and m2 are multipass lines. The first pass region (m1, m2) looks -! like this is one big region but the later (m1, -m2) signals that this -! is not so. -! We thus go through all the first pass regions and compare them to the -! corresponding higher pass regions. If we find two elements that are contiguous -! in the first pass region but not contiguous in some higher pass region, -! we need to break the first pass region into two. - -ix_r = 0 -do ib = 0, ubound(lat%branch, 1) - branch => lat%branch(ib) - mult_ele => mult_lat%branch(ib)%ele - - in_multi_region = .false. - - do ie = 1, branch%n_ele_track - ele => branch%ele(ie) - e_info => m_info%branch(ib)%ele(ie) - ix_pass = e_info%ix_pass - - if (ix_pass /= 1) then ! Not a first pass region - if (in_multi_region) mult_ele(ie-1)%region_stop_pt = .true. - in_multi_region = .false. - cycle - endif - - ! If start of a new region... - if (.not. in_multi_region) then - ix_r = ix_r + 1 - mult_ele(ie)%ix_region = ix_r - mult_ele(ie)%region_start_pt = .true. - in_multi_region = .true. - ix_lord = e_info%ix_lord(1) - ix_super = e_info%ix_super(1) - ss1 => m_info%lord(ix_lord)%slave(:,ix_super) - cycle - endif - ix_lord = e_info%ix_lord(1) - ix_super = e_info%ix_super(1) - ss2 => m_info%lord(ix_lord)%slave(:, ix_super) - - need_new_region = .false. - if (size(ss1) /= size(ss2)) then - need_new_region = .true. - else - do ix_pass = 2, size(ss1) - if (abs(ss1(ix_pass)%ele%ix_ele - ss2(ix_pass)%ele%ix_ele) == 1) cycle - ! not contiguous then need a new region - need_new_region = .true. - exit - enddo - endif - - if (need_new_region) then - ix_r = ix_r + 1 - mult_ele(ie-1)%region_stop_pt = .true. - mult_ele(ie)%region_start_pt = .true. - endif - - ss1 => ss2 - mult_ele(ie)%ix_region = ix_r - enddo - -enddo - -if (in_multi_region) mult_ele(branch%n_ele_track)%region_stop_pt = .true. - -end subroutine multipass_region_info - -!------------------------------------------------------- -!------------------------------------------------------- -!------------------------------------------------------- - -subroutine write_line_element (line, iu, ele, lat) - -implicit none - -type (lat_struct), target :: lat -type (ele_struct) :: ele -type (ele_struct), pointer :: lord, m_lord, slave - -character(*) line -character(40) lord_name - -integer iu, ix - -! - -if (ele%slave_status == super_slave$) then - if (ele%orientation == 1) then - write (line, '(a, 2(a, i0), a)') trim(line), ' slave_drift_', ele%ix_branch, '_', ele%ix_ele, ',' - else - write (line, '(a, 2(a, i0), a)') trim(line), ' --slave_drift_', ele%ix_branch, '_', ele%ix_ele, ',' - endif - -elseif (ele%slave_status == multipass_slave$) then - lord => pointer_to_lord(ele, 1) - write (line, '(4a)') trim(line), ' ', trim(lord%name), ',' - -else - if (ele%orientation == 1) then - write (line, '(4a)') trim(line), ' ', trim(ele%name), ',' - else - write (line, '(4a)') trim(line), ' --', trim(ele%name), ',' - endif -endif - -if (len_trim(line) > 100) call write_lat_line(line, iu, .false.) - -end subroutine write_line_element - -!------------------------------------------------------- -!------------------------------------------------------- -!------------------------------------------------------- - -function re_str(rel) result (str_out) - -implicit none - -real(rp) rel -integer pl, n -character(:), allocatable :: str_out -character(24) str -character(16) fmt - -! - -if (rel == 0) then - allocate(character(1):: str_out) - str_out = '0' - return -endif - -pl = floor(log10(abs(rel))) - -if (pl > 5) then - fmt = '(2a, i0)' - write (str, fmt) trim(rchomp(rel/10.0_rp**pl, 0)), 'E', pl - -elseif (pl > -3) then - str = rchomp(rel, pl) - -else - fmt = '(2a, i0)' - write (str, fmt) trim(rchomp(rel*10.0_rp**(-pl), 0)), 'E', pl -endif - -n = len_trim(str) -allocate(character(n):: str_out) -str_out = str(1:n) - - -end function re_str - -!------------------------------------------------------- -!------------------------------------------------------- -!------------------------------------------------------- - -function array_re_str(arr, parens_in) result (str_out) - -real(rp) arr(:) -integer i -character(120) str_out -character(*), optional :: parens_in -character(2) parens - -! - -parens = '()' -if (present(parens_in)) parens = parens_in - -str_out = parens(1:1) // re_str(arr(1)) -do i = 2, size(arr) - str_out = trim(str_out) // ', ' // re_str(arr(i)) -enddo -str_out = trim(str_out) // parens(2:2) - -end function array_re_str - -!------------------------------------------------------- -!------------------------------------------------------- -!------------------------------------------------------- - -function cmplx_re_str(cmp) result (str_out) - -complex(rp) cmp -character(40) str_out - -! - -if (imag(cmp) == 0) then - str_out = re_str(real(cmp)) -else - str_out = '(' // re_str(real(cmp)) // ', ' // re_str(imag(cmp)) // ')' -endif - -end function cmplx_re_str - -!------------------------------------------------------- -!------------------------------------------------------- -!------------------------------------------------------- - -function rchomp (rel, plc) result (out) - -implicit none - -real(rp) rel -character(25) out -character(8) :: fmt = '(f24.xx)' -integer it, plc, ix - -! - -write (fmt(6:7), '(i2.2)') 14-plc ! 15 digits of accuracy -write (out, fmt) rel -do it = len(out), 1, -1 - if (out(it:it) == ' ') cycle - if (out(it:it) == '0') then - out(it:it) = ' ' - cycle - endif - if (out(it:it) == '.') out(it:it) = ' ' - call string_trim(out, out, ix) - return -enddo - -end function rchomp - -!------------------------------------------------------- -!------------------------------------------------------- -!------------------------------------------------------- -!+ -! Subroutine write_lat_line (line, iu, end_is_neigh, do_split) -! -! Routine to write strings to a lattice file. -! This routine will break the string up into multiple lines -! if the string is too long and add a continuation character if needed. -! -! If the "line" arg does not represent a full "sentence" (end_is_neigh = False), -! then only part of the line may be written and the part not written will be returned. -! -! Input: -! line -- character(*): String of text. -! iu -- integer: Unit number to write to. -! end_is_neigh -- logical: If true then write out everything. -! Otherwise wait for a full line of max_char characters or so. -! do_split -- logical, optional: Split line if overlength? Default is True. -! False is used when line has already been split for expressions since -! the expression splitting routine does a much better job of it. -! julia -- logical, optional: Default False. If True then do not include "&" line continuation -! -! Output: -! line -- character(*): part of the string not written. -! If end_is_neigh = T then line will be blank. -!- - -subroutine write_lat_line (line, iu, end_is_neigh, do_split, julia) - -implicit none - -character(*) line -integer i, iu, n -integer, parameter :: max_char = 105 -logical end_is_neigh -logical, save :: init = .true. -logical, optional :: do_split, julia - -! - -if (.not. logic_option(.true., do_split)) then - n = len_trim(line) - if (end_is_neigh) then - call write_this (line) - init = .true. - elseif (index(',[{(=', line(n:n)) /= 0) then - call write_this (line) - else - if (logic_option(.false., julia)) then - call write_this (trim(line)) - else - call write_this (trim(line) // ' &') - endif - endif - - line = '' - return -endif - -! - -outer_loop: do - - if (len_trim(line) <= max_char) then - if (end_is_neigh) then - call write_this (line) - line = '' - init = .true. - endif - return - endif - - i = index(line(1:max_char), ',', back = .true.) - if (i /= 0) then - call write_this (line(:i)) - line = line(i+1:) - cycle outer_loop - endif - - i = index(line, ',', back = .true.) - if (i /= 0) then - call write_this (line(:i)) - line = line(i+1:) - cycle outer_loop - endif - - if (end_is_neigh) then - call write_this (line) - init = .true. - return - endif - - if (logic_option(.false., julia)) then - call write_this (trim(line)) - else - call write_this (trim(line) // ' &') - endif - line = '' - return - -enddo outer_loop - -!----------------------------------- - -contains - -subroutine write_this (line2) - -character(*) line2 -character(20) fmt - -! - -if (init) then - fmt = '(a, 1x, a)' - init = .false. -else - fmt = '(2x, a, 1x, a)' -endif - -write (iu, fmt) trim(line2) - -end subroutine write_this - -end subroutine write_lat_line - -!-------------------------------------------------------------------------------- -!-------------------------------------------------------------------------------- -!-------------------------------------------------------------------------------- - -subroutine value_to_line (line, value, str, typ, ignore_if_zero, use_comma) - -use precision_def - -implicit none - -character(*) line, str -character(40) fmt, val_str -character(*) typ - -real(rp) value - -integer ix - -logical, optional :: ignore_if_zero, use_comma - -! - -if (value == 0 .and. logic_option(.true., ignore_if_zero)) return - -if (logic_option(.true., use_comma)) then - if (str == '') then - line = trim(line) // ',' - else - line = trim(line) // ', ' // trim(str) // ' =' - endif -else - if (str /= '') then - line = trim(line) // ' ' // trim(str) // ' =' - endif -endif - -if (value == 0) then - line = trim(line) // ' 0' - return -endif - -if (typ == 'R') then - val_str = re_str(value) -elseif (typ == 'I') then - write (val_str, '(i0)') nint(value) -else - print *, 'ERROR IN VALUE_TO_LINE. BAD "TYP": ', typ - if (global_com%exit_on_error) call err_exit -endif - -call string_trim(val_str, val_str, ix) -line = trim(line) // ' ' // trim(val_str) - -end subroutine value_to_line - -!------------------------------------------------------------------------- -!------------------------------------------------------------------------- -!------------------------------------------------------------------------- !+ -! Subroutine write_lat_in_sad_format (out_file_name, lat, include_apertures, ix_branch, converted_lat, err) +! Subroutine write_lattice_in_sad_format (out_file_name, lat, include_apertures, ix_branch, converted_lat, err) ! -! Private routine used by write_lat_in_sad_format and not for general use. -! See write_lat_in_sad_format for details about the argument list. +! Private routine used by write_lattice_in_foreign_format and not for general use. +! See write_lattice_in_foreign_format for details about the argument list. !- -subroutine write_lat_in_sad_format (out_file_name, lat, include_apertures, ix_branch, converted_lat, err) +subroutine write_lattice_in_sad_format (out_file_name, lat, include_apertures, ix_branch, converted_lat, err) + +use element_modeling_mod, dummy => write_lattice_in_sad_format +use write_lattice_file_mod, dummy2 => write_lattice_in_sad_format implicit none @@ -1417,33 +945,5 @@ subroutine write_line (line_out) end subroutine write_line -end subroutine write_lat_in_sad_format - -!-------------------------------------------------------------------------------- -!-------------------------------------------------------------------------------- -!-------------------------------------------------------------------------------- - -subroutine add_this_name_to_list (ele, names, an_indexx, n_names, ix_match, has_been_added, named_eles) - -type (ele_struct), target :: ele -type (ele_pointer_struct), allocatable :: named_eles(:) ! List of unique element names - -integer, allocatable :: an_indexx(:) -integer n_names, ix_match -logical has_been_added -character(40), allocatable :: names(:) - -! - -if (size(names) < n_names + 1) then - call re_allocate(names, 2*size(names)) - call re_allocate(an_indexx, 2*size(names)) - call re_allocate_eles(named_eles, 2*size(names), .true.) -endif -call find_index (ele%name, names, an_indexx, n_names, ix_match, add_to_list = .true., has_been_added = has_been_added) -if (has_been_added) named_eles(n_names)%ele => ele - -end subroutine add_this_name_to_list - -end module +end subroutine write_lattice_in_sad_format diff --git a/bmad/searchf.namelist b/bmad/searchf.namelist new file mode 100644 index 0000000000..40c33aed95 --- /dev/null +++ b/bmad/searchf.namelist @@ -0,0 +1,3609 @@ + +File: code/control_bookkeeper.f90 +control_bookkeeper + +File: code/angle_to_canonical_coords.f90 +angle_to_canonical_coords + +File: code/apply_all_rampers.f90 +apply_all_rampers + +File: code/em_field_calc.f90 +em_field_calc + +File: code/at_this_ele_end.f90 +at_this_ele_end + +File: code/lat_sanity_check.f90 +lat_sanity_check + +File: code/attribute_set_bookkeeping.f90 +attribute_set_bookkeeping + +File: code/bend_exact_multipole_field.f90 +bend_exact_multipole_field +convert_bend_exact_multipole + +File: code/branch_name.f90 +branch_name + +File: code/c_to_cbar.f90 +c_to_cbar + +File: code/calc_z_tune.f90 +calc_z_tune + +File: code/canonical_to_angle_coords.f90 +canonical_to_angle_coords + +File: code/cbar_to_c.f90 +cbar_to_c + +File: code/check_if_s_in_bounds.f90 +check_if_s_in_bounds + +File: code/choose_quads_for_set_tune.f90 +choose_quads_for_set_tune + +File: code/chrom_calc.f90 +chrom_calc + +File: code/chrom_tune.f90 +chrom_tune + +File: code/classical_radius.f90 +classical_radius + +File: code/clear_lat_1turn_mats.f90 +clear_lat_1turn_mats + +File: code/clear_taylor_maps_from_elements.f90 +clear_taylor_maps_from_elements + +File: code/closed_orbit_calc.f90 +closed_orbit_calc + +File: code/closed_orbit_from_tracking.f90 +closed_orbit_from_tracking + +File: code/combine_consecutive_elements.f90 +combine_consecutive_elements + +File: code/attribute_bookkeeper.f90 +attribute_bookkeeper + +File: code/convert_coords.f90 +convert_coords + +File: code/convert_particle_coordinates_s_to_t.f90 +convert_particle_coordinates_s_to_t + +File: code/convert_particle_coordinates_t_to_s.f90 +convert_particle_coordinates_t_to_s + +File: code/convert_pc_to.f90 +convert_pc_to + +File: code/convert_total_energy_to.f90 +convert_total_energy_to + +File: code/create_element_slice.f90 +create_element_slice + +File: code/create_lat_ele_nametable.f90 +create_lat_ele_nametable + +File: code/create_unique_ele_names.f90 +create_unique_ele_names + +File: code/default_tracking_species.f90 +default_tracking_species + +File: code/do_mode_flip.f90 +do_mode_flip + +File: code/e_accel_field.f90 +e_accel_field + +File: code/ele_full_name.f90 +ele_full_name + +File: code/ele_has_nonzero_kick.f90 +ele_has_nonzero_kick + +File: code/ele_has_nonzero_offset.f90 +ele_has_nonzero_offset + +File: code/ele_loc_name.f90 +ele_loc_name + +File: code/ele_order_calc.f90 +ele_order_calc + +File: code/ele_unique_name.f90 +ele_unique_name + +File: code/ele_value_has_changed.f90 +ele_value_has_changed + +File: code/element_slice_iterator.f90 +element_slice_iterator + +File: code/reverse_lat.f90 +reverse_lat + +File: code/equivalent_taylor_attributes.f90 +equivalent_taylor_attributes + +File: code/find_element_ends.f90 +find_element_ends + +File: code/find_matching_fieldmap.f90 +find_matching_fieldmap + +File: code/fringe_here.f90 +fringe_here + +File: code/g_bending_strength_from_em_field.f90 +g_bending_strength_from_em_field + +File: code/gamma_ref.f90 +gamma_ref + +File: code/get_slave_list.f90 +get_slave_list + +File: code/insert_element.f90 +insert_element + +File: code/ion_kick.f90 +ion_kick + +File: code/key_name_to_key_index.f90 +key_name_to_key_index + +File: code/lat_compute_reference_energy.f90 +lat_compute_ref_energy_and_time +ele_compute_ref_energy_and_time + +File: code/lat_ele_locator.f90 +lat_ele_locator + +File: code/lat_make_mat6.f90 +lat_make_mat6 + +File: code/lattice_bookkeeper.f90 +lattice_bookkeeper + +File: code/pointer_to_lord.f90 +pointer_to_lord + +File: code/lord_edge_aligned.f90 +lord_edge_aligned + +File: code/apply_rampers_to_slave.f90 +apply_rampers_to_slave + +File: code/make_g_mats.f90 +make_g_mats + +File: code/make_hybrid_lat.f90 +make_hybrid_lat + +File: code/make_mat6.f90 +make_mat6 + +File: code/make_v_mats.f90 +make_v_mats + +File: code/map_to_angle_coords.f90 +map_to_angle_coords + +File: code/momentum_compaction.f90 +momentum_compaction + +File: code/multi_turn_tracking_analysis.f90 +multi_turn_tracking_analysis + +File: code/multi_turn_tracking_to_mat.f90 +multi_turn_tracking_to_mat + +File: code/multipass_all_info.f90 +multipass_all_info + +File: code/multipass_chain.f90 +multipass_chain + +File: code/multipole_ele_to_ab.f90 +multipole_ele_to_ab + +File: code/multipole_init.f90 +multipole_init + +File: code/new_control.f90 +new_control + +File: code/num_lords.f90 +num_lords + +File: code/offset_particle.f90 +offset_particle + +File: code/one_turn_mat_at_ele.f90 +one_turn_mat_at_ele + +File: code/orbit_amplitude_calc.f90 +orbit_amplitude_calc + +File: code/order_super_lord_slaves.f90 +order_super_lord_slaves + +File: code/particle_is_moving_backwards.f90 +particle_is_moving_backwards + +File: code/particle_is_moving_forward.f90 +particle_is_moving_forward + +File: code/particle_rf_time.f90 +particle_rf_time + +File: code/pointer_to_attribute.f90 +pointer_to_attribute + +File: code/pointer_to_ele_multipole.f90 +pointer_to_ele_multipole + +File: code/pointer_to_girder.f90 +pointer_to_girder + +File: code/pointer_to_multipass_lord.f90 +pointer_to_multipass_lord + +File: code/pointer_to_next_ele.f90 +pointer_to_next_ele + +File: code/pointer_to_wake_ele.f90 +pointer_to_wake_ele + +File: code/pointers_to_attribute.f90 +pointers_to_attribute + +File: code/radiation_integrals.f90 +radiation_integrals + +File: code/reference_energy_correction.f90 +reference_energy_correction + +File: code/rel_tracking_charge_to_mass.f90 +rel_tracking_charge_to_mass + +File: code/relative_mode_flip.f90 +relative_mode_flip + +File: code/remove_eles_from_lat.f90 +remove_eles_from_lat + +File: code/slice_lattice.f90 +slice_lattice + +File: code/rf_clock_setup.f90 +rf_clock_setup + +File: code/rf_is_on.f90 +rf_is_on + +File: code/s_calc.f90 +s_calc + +File: code/save_a_step.f90 +save_a_step + +File: code/set_ele_attribute.f90 +set_ele_attribute + +File: code/set_ele_name.f90 +set_ele_name + +File: code/set_ele_real_attribute.f90 +set_ele_real_attribute + +File: code/set_ele_status_stale.f90 +set_ele_status_stale + +File: code/set_fringe_on_off.f90 +set_fringe_on_off + +File: code/set_orbit_to_zero.f90 +set_orbit_to_zero + +File: code/set_particle_from_rf_time.f90 +set_particle_from_rf_time + +File: code/set_status_flags.f90 +set_status_flags + +File: code/significant_difference.f90 +significant_difference + +File: code/spline_fit_orbit.f90 +spline_fit_orbit + +File: code/start_branch_at.f90 +start_branch_at + +File: code/stream_ele_end.f90 +stream_ele_end + +File: code/taper_mag_strengths.f90 +taper_mag_strengths + +File: code/tilt_coords.f90 +tilt_coords + +File: code/track_all.f90 +track_all + +File: code/track_from_s_to_s.f90 +track_from_s_to_s + +File: code/transfer_matrix_calc.f90 +transfer_matrix_calc + +File: code/twiss_and_track_from_s_to_s.f90 +twiss_and_track_from_s_to_s + +File: code/twiss_and_track_intra_ele.f90 +twiss_and_track_intra_ele + +File: code/twiss_from_tracking.f90 +twiss_from_tracking + +File: code/valid_field_calc.f90 +valid_field_calc + +File: code/valid_fringe_type.f90 +valid_fringe_type + +File: code/value_of_attribute.f90 +value_of_attribute + +File: code/zero_ele_kicks.f90 +zero_ele_kicks + +File: code/zero_ele_offsets.f90 +zero_ele_offsets + +File: code/valid_mat6_calc_method.f90 +valid_mat6_calc_method + +File: code/valid_tracking_method.f90 +valid_tracking_method + +File: code/twiss_propagate_all.f90 +twiss_propagate_all + +File: code/twiss_propagate1.f90 +twiss_propagate1 +twiss1_propagate + +File: code/set_tune.f90 +set_tune + +File: code/set_tune_via_group_knobs.f90 +set_tune_via_group_knobs + +File: code/track_many.f90 +track_many + +File: code/knots_to_string.f90 +knots_to_string + +File: code/set_on_off.f90 +set_on_off + +File: code/twiss_at_start.f90 +twiss_at_start + +File: code/twiss_from_mat6.f90 +twiss_from_mat6 + +File: code/kill_taylor.f90 +kill_taylor + +File: code/twiss_at_element.f90 +twiss_at_element + +File: code/transfer_map_calc.f90 +transfer_map_calc + +File: code/transfer_mat_from_twiss.f90 +transfer_mat_from_twiss + +File: code/set_twiss.f90 +set_twiss + +File: code/set_z_tune.f90 +set_z_tune + +File: code/split_lat.f90 +split_lat + +File: code/track1.f90 +track1 + +File: custom/apply_element_edge_kick_hook.f90 +apply_element_edge_kick_hook + +File: custom/check_aperture_limit_custom.f90 +check_aperture_limit_custom + +File: custom/distance_to_aperture_custom.f90 +distance_to_aperture_custom + +File: custom/ele_geometry_hook.f90 +ele_geometry_hook + +File: custom/ele_to_fibre_hook.f90 +ele_to_fibre_hook + +File: custom/em_field_custom.f90 +em_field_custom + +File: custom/init_custom.f90 +init_custom + +File: custom/make_mat6_custom.f90 +make_mat6_custom + +File: custom/radiation_integrals_custom.f90 +radiation_integrals_custom + +File: custom/time_runge_kutta_periodic_kick_hook.f90 +time_runge_kutta_periodic_kick_hook + +File: custom/track1_bunch_hook.f90 +track1_bunch_hook + +File: custom/track1_custom.f90 +track1_custom + +File: custom/track1_postprocess.f90 +track1_postprocess + +File: custom/track1_preprocess.f90 +track1_preprocess + +File: custom/track1_spin_custom.f90 +track1_spin_custom + +File: custom/track1_wake_hook.f90 +track1_wake_hook + +File: custom/track_many_hook.f90 +track_many_hook + +File: custom/wall_hit_handler_custom.f90 +wall_hit_handler_custom + +File: dummy_routines/xraylib_dummy.f90 +xraylib +crystal_struct +compounddatanist +r_e +crystal_getcrystal +crystal_f_h_structurefactor +atomicnumbertosymbol +atomicweight +elementdensity +atomic_factors +elementdensity +getcompounddatanistbyindex +crystal_dspacing +freecompounddatanist + +File: geometry/bend_shift.f90 +bend_shift + +File: geometry/coords_body_to_local.f90 +coords_body_to_local + +File: geometry/coords_body_to_rel_exit.f90 +coords_body_to_rel_exit + +File: geometry/coords_curvilinear_to_floor.f90 +coords_curvilinear_to_floor + +File: geometry/coords_floor_to_curvilinear.f90 +coords_floor_to_curvilinear + +File: geometry/coords_floor_to_local_curvilinear.f90 +coords_floor_to_local_curvilinear + +File: geometry/coords_floor_to_relative.f90 +coords_floor_to_relative + +File: geometry/coords_local_curvilinear_to_body.f90 +coords_local_curvilinear_to_body + +File: geometry/coords_local_curvilinear_to_floor.f90 +coords_local_curvilinear_to_floor + +File: geometry/coords_relative_to_floor.f90 +coords_relative_to_floor + +File: geometry/ele_geometry_with_misalignments.f90 +ele_geometry_with_misalignments + +File: geometry/ele_misalignment_L_S_calc.f90 +ele_misalignment_l_s_calc + +File: geometry/floor_angles_to_w_mat.f90 +floor_angles_to_w_mat + +File: geometry/floor_w_mat_to_angles.f90 +floor_w_mat_to_angles + +File: geometry/lat_geometry.f90 +lat_geometry + +File: geometry/orbit_to_floor_phase_space.f90 +orbit_to_floor_phase_space + +File: geometry/orbit_to_local_curvilinear.f90 +orbit_to_local_curvilinear + +File: geometry/patch_flips_propagation_direction.f90 +patch_flips_propagation_direction + +File: geometry/s_body_calc.f90 +s_body_calc + +File: geometry/update_floor_angles.f90 +update_floor_angles + +File: geometry/w_mat_for_bend_angle.f90 +w_mat_for_bend_angle + +File: geometry/w_mat_for_tilt.f90 +w_mat_for_tilt + +File: geometry/w_mat_for_x_pitch.f90 +w_mat_for_x_pitch + +File: geometry/w_mat_for_y_pitch.f90 +w_mat_for_y_pitch + +File: geometry/ele_geometry.f90 +ele_geometry + +File: hdf5/hdf5_interface.f90 +hdf5_interface +h5o_type_attribute_f +hdf5_info_struct +hdf5_read_dataset_int +procedure +procedure +procedure +procedure +hdf5_read_dataset_real +procedure +procedure +procedure +procedure +hdf5_read_attribute_real +procedure +procedure +hdf5_read_attribute_int +procedure +procedure +hdf5_write_dataset_int +procedure +procedure +procedure +procedure +hdf5_write_dataset_real +procedure +procedure +procedure +procedure +hdf5_write_attribute_real +procedure +procedure +hdf5_write_attribute_int +procedure +procedure +hdf5_write_attribute_string +procedure +procedure +hdf5_write_attribute_string_rank0 +hdf5_write_attribute_string_rank1 +hdf5_write_attribute_int_rank0 +hdf5_write_attribute_int_rank1 +hdf5_write_attribute_real_rank0 +hdf5_write_attribute_real_rank1 +hdf5_open_file +hdf5_open_object +hdf5_close_object +hdf5_exists +hdf5_open_group +hdf5_group_n_links +hdf5_get_object_by_index +hdf5_open_dataset +hdf5_num_attributes +hdf5_get_attribute_by_index +hdf5_attribute_info +hdf5_object_info +hdf5_read_attribute_int_rank0 +hdf5_read_attribute_int_rank1 +hdf5_read_attribute_real_rank0 +hdf5_read_attribute_real_rank1 +hdf5_read_attribute_alloc_string +hdf5_read_attribute_string +hdf5_write_dataset_real_rank0 +hdf5_write_dataset_real_rank1 +hdf5_write_dataset_real_rank2 +hdf5_write_dataset_real_rank3 +hdf5_write_dataset_int_rank0 +hdf5_write_dataset_int_rank1 +hdf5_write_dataset_int_rank2 +hdf5_write_dataset_int_rank3 +hdf5_read_dataorder +hdf5_check_open +hdf5_read_dataset_real_rank0 +hdf5_read_dataset_real_rank1 +hdf5_read_dataset_real_rank2 +hdf5_read_dataset_real_rank3 +hdf5_read_dataset_int_rank0 +hdf5_read_dataset_int_rank1 +hdf5_read_dataset_int_rank2 +hdf5_read_dataset_int_rank3 + +File: hdf5/hdf5_openpmd_mod.f90 +hdf5_openpmd_mod +pmd_unit_struct +dim_1 +dim_length +dim_mass +dim_time +dim_current +dim_temperture +dim_mol +dim_luminous +dim_charge +dim_electric_field +dim_velocity +dim_energy +dim_momentum +dim_tesla +dim_hbar +pmd_write_int_to_dataset +procedure +procedure +procedure +pmd_write_real_to_dataset +procedure +procedure +procedure +pmd_write_complex_to_dataset +procedure +procedure +procedure +pmd_read_int_dataset +procedure +procedure +procedure +pmd_read_real_dataset +procedure +procedure +procedure +pmd_read_complex_dataset +procedure +procedure +procedure +pmd_init_compound_complex +pmd_kill_compound_complex +pmd_write_int_to_dataset_rank1 +pmd_write_int_to_dataset_rank2 +pmd_write_int_to_dataset_rank3 +pmd_write_int_to_pseudo_dataset +pmd_write_real_to_dataset_rank1 +pmd_write_real_to_dataset_rank2 +pmd_write_real_to_dataset_rank3 +pmd_write_real_to_pseudo_dataset +pmd_write_complex_to_dataset_rank1 +pmd_write_complex_to_dataset_rank2 +pmd_write_complex_to_dataset_rank3 +pmd_write_complex_to_pseudo_dataset +my_h5ltset_attribute_complex +pmd_write_units_to_dataset +pmd_read_int_dataset_rank1 +pmd_read_int_dataset_rank2 +pmd_read_int_dataset_rank3 +pmd_read_real_dataset_rank1 +pmd_read_real_dataset_rank2 +pmd_read_real_dataset_rank3 +pmd_read_complex_dataset_rank1 +pmd_read_complex_dataset_rank2 +pmd_read_complex_dataset_rank3 + +File: hdf5/hdf5_read_beam.f90 +hdf5_read_beam + +File: hdf5/hdf5_read_grid_field.f90 +hdf5_read_grid_field + +File: hdf5/hdf5_write_beam.f90 +hdf5_write_beam + +File: hdf5/hdf5_write_grid_field.f90 +hdf5_write_grid_field + +File: interface/astra_interface_mod.f90 +astra_interface_mod +astra_lattice_param_struct +write_astra_lattice_file +write_astra_ele +write_astra_bend +rotate3 +get_astra_fieldgrid_name_and_scaling +write_astra_field_grid_file +write_astra_field_grid_file_3d +astra_max_field_reference + +File: interface/blender_interface_mod.f90 +blender_interface_mod +write_blender_lat_layout +skip_ele_blender +write_blender_ele + +File: interface/gpt_interface_mod.f90 +gpt_interface_mod +gpt_lat_param_struct +gpt_to_particle_bunch +write_gpt_lattice_file +write_gpt_ele +get_gpt_fieldgrid_name_and_scaling +gpt_field_grid_scaling +write_gpt_field_grid_file_1d +write_gpt_field_grid_file_2d +write_gpt_field_grid_file_3d +gpt_max_field_reference +rotate_field_zx +convert_local_curvilinear_to_local_cartesian +convert_local_cartesian_to_local_curvilinear + +File: interface/xraylib_interface.f90 +xraylib_interface +xraylib_z_max$ +photon_absorption_and_phase_shift +multilayer_type_to_multilayer_params +crystal_type_to_crystal_params +xraylib_nist_compound + +File: interface/opal_interface_mod.f90 +opal_interface_mod +write_opal_lattice_file +get_opal_fieldgrid_name_and_scaling +write_opal_field_grid_file +write_opal_line + +File: low_level/absolute_time_tracking.f90 +absolute_time_tracking + +File: low_level/ac_kicker_amp.f90 +ac_kicker_amp + +File: low_level/allocate_branch_array.f90 +allocate_branch_array + +File: low_level/allocate_element_array.f90 +allocate_element_array + +File: low_level/allocate_lat_ele_array.f90 +allocate_lat_ele_array + +File: low_level/apply_element_edge_kick.f90 +apply_element_edge_kick + +File: low_level/apply_energy_kick.f90 +apply_energy_kick + +File: low_level/autoscale_phase_and_amp.f90 +autoscale_phase_and_amp + +File: low_level/average_twiss.f90 +average_twiss + +File: low_level/track_a_match.f90 +track_a_match + +File: low_level/c_multi.f90 +c_multi + +File: low_level/calc_next_fringe_edge.f90 +calc_next_fringe_edge + +File: low_level/match_ele_to_mat6.f90 +match_ele_to_mat6 + +File: low_level/check_aperture_limit.f90 +check_aperture_limit + +File: low_level/create_wiggler_cartesian_map.f90 +create_wiggler_cartesian_map + +File: low_level/deallocate_ele_array_pointers.f90 +deallocate_ele_array_pointers + +File: low_level/deallocate_ele_pointers.f90 +deallocate_ele_pointers + +File: low_level/deallocate_lat_pointers.f90 +deallocate_lat_pointers + +File: low_level/diffraction_plate_or_mask_hit_spot.f90 +diffraction_plate_or_mask_hit_spot + +File: low_level/distance_to_aperture.f90 +distance_to_aperture + +File: low_level/ele_has_constant_ds_dt_ref.f90 +ele_has_constant_ds_dt_ref + +File: low_level/ele_loc.f90 +ele_loc + +File: low_level/ele_nametable_index.f90 +ele_nametable_index + +File: low_level/entering_element.f90 +entering_element + +File: low_level/g_integrals_calc.f90 +g_integrals_calc + +File: low_level/gen_grad1_to_em_taylor.f90 +gen_grad1_to_em_taylor + +File: low_level/gen_grad_at_s_to_em_taylor.f90 +gen_grad_at_s_to_em_taylor + +File: low_level/strong_beam_sigma_calc.f90 +strong_beam_sigma_calc + +File: low_level/init_bmad.f90 +init_bmad + +File: low_level/init_ele.f90 +init_ele + +File: low_level/init_fringe_info.f90 +init_fringe_info + +File: low_level/init_lat.f90 +init_lat + +File: low_level/knot_interpolate.f90 +knot_interpolate + +File: low_level/make_g2_mats.f90 +make_g2_mats + +File: low_level/make_mat6_bmad.f90 +make_mat6_bmad + +File: low_level/make_mat6_symp_lie_ptc.f90 +make_mat6_symp_lie_ptc + +File: low_level/make_mat6_taylor.f90 +make_mat6_taylor + +File: low_level/make_mat6_tracking.f90 +make_mat6_tracking + +File: low_level/master_parameter_value.f90 +master_parameter_value + +File: low_level/mat4_multipole.f90 +mat4_multipole + +File: low_level/mat6_add_offsets.f90 +mat6_add_offsets + +File: low_level/mat6_add_pitch.f90 +mat6_add_pitch + +File: low_level/mat_symp_decouple.f90 +mat_symp_decouple + +File: low_level/ramper_slave_setup.f90 +ramper_slave_setup + +File: low_level/mexp.f90 +mexp + +File: low_level/multipole_kick_mat.f90 +multipole_kick_mat + +File: low_level/orbit_too_large.f90 +orbit_too_large + +File: low_level/patch_length.f90 +patch_length + +File: low_level/physical_ele_end.f90 +physical_ele_end + +File: low_level/pointer_to_branch.f90 +pointer_to_branch_given_name +pointer_to_branch_given_ele + +File: low_level/pointer_to_indexed_attribute.f90 +pointer_to_indexed_attribute + +File: low_level/quad_mat2_calc.f90 +quad_mat2_calc + +File: low_level/re_allocate_eles.f90 +re_allocate_eles + +File: low_level/reallocate_control.f90 +reallocate_control + +File: low_level/reallocate_expression_stack.f90 +reallocate_expression_stack + +File: low_level/remove_lord_slave_link.f90 +remove_lord_slave_link + +File: low_level/rf_coupler_kick.f90 +rf_coupler_kick + +File: low_level/rf_ref_time_offset.f90 +rf_ref_time_offset + +File: low_level/set_lords_status_stale.f90 +set_lords_status_stale + +File: low_level/sol_quad_mat6_calc.f90 +sol_quad_mat6_calc + +File: low_level/solenoid_track_and_mat.f90 +solenoid_track_and_mat + +File: low_level/bbi_slice_calc.f90 +bbi_slice_calc + +File: low_level/strong_beam_strength.f90 +strong_beam_strength + +File: low_level/symp_lie_bmad.f90 +symp_lie_bmad + +File: low_level/tilt_mat6.f90 +tilt_mat6 + +File: low_level/track1_bmad.f90 +track1_bmad + +File: low_level/track1_linear.f90 +track1_linear + +File: low_level/track1_runge_kutta.f90 +track1_runge_kutta + +File: low_level/calc_super_slave_key.f90 +calc_super_slave_key + +File: low_level/transfer_twiss.f90 +transfer_twiss + +File: low_level/track1_symp_lie_ptc.f90 +track1_symp_lie_ptc + +File: low_level/track1_taylor.f90 +track1_taylor + +File: low_level/track1_time_runge_kutta.f90 +track1_time_runge_kutta + +File: low_level/track_a_bend.f90 +track_a_bend +sbend_body_with_k1_map + +File: low_level/track_a_converter.f90 +track_a_converter + +File: low_level/track_a_crab_cavity.f90 +track_a_crab_cavity + +File: low_level/track_a_drift.f90 +track_a_drift + +File: low_level/track_a_foil.f90 +track_a_foil + +File: low_level/track_a_gkicker.f90 +track_a_gkicker + +File: low_level/track_a_lcavity.f90 +track_a_lcavity + +File: low_level/track_a_mask.f90 +track_a_mask + +File: low_level/track_a_patch.f90 +track_a_patch + +File: low_level/track_a_quadrupole.f90 +track_a_quadrupole + +File: low_level/track_a_rfcavity.f90 +track_a_rfcavity + +File: low_level/track_a_sad_mult.f90 +track_a_sad_mult + +File: low_level/track_a_sol_quad.f90 +track_a_sol_quad + +File: low_level/track_a_thick_multipole.f90 +track_a_thick_multipole + +File: low_level/track_a_wiggler.f90 +track_a_wiggler + +File: low_level/track_a_zero_length_element.f90 +track_a_zero_length_element + +File: low_level/transfer_ac_kick.f90 +transfer_ac_kick + +File: low_level/transfer_branch.f90 +transfer_branch + +File: low_level/transfer_branch_parameters.f90 +transfer_branch_parameters + +File: low_level/transfer_branches.f90 +transfer_branches + +File: low_level/transfer_ele.f90 +transfer_ele + +File: low_level/transfer_ele_taylor.f90 +transfer_ele_taylor + +File: low_level/transfer_eles.f90 +transfer_eles + +File: low_level/transfer_fieldmap.f90 +transfer_fieldmap + +File: low_level/transfer_lat.f90 +transfer_lat + +File: low_level/transfer_lat_parameters.f90 +transfer_lat_parameters + +File: low_level/transfer_mat2_from_twiss.f90 +transfer_mat2_from_twiss + +File: low_level/track_a_beambeam.f90 +track_a_beambeam + +File: low_level/transfer_wall3d.f90 +transfer_wall3d + +File: low_level/twiss_from_mat2.f90 +twiss_from_mat2 + +File: low_level/twiss_to_1_turn_mat.f90 +twiss_to_1_turn_mat + +File: low_level/unlink_fieldmap.f90 +unlink_fieldmap + +File: low_level/unlink_wall3d.f90 +unlink_wall3d + +File: low_level/init_multipole_cache.f90 +init_multipole_cache + +File: low_level/low_energy_z_correction.f90 +low_energy_z_correction + +File: low_level/num_field_eles.f90 +num_field_eles + +File: low_level/pointer_to_field_ele.f90 +pointer_to_field_ele + +File: low_level/add_lattice_control_structs.f90 +add_lattice_control_structs + +File: low_level/ramper_value.f90 +ramper_value + +File: low_level/track_a_pickup.f90 +track_a_pickup + +File: low_level/bend_length_has_been_set.f90 +bend_length_has_been_set + +File: low_level/tracking_rad_map_setup.f90 +tracking_rad_map_setup + +File: low_level/normal_mode_dispersion.f90 +normal_mode_dispersion + +File: modules/bmad.f90 +bmad + +File: modules/bmad_struct.f90 +bmad_struct +bmad_inc_version$ +none$ +fringe_field_info_struct +n_pole_maxx +old_control_var_offset$ +var_offset$ +n_var_max$ +taylor_offset$ +expression_atom_struct +bmad_standard$ +symp_lie_ptc$ +runge_kutta$ +linear$ +tracking$ +time_runge_kutta$ +fixed_step_runge_kutta$ +symp_lie_bmad$ +auto$ +sprint$ +fixed_step_time_runge_kutta$ +mad$ +n_methods$ +tracking_method_name +spin_tracking_method_name +mat6_calc_method_name +drift_kick$ +matrix_kick$ +ripken_kick$ +ptc_integration_type_name +sub_key_name +sector$ +straight$ +ptc_field_geometry_name +fieldmap$ +planar_model$ +refer_to_lords$ +no_field$ +helical_model$ +soft_edge$ +field_calc_name +uniform$ +gaussian$ +spherical$ +curve$ +distribution_name +ix_slice_slave$ +minor_slave$ +super_slave$ +free$ +group_lord$ +super_lord$ +overlay_lord$ +girder_lord$ +multipass_lord$ +multipass_slave$ +not_a_lord$ +slice_slave$ +control_lord$ +ramper_lord$ +governor$ +field_lord$ +control_name +set$ +unset$ +auto_aperture$ +rectangular$ +elliptical$ +wall3d$ +custom_aperture$ +lord_defined$ +aperture_type_name +soft_edge_only$ +hard_edge_only$ +full$ +sad_full$ +linear_edge$ +basic_bend$ +fringe_type_name +standing_wave$ +traveling_wave$ +ptc_standard$ +cavity_type_name +x_invariant$ +multipole_symmetry$ +ptc_fringe_geometry_name +control_var$ +old_control_var$ +all_control_var$ +elec_multipole$ +ok$ +in_stop_band$ +non_symplectic$ +unstable$ +unstable_a$ +unstable_b$ +xfer_mat_calc_failure$ +twiss_propagate_failure$ +no_closed_orbit$ +twiss_struct +include_kicks$ +short$ +user_set$ +first_pass$ +multipass_ref_energy_name +highland$ +lynch_dahl$ +scatter_method_name +interval1_coef_struct +photon_reflect_table_struct +photon_reflect_surface_struct +incoherent$ +coherent$ +photon_type_name +ascii$ +binary$ +hdf5$ +one_file$ +old_ascii$ +num_ele_attrib$ +off$ +on$ +transverse_field$ +spin_tracking_model_name +save_state$ +restore_state$ +off_and_save$ +horizontally_pure$ +vertically_pure$ +exact_multipoles_name +one_dim$ +steady_state_3d$ +csr_method_name +slice$ +fft_3d$ +cathode_fft_3d$ +space_charge_method_name +pauli_struct +spin_eigen_struct +spin_axis_struct +spin_matching_struct +spin_polar_struct +spin_orbit_map1_struct +linear_isf1_struct +linear_ele_isf_struct +x_unit_vec +y_unit_vec +z_unit_vec +magnetic$ +electric$ +mixed$ +em_field_type_name +bragg_diffracted$ +forward_diffracted$ +undiffracted$ +ref_orbit_follows_name +reflection$ +transmission$ +mode_name +anchor_beginning$ +anchor_center$ +anchor_end$ +anchor_pt_name +none_pt$ +entrance_end$ +exit_end$ +both_ends$ +no_end$ +no_aperture$ +nowhere$ +continuous$ +surface$ +wall_transition$ +upstream_end$ +downstream_end$ +inside$ +center_pt$ +start_end$ +first_track_edge$ +second_track_edge$ +in_between$ +fiducial_pt_name +aperture_at_name +end_at_name +ref_coords_name +ref_pt_name +location_name +normal$ +clear$ +opaque$ +wall_start$ +wall_end$ +wall3d_section_type_name +wall3d_vertex_struct +absolute$ +relative$ +shifted_to_relative$ +wall3d_section_struct +chamber_wall$ +mask_plate$ +wall3d_name +wall3d_struct +taylor_term_struct +complex_taylor_term_struct +taylor_struct +complex_taylor_struct +x_plane$ +y_plane$ +z_plane$ +n_plane$ +s_plane$ +plane_name +field_plane_name +moving_forward$ +pre_born$ +alive$ +lost$ +lost_neg_x$ +lost_pos_x$ +lost_neg_y$ +lost_pos_y$ +lost_z$ +lost_pz$ +lost_neg_x_aperture$ +lost_pos_x_aperture$ +lost_neg_y_aperture$ +lost_pos_y_aperture$ +lost_z_aperture$ +lost_pz_aperture$ +state_name +vec0$ +coord_struct +coord_array_struct +no_misalignment$ +bpm_phase_coupling_struct +x_polarization$ +y_polarization$ +xy$ +sr_transverse_polarization_name +leading$ +trailing$ +x_leading$ +y_leading$ +x_trailing$ +y_trailing$ +sr_transverse_position_dep_name +sr_longitudinal_position_dep_name +sr_z_plane_name +wake_sr_mode_struct +wake_sr_z_struct +wake_sr_struct +wake_lr_mode_struct +wake_lr_struct +wake_struct +ac_kicker_time_struct +ac_kicker_freq_struct +ac_kicker_struct +family_y$ +family_x$ +family_qu$ +family_sq$ +hyper_y$ +hyper_xy$ +hyper_x$ +cartesian_map_family_name +cartesian_map_form_name +cartesian_map_term1_struct +cartesian_map_term_struct +cartesian_map_struct +cylindrical_map_term1_struct +cylindrical_map_term_struct +cylindrical_map_struct +gen_grad1_struct +gen_grad_map_struct +grid_field_pt1_struct +grid_field_pt_struct +grid_field_struct +em_taylor_term_struct +em_taylor_struct +vec3_zero$ +vec6_zero$ +floor_position_struct +high_energy_space_charge_struct +xy_disp_struct +lat_ele_loc_struct +lat_ele_order1_struct +lat_ele_order_array_struct +lat_ele_order_struct +ele_pointer_struct +branch_pointer_struct +lat_pointer_struct +mode3_struct +super_ok$ +stale$ +attribute_group$ +control_group$ +floor_position_group$ +s_position_group$ +ref_energy_group$ +mat6_group$ +rad_int_group$ +all_groups$ +s_and_floor_position_group$ +bookkeeping_state_struct +multipole_cache_struct +rad_map_struct +rad_map_ele_struct +surface_segmented_pt_struct +surface_segmented_struct +surface_h_misalign_pt_struct +surface_h_misalign_struct +surface_displacement_pt_struct +surface_displacement_struct +pixel_pt_struct +pixel_detec_struct +surface_curvature_struct +target_point_struct +photon_target_struct +photon_material_struct +polarized$ +unpolarized$ +polarization_name +photon_element_struct +bunch_struct +beam_struct +ellipse_beam_init_struct +kv_beam_init_struct +grid_beam_init_struct +beam_init_struct +random_engine_name +random_gauss_converter_name +beam_distribution_type_name +bunch_params_struct +bunch_track_struct +converter_prob_pc_r_struct +converter_dir_1d_struct +converter_dir_2d_struct +converter_dir_coef_struct +converter_direction_out_struct +converter_sub_distribution_struct +material_struct +foil_struct +converter_distribution_struct +converter_struct +control_struct +control_var1_struct +control_ramp1_struct +cubic$ +interpolation_name +ramper_lord_struct +controller_struct +ele_struct +lat_param_struct +ptc_layout_pointer_struct +ptc_branch1_struct +mode_info_struct +resonance_h_struct +bmad_normal_form_struct +ptc_normal_form_struct +branch_struct +opal$ +impactt$ +pre_tracker_struct +lat_struct +coord_name +coord_name_cap +drift$ +sbend$ +quadrupole$ +group$ +sextupole$ +overlay$ +custom$ +taylor$ +rfcavity$ +elseparator$ +beambeam$ +wiggler$ +sol_quad$ +marker$ +kicker$ +hybrid$ +octupole$ +rbend$ +multipole$ +def_bmad_com$ +def_mad_beam$ +ab_multipole$ +solenoid$ +patch$ +lcavity$ +def_parameter$ +null_ele$ +beginning_ele$ +def_line$ +match$ +monitor$ +instrument$ +hkicker$ +vkicker$ +rcollimator$ +ecollimator$ +girder$ +converter$ +def_particle_start$ +photon_fork$ +fork$ +mirror$ +crystal$ +pipe$ +capillary$ +multilayer_mirror$ +e_gun$ +em_field$ +floor_shift$ +fiducial$ +undulator$ +diffraction_plate$ +photon_init$ +sample$ +detector$ +sad_mult$ +mask$ +ac_kicker$ +lens$ +def_space_charge_com$ +crab_cavity$ +ramper$ +def_ptc_com$ +rf_bend$ +gkicker$ +foil$ +thick_multipole$ +pickup$ +feedback$ +n_key$ +key_name +standard$ +match_twiss$ +identity$ +phase_trombone$ +match_orbit$ +zero$ +val1$ +val2$ +val3$ +val4$ +val5$ +val6$ +val7$ +val8$ +val9$ +val10$ +val11$ +val12$ +beta_a0$ +alpha_a0$ +beta_b0$ +alpha_b0$ +beta_a1$ +alpha_a1$ +beta_b1$ +alpha_b1$ +dphi_a$ +dphi_b$ +eta_x0$ +etap_x0$ +eta_y0$ +etap_y0$ +eta_x1$ +etap_x1$ +eta_y1$ +etap_y1$ +c11_mat0$ +c12_mat0$ +c21_mat0$ +c22_mat0$ +mode_flip0$ +c11_mat1$ +c12_mat1$ +c21_mat1$ +c22_mat1$ +mode_flip1$ +x0$ +px0$ +y0$ +py0$ +z0$ +pz0$ +x1$ +px1$ +y1$ +py1$ +z1$ +pz1$ +matrix$ +kick0$ +recalc$ +spin_tracking_model$ +delta_time$ +x$ +px$ +y$ +py$ +z$ +pz$ +t$ +field_x$ +field_y$ +phase_x$ +phase_y$ +e_photon$ +e1$ +e2$ +fint$ +fintx$ +hgap$ +hgapx$ +h1$ +h2$ +radius$ +focal_strength$ +l$ +tilt$ +roll$ +n_part$ +inherit_from_fork$ +ref_tilt$ +direction$ +repetition_frequency$ +deta_ds_master$ +kick$ +x_gain_err$ +taylor_order$ +r_solenoid$ +final_charge$ +k1$ +kx$ +harmon$ +h_displace$ +y_gain_err$ +s_twiss_ref$ +critical_angle_factor$ +tilt_corr$ +ref_coords$ +dt_max$ +graze_angle$ +k2$ +b_max$ +v_displace$ +gradient_tot$ +harmon_master$ +ks$ +flexible$ +crunch$ +ref_orbit_follows$ +pc_out_min$ +gradient$ +k3$ +noise$ +new_branch$ +ix_branch$ +g_max$ +g$ +symmetry$ +field_scale_factor$ +pc_out_max$ +dg$ +bbi_const$ +osc_amplitude$ +ix_to_branch$ +angle_out_max$ +gradient_err$ +critical_angle$ +bragg_angle_in$ +spin_dn_dpz_x$ +delta_e_ref$ +interpolation$ +bragg_angle_out$ +k1x$ +spin_dn_dpz_y$ +charge$ +x_gain_calib$ +ix_to_element$ +voltage$ +g_tot$ +rho$ +voltage_err$ +bragg_angle$ +k1y$ +n_particle$ +spin_dn_dpz_z$ +fringe_type$ +dbragg_angle_de$ +fringe_at$ +gang$ +darwin_width_sigma$ +darwin_width_pi$ +spin_fringe_on$ +pendellosung_period_sigma$ +sig_x$ +exact_multipoles$ +pendellosung_period_pi$ +sig_y$ +graze_angle_in$ +r0_elec$ +rf_frequency$ +sig_z$ +graze_angle_out$ +r0_mag$ +rf_wavelength$ +sig_vx$ +static_linear_map$ +sig_vy$ +constant_ref_energy$ +longitudinal_mode$ +sig_e$ +sig_pz$ +autoscale_amplitude$ +d1_thickness$ +default_tracking_species$ +autoscale_phase$ +n_slice$ +y_gain_calib$ +sig_e2$ +fb1$ +polarity$ +crunch_calib$ +alpha_angle$ +d2_thickness$ +beta_a_strong$ +beta_a_out$ +e_loss$ +gap$ +spin_x$ +E_center$ +scatter_test$ +fb2$ +x_offset_calib$ +v1_unitcell$ +psi_angle$ +cavity_type$ +beta_b_strong$ +beta_b_out$ +spin_y$ +E2_center$ +n_period$ +emit_fraction$ +x1_edge$ +y_offset_calib$ +v_unitcell$ +v2_unitcell$ +spin_z$ +l_period$ +fq1$ +alpha_a_strong$ +alpha_a_out$ +E2_probability$ +phi0_max$ +x2_edge$ +fq2$ +phi0$ +tilt_calib$ +e_center_relative_to_ref$ +y1_edge$ +alpha_b_strong$ +alpha_b_out$ +is_mosaic$ +px_aperture_width2$ +phi0_err$ +current$ +mosaic_thickness$ +px_aperture_center$ +eta_x_out$ +quad_tilt$ +de_eta_meas$ +spatial_distribution$ +y2_edge$ +species_strong$ +eta_y_out$ +mode$ +velocity_distribution$ +py_aperture_width2$ +phi0_multipass$ +n_sample$ +origin_ele_ref_pt$ +mosaic_angle_rms_in_plane$ +eps_step_scale$ +E_tot_strong$ +dthickness_dx$ +bend_tilt$ +etap_x_out$ +phi0_autoscale$ +dx_origin$ +energy_distribution$ +x_quad$ +ds_photon_slice$ +mosaic_angle_rms_out_plane$ +py_aperture_center$ +x_dispersion_err$ +l_rectangle$ +etap_y_out$ +dy_origin$ +y_quad$ +e_field_x$ +y_dispersion_err$ +z_aperture_width2$ +user_sets_length$ +rf_clock_harmonic$ +b_field_tot$ +atomic_weight$ +upstream_coord_dir$ +dz_origin$ +mosaic_diffraction_num$ +cmat_11$ +field_autoscale$ +l_sagitta$ +e_field_y$ +x_dispersion_calib$ +z_aperture_center$ +f_factor$ +cmat_12$ +dtheta_origin$ +b_param$ +l_chord$ +downstream_coord_dir$ +pz_aperture_width2$ +y_dispersion_calib$ +scale_field_to_one$ +voltage_tot$ +scatter_method$ +cmat_21$ +l_active$ +dphi_origin$ +split_id$ +ref_cap_gamma$ +l_soft_edge$ +transverse_sigma_cut$ +pz_aperture_center$ +mean_excitation_energy$ +fiducial_pt$ +cmat_22$ +dpsi_origin$ +t_offset$ +ds_slice$ +use_reflectivity_table$ +init_needed$ +angle$ +n_cell$ +mode_flip$ +z_crossing$ +x_kick$ +x_pitch$ +px_kick$ +y_pitch$ +y_kick$ +x_offset$ +py_kick$ +y_offset$ +z_kick$ +z_offset$ +pz_kick$ +hkick$ +d_spacing$ +x_offset_mult$ +emittance_a$ +crab_x1$ +vkick$ +y_offset_mult$ +p0c_ref_init$ +emittance_b$ +crab_x2$ +bl_hkick$ +e_tot_ref_init$ +emittance_z$ +crab_x3$ +bl_vkick$ +crab_tilt$ +bl_kick$ +b_field$ +e_field$ +high_energy_space_charge_on$ +crab_x4$ +photon_type$ +coupler_phase$ +db_field$ +crab_x5$ +lattice_type$ +b1_gradient$ +e1_gradient$ +coupler_angle$ +live_branch$ +b2_gradient$ +e2_gradient$ +coupler_strength$ +geometry$ +coupler_at$ +e_tot_offset$ +ptc_canonical_coords$ +b3_gradient$ +e3_gradient$ +ptc_fringe_geometry$ +e_tot_set$ +bs_field$ +p0c_set$ +ptc_field_geometry$ +delta_ref_time$ +p0c_start$ +e_tot_start$ +p0c$ +e_tot$ +x_pitch_tot$ +no_end_marker$ +y_pitch_tot$ +x_offset_tot$ +y_offset_tot$ +z_offset_tot$ +tilt_tot$ +roll_tot$ +ref_tilt_tot$ +multipass_ref_energy$ +dispatch$ +ref_time_start$ +thickness$ +integrator_order$ +num_steps$ +ds_step$ +csr_ds_step$ +lord_pad1$ +lord_pad2$ +ref_wavelength$ +x1_limit$ +x2_limit$ +y1_limit$ +y2_limit$ +check_sum$ +spherical_curvature$ +distribution$ +tt$ +x_knot$ +alias$ +max_fringe_order$ +eta_x$ +electric_dipole_moment$ +lr_self_wake_on$ +x_ref$ +species_out$ +y_knot$ +eta_y$ +density$ +lr_wake_file$ +px_ref$ +elliptical_curvature_x$ +etap_x$ +slave$ +density_used$ +lr_freq_spread$ +y_ref$ +elliptical_curvature_y$ +etap_y$ +area_density$ +input_ele$ +lattice$ +phi_a$ +multipoles_on$ +py_ref$ +elliptical_curvature_z$ +area_density_used$ +output_ele$ +aperture_type$ +eta_z$ +machine$ +taylor_map_includes_offsets$ +pixel$ +p88$ +radiation_length$ +csr_method$ +var$ +z_ref$ +p89$ +radiation_length_used$ +pz_ref$ +space_charge_method$ +p90$ +mat6_calc_method$ +tracking_method$ +s_long$ +ref_time$ +ptc_integration_type$ +spin_tracking_method$ +eta_a$ +aperture$ +etap_a$ +x_limit$ +absolute_time_tracking$ +eta_b$ +y_limit$ +etap_b$ +offset_moves_aperture$ +aperture_limit_on$ +alpha_a$ +reflectivity_table$ +energy_probability_curve$ +exact_misalign$ +physical_source$ +sr_wake_file$ +alpha_b$ +term$ +frequencies$ +old_integrator$ +curvature$ +x_position$ +exact_model$ +symplectify$ +y_position$ +n_slice_spline$ +z_position$ +amp_vs_time$ +is_on$ +theta_position$ +vertical_kick$ +field_calc$ +phi_position$ +psi_position$ +wall$ +aperture_at$ +beta_a$ +ran_seed$ +origin_ele$ +beta_b$ +to_line$ +field_overlaps$ +field_master$ +to_element$ +descrip$ +scale_multipoles$ +sr_wake$ +ref_orbit$ +lr_wake$ +phi_b$ +crystal_type$ +material_type$ +type$ +ref_origin$ +ele_origin$ +superimpose$ +super_offset$ +reference$ +cartesian_map$ +cylindrical_map$ +grid_field$ +gen_grad_map$ +create_jumbo_slave$ +accordion_edge$ +start_edge$ +end_edge$ +s_position$ +ref_species$ +particle$ +wrap_superimpose$ +a0$ +a21$ +b0$ +b21$ +k0l$ +k21l$ +t0$ +t21$ +k0sl$ +k21sl$ +a0_elec$ +a21_elec$ +b0_elec$ +b21_elec$ +custom_attribute0$ +custom_attribute_num$ +num_ele_attrib_extended$ +g_err$ +b_field_err$ +blank_name$ +open$ +closed$ +lattice_type_name +geometry_name +anormal_mode_struct +linac_normal_mode_struct +normal_modes_struct +bends$ +wigglers$ +all$ +upstream$ +downstream$ +radians$ +degrees$ +cycles$ +radians_over_2pi$ +angle_units_name +short_angle_units_name +em_field_struct +rotationally_symmetric_rz$ +xyz$ +grid_field_geometry_name +grid_field_dimension +strong_beam_struct +track_point_struct +track_struct +multipass_lord_info_struct +multipass_ele_info_struct +multipass_branch_info_struct +multipass_all_info_struct +aperture_point_struct +aperture_param_struct +aperture_scan_struct +space_charge_common_struct +time_runge_kutta_common_struct +invalid_name$ +is_logical$ +is_integer$ +is_real$ +is_switch$ +is_string$ +is_struct$ +unknown$ +patch_problem$ +outside$ +cannot_find$ +extra_parsing_info_struct +bmad_common_struct +bmad_private_struct +ptc_common_struct +ptc_private_struct +small_rel_change$ +rad_int1_struct +rad_int_branch_struct +rad_int_all_ele_struct +pmd_header_struct +end_stack$ +plus$ +minus$ +times$ +divide$ +l_parens$ +r_parens$ +power$ +unary_minus$ +unary_plus$ +no_delim$ +sin$ +cos$ +tan$ +asin$ +acos$ +atan$ +abs$ +sqrt$ +log$ +exp$ +ran$ +ran_gauss$ +atan2$ +factorial$ +int$ +nint$ +floor$ +ceiling$ +numeric$ +variable$ +mass_of$ +charge_of$ +anomalous_moment_of$ +species$ +species_const$ +sinc$ +constant$ +comma$ +rms$ +average$ +sum$ +l_func_parens$ +arg_count$ +antiparticle$ +cot$ +sec$ +csc$ +sign$ +sinh$ +cosh$ +tanh$ +coth$ +asinh$ +acosh$ +atanh$ +acoth$ +min$ +max$ +modulo$ +expression_op_name +expression_eval_level +next_in_branch +coord_state_name +is_attribute +pointer_to_slave +ele_finalizer + +File: modules/changed_attribute_bookkeeper.f90 +changed_attribute_bookkeeper +set_flags_for_changed_attribute +procedure +procedure +procedure +procedure +procedure +set_flags_for_changed_all_attribute +set_flags_for_changed_integer_attribute +set_flags_for_changed_logical_attribute +set_flags_for_changed_lat_attribute +set_flags_for_changed_real_attribute + +File: modules/element_at_s_mod.f90 +element_at_s_mod +element_at_s +procedure +procedure +element_at_s_branch +element_at_s_lat +pointer_to_element_at_s + +File: modules/em_field_mod.f90 +em_field_mod +g_bend_from_em_field +to_fieldmap_coords +rotate_em_field +grid_field_interpolate +field_interpolate_3d +em_field_derivatives +gen_grad_field + +File: modules/integration_timer_mod.f90 +integration_timer_mod +integration_timer +procedure +procedure +integration_timer_ele +integration_timer_fibre +get_taylor +diff +term_diff + +File: modules/mad_mod.f90 +mad_mod +mad_energy_struct +mad_map_struct +make_mat6_mad +make_mad_map +mad_add_offsets_and_multipoles +mad_drift +mad_elsep +mad_sextupole +mad_sbend +mad_sbend_fringe +mad_sbend_body +mad_tmfoc +mad_quadrupole +mad_rfcavity +mad_solenoid +mad_tmsymm +mad_tmtilt +mad_concat_map2 +mad_track1 +track1_mad +mad_map_to_taylor +taylor_to_mad_map +make_unit_mad_map + +File: modules/measurement_mod.f90 +measurement_mod +ele_is_monitor +compute_measurement_distortion_mat +to_orbit_reading +to_eta_reading +to_phase_and_coupling_reading + +File: modules/srdt_mod.f90 +srdt_mod +summation_rdt_struct +srdt_first +srdt_second +sliced_eles_struct +srdt_calc +srdt_calc_with_cache +make_srdt_cache +make_slices +srdt_lsq_solution + +File: modules/bookkeeper_mod.f90 +bookkeeper_mod +makeup_group_lord +makeup_multipass_slave +makeup_super_slave +makeup_super_slave1 +compute_slave_coupler +makeup_control_slave +aperture_bookkeeper +attributes_need_bookkeeping + +File: modules/twiss_and_track_mod.f90 +twiss_and_track_mod +twiss_and_track +procedure +procedure +twiss_and_track_branch +twiss_and_track_all +twiss_and_track1 +twiss_and_track_at_s + +File: modules/equality_mod.f90 +equality_mod +operator +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +eq_spline +eq_spin_polar +eq_ac_kicker_time +eq_ac_kicker_freq +eq_ac_kicker +eq_interval1_coef +eq_photon_reflect_table +eq_photon_reflect_surface +eq_coord +eq_coord_array +eq_bpm_phase_coupling +eq_expression_atom +eq_wake_sr_z +eq_wake_sr_mode +eq_wake_sr +eq_wake_lr_mode +eq_wake_lr +eq_lat_ele_loc +eq_wake +eq_taylor_term +eq_taylor +eq_em_taylor_term +eq_em_taylor +eq_cartesian_map_term1 +eq_cartesian_map_term +eq_cartesian_map +eq_cylindrical_map_term1 +eq_cylindrical_map_term +eq_cylindrical_map +eq_grid_field_pt1 +eq_grid_field_pt +eq_grid_field +eq_floor_position +eq_high_energy_space_charge +eq_xy_disp +eq_twiss +eq_mode3 +eq_bookkeeping_state +eq_rad_map +eq_rad_map_ele +eq_gen_grad1 +eq_gen_grad_map +eq_surface_segmented_pt +eq_surface_segmented +eq_surface_h_misalign_pt +eq_surface_h_misalign +eq_surface_displacement_pt +eq_surface_displacement +eq_target_point +eq_surface_curvature +eq_photon_target +eq_photon_material +eq_pixel_pt +eq_pixel_detec +eq_photon_element +eq_wall3d_vertex +eq_wall3d_section +eq_wall3d +eq_ramper_lord +eq_control +eq_control_var1 +eq_control_ramp1 +eq_controller +eq_ellipse_beam_init +eq_kv_beam_init +eq_grid_beam_init +eq_beam_init +eq_lat_param +eq_mode_info +eq_pre_tracker +eq_anormal_mode +eq_linac_normal_mode +eq_normal_modes +eq_em_field +eq_strong_beam +eq_track_point +eq_track +eq_space_charge_common +eq_bmad_common +eq_rad_int1 +eq_rad_int_branch +eq_rad_int_all_ele +eq_ele +eq_complex_taylor_term +eq_complex_taylor +eq_branch +eq_lat +eq_bunch +eq_bunch_params +eq_beam +eq_aperture_point +eq_aperture_param +eq_aperture_scan + +File: modules/radiation_mod.f90 +radiation_mod +release_rad_int_cache +track1_radiation +radiation_map_setup +track1_radiation_center + +File: modules/bmad_interface.f90 +bmad_interface + +File: modules/fringe_mod.f90 +fringe_mod +bend_edge_kick +linear_bend_edge_kick +hwang_bend_edge_kick +sad_mult_hard_bend_edge_kick +soft_quadrupole_edge_kick +hard_multipole_edge_kick +sad_soft_bend_edge_kick +ptc_wedger +ptc_fringe_dipoler +ptc_rot_xz +exact_bend_edge_kick + +File: modules/time_tracker_mod.f90 +time_tracker_mod +odeint_bmad_time +rk_adaptive_time_step +rk_time_step1 +em_field_kick_vector_time +particle_in_global_frame +drift_orbit_time +write_time_particle_distribution +track_until_dead + +File: modules/complex_taylor_mod.f90 +complex_taylor_mod +complex_taylor_coef +procedure +procedure +complex_taylor_clean +complex_taylor_coef1 +complex_taylor_coef2 +type_complex_taylors +complex_taylor_make_unit +add_complex_taylor_term1 +add_complex_taylor_term2 +kill_complex_taylor +sort_complex_taylor_terms +complex_taylor_exponent_index +complex_taylor_to_mat6 +mat6_to_complex_taylor +track_complex_taylor +truncate_complex_taylor_to_order + +File: modules/equal_mod.f90 +equal_mod +assignment +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +operator +procedure +operator +procedure +map1_times_map1 +em_field_plus_em_field +ele_equal_ele +ele_equals_ele +ele_vec_equal_ele_vec +lat_equal_lat +lat_vec_equal_lat_vec +branch_equal_branch +coord_equal_coord +taylor_equal_taylor +taylors_equal_taylors +init_taylor_series +em_taylor_equal_em_taylor +em_taylors_equal_em_taylors +init_em_taylor_series +complex_taylor_equal_complex_taylor +complex_taylors_equal_complex_taylors +init_complex_taylor_series +bunch_equal_bunch +beam_equal_beam + +File: modules/transfer_map_mod.f90 +transfer_map_mod +transfer_map_from_s_to_s +transfer_this_map +mat6_from_s_to_s +transfer_this_mat +concat_transfer_mat + +File: modules/multipole_mod.f90 +multipole_mod +multipole_ab_to_kt +multipole1_ab_to_kt +multipole_ele_to_kt +multipole_kt_to_ab +multipole1_kt_to_ab +multipole_kicks +ab_multipole_kicks +multipole_kick +ab_multipole_kick +elec_multipole_field + +File: modules/runge_kutta_mod.f90 +runge_kutta_mod +runge_kutta_common_struct +odeint_bmad +rk_adaptive_step +rk_step1 +kick_vector_calc + +File: modules/taylor_mod.f90 +taylor_mod +taylor_clean +taylor_coef +taylor_expn +type_taylors +taylor_make_quaternion_unit +taylor_make_unit +taylor_term_index +add_taylor_term +remove_taylor_term +taylor_extract_zeroth_order_part +sort_taylor_terms +taylor_exponent_index +taylor_to_mat6 +mat6_to_taylor +track_taylor +truncate_taylor_to_order +evaluate_em_taylor +add_em_taylor_term + +File: modules/wall3d_mod.f90 +wall3d_mod +re_allocate +procedure +procedure +re_allocate_wall3d_vertex_array +re_allocate_wall3d_section_array +wall3d_initializer +wall3d_section_initializer +calc_wall_radius +wall3d_d_radius +pointer_to_wall3d +wall3d_to_position +create_concatenated_wall3d +mark_patch_regions + +File: modules/element_modeling_mod.f90 +element_modeling_mod +wiggler_modeling_common_struct +create_sol_quad_model +create_planar_wiggler_model +wig_func +yfit_calc +mat_flatten + +File: modules/coord_mod.f90 +coord_mod +reallocate_coord +procedure +procedure +init_coord +procedure +procedure +procedure +reallocate_coord_n +reallocate_coord_lat +reallocate_coord_array +init_coord1 +init_coord2 +init_coord3 + +File: modules/expression_mod.f90 +expression_mod +expression_string_to_stack +pushit +expression_value +expression_stack_value +expression_stack_to_string +split_expression_string +linear_coef + +File: modules/mode3_mod.f90 +mode3_mod +m +o +l +t6_to_b123 +normal_mode3_calc +make_hvbp +xyz_to_action +action_to_xyz +eigen_decomp_6mat +mytan +order_evecs_by_n_similarity +order_evecs_by_plane_dominance +order_evecs_by_tune +make_n +get_emit_from_sigma_mat +beam_tilts +make_smat_from_abc +normalize_evecs +project_emit_to_xyz +twiss3_propagate_all +twiss3_propagate1 +twiss3_from_twiss2 +twiss3_at_start + +File: modules/rad_6d_mod.f90 +rad_6d_mod +emit_6d +rad_damp_and_stoc_mats +rad1_damp_and_stoc_mats +rad_g_integrals + +File: modules/superimpose_mod.f90 +superimpose_mod +add_superimpose +split_this_lat +delete_underscore +adjust_super_slave_names +adjust_drift_names + +File: modules/rad_int_common.f90 +rad_int_common +no_cache$ +cache_no_misalign$ +rad_int_track_point_struct +rad_int_cache1_struct +rad_int_cache_struct +rad_int_info_struct +qromb_rad_int +propagate_part_way +calc_wiggler_g_params + +File: modules/dynamic_aperture_mod.f90 +dynamic_aperture_mod +dynamic_aperture_scan +set_branch_and_ele_for_omp +dynamic_aperture_point + +File: modules/attribute_mod.f90 +attribute_mod +does_not_exist$ +is_free$ +quasi_free$ +dependent$ +private$ +overlay_slave$ +field_master_dependent$ +ele_attribute_struct +attribute_free +procedure +procedure +procedure +attribute_index +procedure +procedure +attribute_name +procedure +procedure +attribute_index1 +attribute_index2 +attribute_name1 +attribute_name2 +attribute_info +init_attribute_name_array +init_short_attrib_array +init_attribute_name1 +has_orientation_attributes +attribute_type +attribute_units +string_attrib +switch_attrib_value_name +n_attrib_string_max_len +has_attribute +custom_attribute_ubound_index +set_custom_attribute_name +custom_ele_attrib_name_list +attribute_free1 +attribute_free2 +attribute_free3 +check_this_attribute_free +field_attribute_free + +File: modules/bmad_routine_interface.f90 +bmad_routine_interface +pointer_to_branch +pointer_to_branch_given_name +pointer_to_branch_given_ele +pointer_to_ele +procedure +procedure +procedure +procedure +apply_element_edge_kick_hook_def +check_aperture_limit_custom_def +distance_to_aperture_custom_def +ele_geometry_hook_def +wall_hit_handler_custom_def +em_field_custom_def +ele_to_fibre_hook_def +radiation_integrals_custom_def +init_custom_def +make_mat6_custom_def +time_runge_kutta_periodic_kick_hook_def +track1_bunch_hook_def +track1_custom_def +track_many_hook_def +track1_postprocess_def +track1_preprocess_def +track1_spin_custom_def +track1_wake_hook_def +pointer_to_ele1 +pointer_to_ele2 +pointer_to_ele3 +pointer_to_ele4 + +File: multiparticle/envelope_mod.f90 +envelope_mod +eps7 +limit +o +l +make_ykick_mat +make_sr_mats +diffusion_matrix_b +damping_matrix_d +transport_with_sr +transport_with_sr_and_ibs +make_v +integrated_mats +envelope_radints_ibs +envelope_radints +make_pbrh +ibs_matrix_c +beam_envelope_ibs +kubo_integrand +eigensys +ety +etyt +ety2 +etdiv + +File: multiparticle/ibs_mod.f90 +ibs_mod +ibs_sim_param_struct +ibs_lifetime_struct +ibs_maxratio_struct +eps_7 +space_limit +ibs_equib_rlx +ibs_equib_der +ibs_lifetime +ibs_delta_calc +ibs_rates1turn +ibs_blowup1turn +ibs1 +multi_coulomb_log +rclog_integrand +bl_via_vlassov +bl_via_mat + +File: multiparticle/ibs_rates_mod.f90 +ibs_rates_mod +ibs_struct +eps7 +limit +bjmt1 +bjmt_integrand +bane1 +integrand +mpxx1 +mpxx_integrand +mpzt1 +zot_integrand +cimp1 + +File: multiparticle/longitudinal_profile_mod.f90 +longitudinal_profile_mod +limit +psi_prime +psi_prime_sca +jac +solve_psi_adaptive +solve_psi_fixed_steps +integrate_psi +find_normalization +find_fwhm +get_bl_from_fwhm +set_pwd_ele +pwd_mat + +File: multiparticle/save_a_beam_step.f90 +save_a_beam_step + +File: multiparticle/save_a_bunch_step.f90 +save_a_bunch_step + +File: multiparticle/touschek_mod.f90 +touschek_mod +momentum_aperture_struct +eps7 +limit +touschek_lifetime +touschek_lifetime_ele_by_ele +touschek_lifetime_with_aperture +touschek_rate1_zap +integrand_zap +touschek_rate1 +integrand_base +integrand_base_cov +exp_bessi0 + +File: multiparticle/write_beam_floor_positions.f90 +write_beam_floor_positions + +File: multiparticle/reallocate_bunch.f90 +reallocate_bunch + +File: multiparticle/track_bunch_time.f90 +track_bunch_time + +File: multiparticle/bbi_kick.f90 +bbi_kick + +File: multiparticle/reallocate_beam.f90 +reallocate_beam + +File: multiparticle/set_emit_from_beam_init.f90 +set_emit_from_beam_init + +File: multiparticle/beam_file_io.f90 +beam_file_io +write_beam_file +write_ascii_beam_file +read_beam_file +read_beam_ascii + +File: multiparticle/beam_mod.f90 +beam_mod +track_beam +track_bunch +track1_bunch + +File: multiparticle/remove_dead_from_bunch.f90 +remove_dead_from_bunch + +File: multiparticle/gradient_shift_sr_wake.f90 +gradient_shift_sr_wake + +File: multiparticle/init_wake.f90 +init_wake + +File: multiparticle/transfer_wake.f90 +transfer_wake + +File: multiparticle/wake_mod.f90 +wake_mod +randomize_lr_wake_frequencies +zero_lr_wakes_in_lat +track1_lr_wake +sr_longitudinal_wake_particle +sr_transverse_wake_particle +sr_z_wake_particle +order_particles_in_z +track1_sr_wake + +File: multiparticle/beam_utils.f90 +beam_utils +track1_bunch_hom +init_beam_distribution +init_bunch_distribution +init_random_distribution +init_grid_distribution +init_ellipse_distribution +init_kv_distribution +combine_bunch_distributions +init_spin_distribution +calc_bunch_params_slice +calc_bunch_params_z_slice +calc_bunch_params +calc_emittances_and_twiss_from_sigma_matrix +calc_spin_params +calc_bunch_sigma_matrix_etc +bunch_init_end_calc + +File: parsing/binary_parser_mod.f90 +binary_parser_mod +write_binary_cartesian_map +read_binary_cartesian_map +write_binary_cylindrical_map +read_binary_cylindrical_map +write_binary_grid_field +read_binary_grid_field +open_binary_file + +File: parsing/converter_distribution_parser.f90 +converter_distribution_parser + +File: parsing/create_field_overlap.f90 +create_field_overlap + +File: parsing/create_girder.f90 +create_girder + +File: parsing/create_group.f90 +create_group + +File: parsing/init_bmad_parser_common.f90 +init_bmad_parser_common + +File: parsing/check_controller_controls.f90 +check_controller_controls + +File: parsing/create_overlay.f90 +create_overlay + +File: parsing/set_ele_defaults.f90 +set_ele_defaults + +File: parsing/write_digested_bmad_file.f90 +write_digested_bmad_file + +File: parsing/bmad_parser_mod.f90 +bmad_parser_mod +parser_set_attribute +get_called_file +add_this_taylor_term +parser_call_check +get_next_word +parser_file_stack +load_parse_line +evaluate_array_index +evaluate_logical +parse_evaluate_value +word_to_value +parser_add_constant +bmad_parser_string_attribute_set +parser_read_sr_wake +parser_read_lr_wake +parser_read_old_format_lr_wake +parser_read_old_format_sr_wake +get_list_of_names +get_overlay_group_names +verify_valid_name +parser_error +add_this_multipass +drift_multipass_name_correction +reallocate_bp_com_const +parser_add_superimpose +parser2_add_superimpose +compute_super_lord_s +check_for_superimpose_problem +get_sequence_args +parse_line_or_list +allocate_plat +parser_add_lords +drift_and_pipe_track_methods_adjustment +settable_dep_var_bookkeeping +form_digested_bmad_file_name +parser_add_branch +parser_identify_fork_to_element +parser_expand_line +bp_set_ran_status +parser_debug_print_info +parse_cartesian_map +parse_cylindrical_map +parse_grid_field +parse_gen_grad_map +parse_integer_list +parse_integer_list2 +parse_real_list +parse_real_matrix +parse_real_list2 +parser_get_integer +parser_get_logical +expect_this +get_switch +expect_one_of +equal_sign_here +parser_print_line +parser_init_custom_elements +reallocate_sequence +parse_superimpose_command +init_surface_segment +parser_transfer_control_struct +parser_fast_integer_read +parser_fast_complex_read +parser_fast_real_read + +File: parsing/bmad_parser2.f90 +bmad_parser2 + +File: parsing/bmad_parser_struct.f90 +bmad_parser_struct +n_parse_line +n_parse_line_extended +seq_ele_struct +base_line_ele_struct +seq_struct +f_maxx +stack_file_struct +parser_controller_struct +parser_ele_struct +parser_lat_struct +line$ +list$ +element$ +replacement_line$ +def$ +redef$ +bp_const_struct +bp_common_struct +bp_common2_struct + +File: parsing/create_feedback.f90 +create_feedback + +File: parsing/create_ramper.f90 +create_ramper + +File: parsing/bmad_parser.f90 +bmad_parser + +File: parsing/read_digested_bmad_file.f90 +read_digested_bmad_file + +File: photon/capillary_mod.f90 +capillary_mod +photon_coord_struct +photon_track_struct +track_a_capillary +capillary_track_photon_to_wall +capillary_propagate_photon_a_step +capillary_photon_hit_spot_calc +capillary_reflect_photon + +File: photon/crystal_attribute_bookkeeper.f90 +crystal_attribute_bookkeeper + +File: photon/init_a_photon_from_a_photon_init_ele.f90 +init_a_photon_from_a_photon_init_ele + +File: photon/make_mat6_bmad_photon.f90 +make_mat6_bmad_photon + +File: photon/photon_init_mod.f90 +photon_init_mod +photon_init_spline_pt_struct +photon_init_spline_struct +gen_poly_spline$ +end_spline$ +absolute_photon_position +bend_photon_init +bend_photon_energy_integ_prob +bend_vert_angle_integ_prob +bend_photon_polarization_init +bend_photon_vert_angle_init +bend_photon_e_rel_init +bend_photon_energy_normalized_probability +photon_init_spline_coef_calc +photon_init_spline_eval +e_crit_photon +init_photon_integ_prob + +File: photon/photon_init_spline_mod.f90 +photon_init_spline_mod +photon_init_x_angle_spline_struct +photon_init_y_angle_spline_struct +photon_init_splines_struct +photon_read_spline + +File: photon/photon_reflection_mod.f90 +photon_reflection_mod +cheb_diffuse_struct +converge +gmin +gmax +maxsum +ismax +bmax +diffuse_common_struct +photon_reflection_std_surface_init +finalize_reflectivity_table +read_surface_reflection_file +photon_reflectivity +photon_reflection +photon_diffuse_scattering +prob_x_diffuse +ptwo +zmmax +cos_phi +zzfi +zzfp +hzz +zbessi +zbessi1 +zbessi0 +zzexp +output_specular_reflection_input_params + +File: photon/tilt_coords_photon.f90 +tilt_coords_photon + +File: photon/track_a_drift_photon.f90 +track_a_drift_photon + +File: photon/track_to_surface.f90 +track_to_surface + +File: photon/photon_target_mod.f90 +photon_target_mod +photon_target_setup +photon_target_corner_calc +photon_add_to_detector_statistics +detector_pixel_pt +to_photon_angle_coords + +File: photon/to_surface_coords.f90 +to_surface_coords + +File: photon/track1_photon_mod.f90 +track1_photon_mod +track1_lens +track_a_patch_photon +track1_diffraction_plate_or_mask +track1_sample +point_photon_emission +track1_mirror +track1_multilayer_mirror +track1_mosaic_crystal +track1_crystal +crystal_h_misalign +target_rot_mats +target_min_max_calc +track_a_bend_photon + +File: photon/offset_photon.f90 +offset_photon + +File: photon/photon_utils_mod.f90 +photon_utils_mod +has_curvature +photon_type +z_at_surface +surface_grid_displacement +crystal_diffraction_field_calc +pointer_to_surface_segmented_pt +pointer_to_surface_displacement_pt + +File: photon/rotate_for_curved_surface.f90 +rotate_for_curved_surface + +File: photon/track1_bmad_photon.f90 +track1_bmad_photon + +File: ptc/fibre_to_ele.f90 +fibre_to_ele + +File: ptc/kill_ptc_layouts.f90 +kill_ptc_layouts + +File: ptc/lat_to_ptc_layout.f90 +lat_to_ptc_layout + +File: ptc/pointer_to_fibre.f90 +pointer_to_fibre + +File: ptc/ptc_bookkeeper.f90 +ptc_bookkeeper + +File: ptc/ptc_linear_isf_calc.f90 +ptc_linear_isf_calc + +File: ptc/ptc_map_with_radiation_mod.f90 +ptc_map_with_radiation_mod +ptc_rad_map_struct +ptc_setup_map_with_radiation +ptc_track_map_with_radiation +ptc_write_map_with_radiation +ptc_read_map_with_radiation +ptc_kill_map_with_radiation + +File: ptc/ptc_ran_seed_put.f90 +ptc_ran_seed_put + +File: ptc/ptc_read_flat_file.f90 +ptc_read_flat_file + +File: ptc/ptc_set_rf_state_for_c_normal.f90 +ptc_set_rf_state_for_c_normal + +File: ptc/ptc_spin_matching_calc.f90 +ptc_spin_matching_calc + +File: ptc/ptc_transfer_map_with_spin.f90 +ptc_transfer_map_with_spin + +File: ptc/set_ptc.f90 +set_ptc + +File: ptc/set_ptc_base_state.f90 +set_ptc_base_state + +File: ptc/update_fibre_from_ele.f90 +update_fibre_from_ele + +File: ptc/ptc_layout_mod.f90 +ptc_layout_mod +type_ptc_layout +branch_to_ptc_m_u +add_ptc_layout_to_list +ptc_setup_tracking_with_damping_and_excitation +ptc_one_turn_mat_and_closed_orbit_calc +ptc_emit_calc +ptc_spin_calc +ptc_track_all +ptc_closed_orbit_calc +ptc_one_turn_map_at_ele +ptc_map_to_normal_form +normal_form_taylors +normal_form_complex_taylors +normal_form_rd_terms +set_ptc_verbose +update_ele_from_fibre +ptc_calculate_tracking_step_size +ptc_layouts_resplit +ptc_check_for_lost_particle + +File: ptc/ele_to_taylor.f90 +ele_to_taylor + +File: ptc/ele_to_fibre.f90 +ele_to_fibre + +File: ptc/ptc_interface_mod.f90 +ptc_interface_mod +assignment +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +operator +procedure +operator +procedure +ptc_set_taylor_order_if_needed +taylor_plus_taylor +taylor_minus_taylor +map_coef +type_map1 +type_ptc_internal_state +type_ptc_fibre +type_end_stuff +kind_name +set_ptc_com_pointers +bmad_taylor_equal_damap +damap_equal_bmad_taylor +bmad_taylor_equal_real_8 +real_8_equal_bmad_taylor +ptc_taylor_equal_bmad_taylor +sigma_mat_ptc_to_bmad +universal_equal_universal +universal_to_bmad_taylor +complex_taylor_equal_c_taylor +complex_taylors_equal_c_taylors +bmad_taylor_equal_ptc_taylor +bmad_taylors_equal_ptc_taylors +form_complex_taylor +concat_real_8 +taylor_to_genfield +remove_constant_taylor +taylor_inverse +concat_taylor +concat_ele_taylor +taylor_to_real_8 +real_8_to_taylor +taylor_propagate1 +type_real_8_taylors +sort_universal_terms +type_map +beambeam_fibre_setup +misalign_ptc_fibre +bmad_patch_parameters_to_ptc +ele_to_ptc_magnetic_an_bn +apply_patch_to_ptc_fibre +set_ptc_quiet + +File: space_charge/csr3d_mod.f90 +csr3d_mod +csr3d_steady_state_solver +calc_density_derivative_complex +get_cgrn_csr3d +write_2d +ellipinc_test + +File: space_charge/fast_fourier_am.f90 +fast_fourier_am +ccfftam +fft1 +mfft1 +sfft + +File: space_charge/fft_interface_mod.f90 +fft_interface_mod +ccfft3d +mccfft1d + +File: space_charge/open_spacecharge_core_mod.f90 +open_spacecharge_core_mod +osc_freespace_solver +osc_alloc_freespace_array +coulombfun +igfcoulombfun +lafun +igfexfun +igfeyfun +igfezfun +xlafun +ylafun +zlafun +getrhotilde +osc_getgrnfree +conv3d +osc_rectpipe_solver +osc_getgrnpipe +rfun +fftconvcorr3d +osc_read_rectpipe_grn +osc_write_rectpipe_grn +osc_alloc_rectpipe_arrays +osc_cathodeimages_solver +osc_alloc_image_array +osc_getgrnimageshift +osc_getgrnimageconvcorr +imageconvcorr3d + +File: space_charge/open_spacecharge_mod.f90 +open_spacecharge_mod +mesh3d_struct +print_mesh3d +space_charge_freespace +space_charge_cathodeimages +space_charge_rectpipe +deposit_particles +interpolate_field +space_charge_3d +osc_freespace_solver2 +osc_get_cgrn_freespace + +File: space_charge/track1_bunch_space_charge.f90 +track1_bunch_space_charge + +File: space_charge/space_charge_mod.f90 +space_charge_mod +sc_field_calc +sc_step +sc_adaptive_step +track_bunch_to_s +track_bunch_to_t +drift_particle_to_s +drift_particle_to_t + +File: space_charge/high_energy_space_charge_mod.f90 +high_energy_space_charge_mod +setup_high_energy_space_charge_calc +track1_high_energy_space_charge +make_mat6_high_energy_space_charge + +File: space_charge/csr_and_space_charge_mod.f90 +csr_and_space_charge_mod +csr_ele_info_struct +csr_bunch_slice_struct +csr_kick1_struct +csr_particle_position_struct +csr_struct +track1_bunch_csr +csr_bin_particles +csr_bin_kicks +s_source_calc +lsc_kick_params_calc +i_csr +image_charge_kick_calc +csr_and_sc_apply_kicks +dspline_len +s_ref_to_s_chord +track1_bunch_csr3d + +File: spin/angle_between_polars.f90 +angle_between_polars + +File: spin/map1_inverse.f90 +map1_inverse + +File: spin/map1_make_unit.f90 +map1_make_unit + +File: spin/multipole_spin_tracking.f90 +multipole_spin_tracking + +File: spin/polar_to_spinor.f90 +polar_to_spinor + +File: spin/polar_to_vec.f90 +polar_to_vec + +File: spin/rotate_spin.f90 +rotate_spin + +File: spin/rotate_spin_a_step.f90 +rotate_spin_a_step + +File: spin/rotate_spin_given_field.f90 +rotate_spin_given_field + +File: spin/spin_depolarization_rate.f90 +spin_depolarization_rate + +File: spin/spin_dn_dpz_from_mat8.f90 +spin_dn_dpz_from_mat8 + +File: spin/spin_dn_dpz_from_qmap.f90 +spin_dn_dpz_from_qmap + +File: spin/spin_map1_normalize.f90 +spin_map1_normalize + +File: spin/spin_mat8_resonance_strengths.f90 +spin_mat8_resonance_strengths + +File: spin/spin_mat_to_eigen.f90 +spin_mat_to_eigen + +File: spin/spinor_to_polar.f90 +spinor_to_polar + +File: spin/spinor_to_vec.f90 +spinor_to_vec + +File: spin/vec_to_polar.f90 +vec_to_polar + +File: spin/vec_to_spinor.f90 +vec_to_spinor + +File: spin/sprint_spin_taylor_map.f90 +sprint_spin_taylor_map + +File: spin/valid_spin_tracking_method.f90 +valid_spin_tracking_method + +File: spin/spin_omega.f90 +spin_omega + +File: spin/spin_concat_linear_maps.f90 +spin_concat_linear_maps + +File: spin/spin_taylor_to_linear.f90 +spin_taylor_to_linear + +File: spin/spin_quat_resonance_strengths.f90 +spin_quat_resonance_strengths + +File: spin/track1_spin.f90 +track1_spin + +File: spin/track1_spin_bmad.f90 +track1_spin_bmad + +File: spin/track1_spin_taylor.f90 +track1_spin_taylor + +File: output/type_coord.f90 +type_coord + +File: output/type_twiss.f90 +type_twiss + +File: output/write_bmad_lattice_file.f90 +write_bmad_lattice_file + +File: output/write_lattice_file_mod.f90 +write_lattice_file_mod +multipass_region_ele_struct +multipass_region_branch_struct +multipass_region_lat_struct +multipass_region_info +write_line_element +re_str +array_re_str +cmplx_re_str +rchomp +write_lat_line +value_to_line +add_this_name_to_list + +File: output/write_lattice_in_elegant_format.f90 +write_lattice_in_elegant_format + +File: output/write_lattice_in_foreign_format.f90 +write_lattice_in_foreign_format + +File: output/write_lattice_in_julia.f90 +write_lattice_in_julia + +File: output/write_lattice_in_mad_format.f90 +write_lattice_in_mad_format + +File: output/write_lattice_in_sad_format.f90 +write_lattice_in_sad_format + +File: output/type_ele.f90 +type_ele diff --git a/bsim/searchf.namelist b/bsim/searchf.namelist index 26450c5891..eae650cb8d 100644 --- a/bsim/searchf.namelist +++ b/bsim/searchf.namelist @@ -513,12 +513,12 @@ sodom2_write_n sodom2_write_particles sodom2_check_n -File: spin_stroboscope/spin_stroboscope.f90 -spin_stroboscope - File: spin_stroboscope/track1_custom.f90 track1_custom +File: spin_stroboscope/spin_stroboscope.f90 +spin_stroboscope + File: synrad/synrad_plot_mod.f90 synrad_plot_mod plot_param_struct diff --git a/forest/searchf.namelist b/forest/searchf.namelist index a3c08034f0..0a6f5f1b77 100644 --- a/forest/searchf.namelist +++ b/forest/searchf.namelist @@ -2700,153 +2700,6 @@ remove_aperture_el remove_aperture_elp decode_element -File: code/Sr_spin.f90 -ptc_spin -assignment -procedure -alloc -procedure -procedure -track_probe2 -procedure -procedure -track_probe -procedure -procedure -procedure -procedure -track_node_probe_old -procedure -procedure -track_node_probe -procedure -procedure -track_node_x -procedure -procedure -track_node_v -procedure -track_probe_x -procedure -procedure -procedure -procedure -propagate -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -patch_spin -procedure -procedure -mis_spin -procedure -procedure -dtilt_spin -procedure -procedure -track_spin_front -procedure -procedure -track_spin_back -procedure -procedure -track_rotate_spin -procedure -procedure -track_wedge_spin -procedure -procedure -track_fringe_spin_multipole -procedure -procedure -track_fringe_spin -procedure -procedure -superdrift_spin -procedure -procedure -push_spin -procedure -procedure -push_spin_fake_fringe -procedure -procedure -fluc_spin -push_spin_fake_fringer -push_spin_fake_fringep -push_spinr -push_spinp -quaternion_to_damps -track_node_layout_flag_pr_t12_r -track_node_layout_flag_pr_t12_p -track_node_layout_flag_pr_s12_r -track_node_layout_flag_pr_s12_p -track_layout_flag_probe_spin12r -track_layout_flag_probe_spin12p -track_layout_flag_spin12r_x -track_layout_flag_spin12p_x -track_layout_flag_spint12r_x -track_layout_flag_spint12p_x -track_fill_ref -track_node_layout_flag_spin_v -track_node_layout_flag_spinr_x -track_node_layout_flag_spinp_x -track_node_flag_probe_quar -track_node_flag_probe_quap -track_node_flag_probe_wrap_r -track_node_flag_probe_wrap_p -track_node_flag_probe_r -track_node_flag_probe_p -track_fringe_spinr -track_fringe_spinp -track_wedge_spinr -track_wedge_spinp -track_rotate_spin_r -track_rotate_spin_p -track_fringe_spin_multipole_r -track_fringe_spin_multipole_p -track_spin_frontr -track_spin_frontp -track_spin_backr -track_spin_backp -superdrift_spinr -superdrift_spinp -patch_spinr -patch_spinp -mis_spinr -mis_spinp -dtilt_spinr -dtilt_spinp -stroboscopic_average -track_time -ptc_global_x_p -locate_temporal_probe -fit_temporal_probe -fit_temporal_probe_nocav -fit_temporal_probe_cav -ptc_print -find_frac_r -find_as -find_n0 -equal_temporal -alloc_temporal_beam -alloc_temporal_probe -track_temporal_beam -fill_tree_element -fill_tree_element_line -fill_tree_element_line_zhe0 -fill_tree_element_line_zhe0_node -fill_tree_element_line_zhe -set_tree_g_complex_zhe0 -symplectify_for_zhe0 -extract_moments -checksympglobal - File: code/Su_duan_zhe_map.f90 duan_zhe_map i_ @@ -2965,15 +2818,46 @@ dealloc_all_c danum_c danum0_c -File: code/Ci_tpsa.f90 -c_tpsa -ndim2t -compute_lattice_functions -procedure -procedure -abs_square -procedure -abs +File: code/Se_status.f90 +s_status +kind0 +kind1 +kind2 +kind3 +kind4 +kind5 +kind6 +kind7 +kind8 +kind9 +kind10 +kind11 +kind12 +kind13 +kind14 +kind15 +kind16 +kind17 +kind18 +kind19 +kind20 +kind21 +kind22 +kind23 +kindfitted +kinduser1 +kinduser2 +kindhel +kindwiggler +kindmu +kindpa +kindsuperdrift +kindabell +drift_kick_drift +matrix_kick_matrix +kick_sixtrack_kick +b_cyl +operator procedure assignment procedure @@ -2981,55 +2865,142 @@ procedure procedure procedure procedure +operator procedure procedure +operator procedure +make_states procedure procedure +check_aperture procedure procedure +check_s_aperture procedure procedure +check_s_aperture_out procedure procedure +init procedure +print procedure +alloc procedure procedure procedure +kill procedure procedure procedure +b2perp procedure procedure +orthonormalise procedure procedure +dtiltd procedure procedure +track_tree_g_complex procedure procedure +track_tree_probe_complex procedure procedure +null_a +alloc_a +dealloc_a +null_p +alloc_p +dealloc_p +kill_s_aperture +alloc_s_aperture +check_s_aperture_r +check_s_aperture_p +check_s_aperture_out_r +check_s_aperture_out_p +equal_a +equal_p +check_aperture_r +check_aperture_p +chkaperpolygon +minu +equaltilt +make_states_0 +print_curv +print_curv_elec +make_set_coef +clear_states +print_s +conv +make_states_m +update_states +equalt +equali +add +sub +para_rema +init_all +s_init +kill_map_cp +init_default +b2perpr +b2perpp +dtiltr_external +dtiltp_external +dd_p +set_s_b +set_s_e +set_s_b_mcmillan +set_s_e_mcmillan +get_bend_electric_coeff +get_bend_magnetic_potential +invert_laplace +make_coef +nul_coef +set_tree_g_complex +track_tree_probe_complexr +orthonormaliser +track_tree_probe_complexp_new +orthonormalisep +furman_rrt +track_tree_g_complexr +track_tree_g_complexp + +File: code/Sr_spin.f90 +ptc_spin +assignment procedure +alloc procedure procedure +track_probe2 procedure procedure +track_probe procedure procedure procedure procedure +track_node_probe_old procedure procedure +track_node_probe procedure procedure +track_node_x procedure procedure +track_node_v procedure +track_probe_x procedure procedure procedure procedure +propagate procedure procedure procedure @@ -3038,315 +3009,258 @@ procedure procedure procedure procedure +patch_spin procedure procedure +mis_spin procedure procedure +dtilt_spin procedure procedure +track_spin_front procedure procedure +track_spin_back procedure procedure -procedure -assignment -procedure -procedure -procedure -procedure -procedure -operator -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -operator -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -operator -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -operator -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -operator -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -operator -procedure -operator -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -operator -procedure -procedure -operator -procedure -procedure -procedure -operator -procedure -procedure -procedure -procedure -procedure -procedure -operator -procedure -procedure -operator -procedure -procedure -operator -procedure -operator -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -operator -procedure -operator -procedure -procedure -procedure -procedure -operator -procedure -operator -procedure -procedure -procedure -operator -procedure -procedure -procedure -procedure -procedure -procedure -operator -procedure -operator -procedure -operator -procedure -operator -procedure -operator -procedure -procedure -checksymp -procedure -q_part -procedure -c_phasor -procedure -ci_phasor -procedure -clean -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -c_simil -procedure -procedure -texp_inv -procedure -exp_inv -procedure -real -procedure -aimag -procedure -cget_field_c_universal_taylor -procedure -get_field_c_universal_taylor -procedure -exp_mat -procedure -procedure -exp -procedure -procedure -procedure +track_rotate_spin procedure procedure +track_wedge_spin procedure procedure -makequaternion +track_fringe_spin_multipole procedure -makeso3 procedure +track_fringe_spin procedure -average procedure -iexp +superdrift_spin procedure -texp procedure +push_spin procedure procedure +push_spin_fake_fringe procedure procedure +fluc_spin +push_spin_fake_fringer +push_spin_fake_fringep +push_spinr +push_spinp +quaternion_to_damps +track_node_layout_flag_pr_t12_r +track_node_layout_flag_pr_t12_p +track_node_layout_flag_pr_s12_r +track_node_layout_flag_pr_s12_p +track_layout_flag_probe_spin12r +track_layout_flag_probe_spin12p +track_layout_flag_spin12r_x +track_layout_flag_spin12p_x +track_layout_flag_spint12r_x +track_layout_flag_spint12p_x +track_fill_ref +track_node_layout_flag_spin_v +track_node_layout_flag_spinr_x +track_node_layout_flag_spinp_x +track_node_flag_probe_quar +track_node_flag_probe_quap +track_node_flag_probe_wrap_r +track_node_flag_probe_wrap_p +track_node_flag_probe_r +track_node_flag_probe_p +track_fringe_spinr +track_fringe_spinp +track_wedge_spinr +track_wedge_spinp +track_rotate_spin_r +track_rotate_spin_p +track_fringe_spin_multipole_r +track_fringe_spin_multipole_p +track_spin_frontr +track_spin_frontp +track_spin_backr +track_spin_backp +superdrift_spinr +superdrift_spinp +patch_spinr +patch_spinp +mis_spinr +mis_spinp +dtilt_spinr +dtilt_spinp +stroboscopic_average +track_time +ptc_global_x_p +locate_temporal_probe +fit_temporal_probe +fit_temporal_probe_nocav +fit_temporal_probe_cav +ptc_print +find_frac_r +find_as +find_n0 +equal_temporal +alloc_temporal_beam +alloc_temporal_probe +track_temporal_beam +fill_tree_element +fill_tree_element_line +fill_tree_element_line_zhe0 +fill_tree_element_line_zhe0_node +fill_tree_element_line_zhe +set_tree_g_complex_zhe0 +symplectify_for_zhe0 +extract_moments +checksympglobal + +File: code/cc_dabnew.f90 +c_dabnew +c_daall1 +c_daall +c_daall0 +c_dadal +c_dadal1 +c_davar +c_dacma +c_daini +dalc_lsta +daalc_lno1 +daall +daall1 +c_print_c_nda_dab_c_lda +c_etall1 +c_daall0 +dadal +c_dadal1 +c_count_da +c_davar +c_dacon +c_danot +c_daeps +c_print_eps +c_dapek +c_dapok +daclr +c_dacop +c_real_imag +c_daadd +c_datrunc +c_dasub +c_damul +damult +c_dadiv +dasqr +dasqrt +c_dacad +c_dacsu +c_dasuc +c_dacmu +dacmut +c_dacdi +c_dadic +dacma +dalin +dalint +c_daabs +dacctt1 +dacctt2tpsa +dacctt2da +c_dacctt2datest +c_dacct +dacctt +c_mtree +ppushprint +ppushstore +ppushgetn +ppush +ppush1 +dainvt1 +dainvt2 +c_dainv +dainvt +dapin +c_dapint +c_dader +dadert +c_dacfu +dacfut +c_dapri +c_clean_complex +c_dapri77 +c_dashift +c_darea +c_darea77 +dadeb +dainf +dapac +dachk +damch +dadcd +dancd +c_datra +hash +dehash +c_dacycle +c_dafun +dafunt +c_take +c_daran +c_dapek0 +c_dapok0 +c_etcom + +File: code/Ci_tpsa.f90 +c_tpsa +ndim2t +compute_lattice_functions +procedure procedure +abs_square procedure abs procedure -dabs +assignment procedure -exp procedure -dexp procedure -cexp procedure -cdexp procedure -log procedure procedure procedure procedure -ln procedure -cos procedure -cdcos procedure -dcos procedure -ccos procedure -sin procedure -cdsin procedure -ccsin procedure -dsin procedure -sqrt procedure -tan procedure -dtan procedure -c_pek procedure -c_pok procedure -shiftda procedure -cfu procedure -full_abs procedure -daread procedure procedure procedure procedure procedure procedure -read procedure procedure procedure procedure procedure procedure -daprint procedure procedure procedure @@ -3358,7 +3272,6 @@ procedure procedure procedure procedure -print procedure procedure procedure @@ -3373,24 +3286,23 @@ procedure procedure procedure procedure -daprint procedure procedure procedure -print procedure procedure procedure procedure procedure -alloc procedure procedure +assignment procedure procedure procedure procedure procedure +operator procedure procedure procedure @@ -3399,19 +3311,15 @@ procedure procedure procedure procedure -alloc_nn procedure -kill_nn procedure -matmul_nn procedure -matmulr_nn procedure procedure -kill procedure procedure procedure +operator procedure procedure procedure @@ -3424,1624 +3332,903 @@ procedure procedure procedure procedure -alloctpsa procedure -killtpsa procedure -ass procedure -alloc procedure procedure -kill procedure procedure -get_rf -c_get_indices -locally_set_da_pointers -c_count_taylor -unaryadd -unarysub -unarysub_vec -unarysub_q -unarysub_spinor -normalise_spinor -orthogonalise_spin_matrix -dotc_spinor -c_maketree -c_allocda -alloc_c_quaternion -kill_c_quaternion -c_a_opt -k_opt -a_opt_c_damap -k_opt_c_damap -a_opt_c_vector -k_opt_c_vector -c_allocdas -c_killda -c_killdas -alloc_c_damap -alloc_c_damaps -alloc_c_yu_w -kill_c_yu_w -alloc_c_vector_field -alloc_c_factored_lie -alloc_c_normal_form -kill_c_normal_form -kill_c_factored_lie -kill_c_damap -kill_c_damaps -kill_c_vector_field -alloc_c_spinmatrix -alloc_c_spinor -kill_c_spinor -kill_c_spinmatrix -c_real -c_aimag -equalc_t -equalt_c -equalc_ray_ray -equalc_ray_r6 -equalc_ray_r6r -equalc_r6_ray -equalc_r6r_ray -equalc_t_ct -equalc_ct_c -equalc_cmap_map -equalc_map_cmap -equal_c_spinmatrix_probe -equal_probe_c_spinmatrix -equal_c_spinmatrix_3_by_3 -equal_3_by_3_c_spinmatrix -equal_3_by_3_probe -equal_probe_3_by_3 -equalc_cvec_vec -equalc_cspinor_cspinor -equalc_spinor_c_quaternion -equalc_quaternion_c_spinor -equalc_spinor_cspinor -equalc_cspinor_spinor -c_dpekmap -c_dpokmap -equal -equal_map_real8 -equal_map_complex8 -equal_real8_map -equal_complex8_map -equal_c_tayls -equalspinmatrix -cdequal -dequal -requal -daabsequal -cdequaldacon -dequaldacon -dequaldacons -equaldacon -iequaldacon -dexpt -c_logt -flatten_c_factored_lie_r -flatten_c_factored_lie -c_logf_spin -c_logf -c_logc -get_log -full_abst -dtant -dcost -dsint -sqrtt -mul -pbbra -cpbbra -liebraquaternion -liebra -getorder -getordermap -getorderquaternion -getorderspinmatrix -getordervec -from_phasor -to_phasor -cutorder -cutordermap -cutordervec -cutorderspin -cutorderquaternion -cutorderspinor -dputchar -dputcharr -dputint -dputintr -c_dputint0 -c_dputint0r -getcharnd2s -getintnd2s -getintk -getchar -getint -getintmat -getdiff -getdiff_universal -getintegrate -getpb -cgetpb -getpb_from_transverse -derive -getvectorfield -getvectorfield_universal -cgetvectorfield_universal -cgetvectorfield -getdatra -pow -cdmulsc -dmulsc -mulsc -imulsc -cdscmul -dscmul -scmul -iscmul -div -cdscdiv -dscdiv -scdiv -iscdiv -cddivsc -ddivsc -divsc -idivsc -add -addq -absq2 -absq -mulq -mulcq -subq -c_invq -powq -powql -equalq -equalq_c_r -equalq_r_c -equalql_i -equalql_r -qua_ql -equal_c_l_f -compute_lattice_functions_2 -compute_lattice_functions_1 -equalql_c_spin -equalql_q -equalql_cmap -equalcmap_ql -equalq_ql -equal_c_quaternion_complex_quaternion -equal_complex_quaternion_c_quaternion -equalql_ql -print_ql -inv_symplectic66 -inv_c_linear_map -inv_c_linear_map_symplectic -mulqdiv -mul_ql_m -mul_ql_cm -addql -mulql -subql -equalq_c_8 -equalq_8_c -equalq_r -equalq_i -matrix_to_quaternion_in_c_damap -quaternion_to_matrix_in_c_damap -c_linear_map_to_matrix -cdaddsc -daddsca -addsc -iaddsc -cdscadd -dscadd -scadd -iscadd -subs -cdsubsc -dsubsc -subsc -isubsc -cdscsub -dscsub -scsub -iscsub -varf -varf001 -shift000 -c_pek000 -c_pok000 -c_taylor_ran -c_cfu000 -c_taylor_eps -getcharnd2 -getintnd2_universal -lfilter -getintnd2 -getintnd2t -c_taylor_cycle -c_cycle -c_check_snake -check_j -check_harmonic_order -filter -c_filter_part -c_pri_c_ray -pri_matrix -c_pri_matrix -c_pri_map -print_e_ij -c_pri_quaternion -c_read_quaternion -c_read_map -c_pri_vec -c_pri_factored_lie -c_pri_spinmatrix -c_read_spinmatrix -c_full_norm_spin -c_norm_spin -c_pri_spinor -c_read_spinor -c_pri -printcomplex -printpoly -print6 -daprinttaylors -c_rea -dareadtaylors -c_crap1 -c_real_stop -c_ndum_warning_user -set_up -de_set_up -null_it -line_l -ring_l -append_da -insert_da -c_alloc_da -kill_dalevel -dealloc_dascratch -set_up_level -c_report_level -c_assign -c_deassign -c_asstaylor -c_ass0 -c_assmap -c_ass_quaternion -c_ass_spinmatrix -c_ass_spinor -c_ass_vector_field -c_norm -c_clean_yu_w -clean_matrix_complex -clean_vector_complex -clean_matrix -clean_vector -c_clean_taylor -c_clean_linear_map -c_clean_spinmatrix -c_clean_quaternion -c_clean_spinor -c_clean_damap -c_clean_cm -c_clean_c_factored_lie -c_clean_vector_field -clean_c_universal_taylor -c_bmad_reinit -c_init -init_map_all -c_init_all -c_etcct -c_etinv -c_etpin -transform_vector_field_by_map -c_concat -c_concat_tpsa -c_adjoint -c_adjoint_vec -c_spinmatrix_spinmatrix -c_spinmatrix_mul_cray -c_quaternion_mul_cray -c_spinmatrix_spinor -c_transpose -c_spinor_cmap -c_spinor_cmap_tpsa -c_complex_spinmatrix -c_spinmatrix_add_spinmatrix -c_spinmatrix_sub_spinmatrix -c_spinor_add_spinor -c_spinor_sub_spinor -c_taylor_spinor -c_complex_spinor -c_real_spinor -c_spinor_spinor -c_trxspinmatrix -c_trxquaternion -c_trxquaternion_tpsa -c_trxspinmatrixda -c_trxtaylor -c_trxtaylor_da -c_concat_spinor_ray -c_concat_spinmatrix_ray -c_concat_quaternion_ray -c_concat_c_ray -c_concat_map_ray -c_concat_vector_field_ray -c_bra_v_ct -c_bra_v_q -c_bra_v_dm -powmap -powmap_inv -pow_tpsamap -pow_tpsamapnew -powmaps -c_equalmap -c_map_vec -c_equalvec -c_equalcray -c_identityequalmap -c_zero_constant_in_map -c_identityequalspin -c_identityequalspinor -c_identityequalvec -c_identityequalfactored -matrixmapr -r_matrixmapr -matrixvecfr -r_matrixvecfr -mapmatrixr -r_mapmatrixr -c_linear_a -c_linear_a_stoch -c_locate_planes -c_locate_modulated_magnet_planes -c_linear_ac_longitudinal -c_gofix -c_factor_map -c_canonise -c_full_canonise -c_identify_resonance -c_full_factorise -c_normal_spin_linear_quaternion -c_normal_spin_linear -c_convert_spin -coast -c_normal_radiation -c_stochastic_kick -check_kernel -check_resonance -check_resonance_spin -c_kernel -c_average -c_expflo_fac -c_expflo_fac_inv -c_add_map -c_sub_map -c_1_vf_q -c_1_map -c_add_vf -c_sub_vf -real_mul_map -complex_mul_map -real_mul_vec -complex_mul_vec -c_taylor_mul_vec -map_mul_vec_q -map_mul_vec -exp_ad -iexp_ad -c_expflo_map -c_expflo -c_flofacg -c_find_n0 -c_n0_to_nr -c_nr_to_n0 -c_q0_to_qr -c_qr_to_q0 -c_find_om_da -c_find_as -c_inv_as -c_find_spin_angle -c_log_spinmatrix -c_vector_field_quaternion -c_exp_spinmatrix -c_exp_quaternion -c_exp_vectorfield_on_quaternion -c_full_norm_damap -c_full_norm_spin_map -c_full_norm_spinmatrix -c_full_norm_quaternion -c_norm_spinmatrix -c_full_norm_vector_field -c_full_norm_spinor -c_full_norm_fourier -c_check_rad -c_check_rad_spin -c_exp_mat_ -c_norm_matrix -exp_mat_ -norm_matrix -c_eig6 -ety -etyt -ety2 -etdiv -teng_edwards_a1 -c_int_partial -copy_damap_matrix -invert_22 -dagger_22 -matmulr_33 -matmult_33 -matmul_33 -dalloc_33t -prin_33t -dkill_33t -copy_matrix_matrix -extract_linear_from_normalised -extract_a0 -extract_only_a0 -extract_a1 -extract_only_a1 -extract_a2 -factor_ely_rest -c_remove_y_rot -produce_orthogonal -orthogonalise_ray -c_identityequalvecfourier -equal_c_vector_field_fourier -alloc_c_vector_field_fourier -kill_c_vector_field_fourier -transform_vector_field_fourier_by_map -exp_vector_field_fourier -ddt_vector_field_fourier -print_vector_field_fourier -print_poisson_bracket_fourier -bra_vector_field_fourier -add_vector_field_fourier -mulc_vector_field_fourier -c_clean_vector_field_fourier -c_clean_taylors -c_evaluate_vector_field_fourier -create_rotation_linear_field -normalise_vector_field_fourier_factored -symplectify_for_sethna -nth_root -alloc_node_array_tpsa -kill_node_array_tpsa -kill_node_array -alloc_node_array -get_c_yu_w -transform_c_yu_w -c_fast_canonise -canonize_damping -extract_a0_mat -set_tree_g_complex_zhe -set_tree_g_complex_zhe_as_is -fill_tree_element_line_zhe_outside_map -compute_lie_map_matrix_complex -compute_lie_map_matrix -create_taylor_vector -init_moment_map -create_moment_map_one -create_vector_field -create_moment_map_one_complex -create_moment_map -create_yu_map -norm_moment_matrix -matinvn -ludcmp_nr0n -lubksb_nr0n -copy_tree_into_tree_zhe -print_tree_element -print_tree_elements -read_tree_element -read_tree_elements -symplectify_for_zhe -furman_symp -furman_step -checksympn -cholesky_dt -c_kill_uni -c_kill_unis -c_null_uni -c_alloc_u -c_alloc_us -c_get_coeff -c_fill_uni_r -c_fill_uni -c_fill_uni_complextaylor -c_concat_c_uni_ray -c_concat_c_uni_rays -c_equal_uni -c_refill_uni -c_printunitaylors -c_printunitaylor_old -r_field_for_demin -d_field_for_demin -c_uni_reorder -d_mod_demin -check_re -symplectify_general -normalise_vector_field_fourier -check_resonance_ham -check_kernel_spin1 -c_normal -c_normal_new -c_normal_new_no_fac - -File: code/Sh_def_kind.f90 -s_def_kind -n_enge -radiate_2_force -procedure -procedure -rad_spin_qua_probe -procedure -procedure -rad_spin_force_probe -procedure -procedure -track_slice_sol5 -procedure -procedure -track_slice_dkd2 -procedure -procedure -track_slice_dkd2_old -procedure -procedure -track_slice_tktf -procedure -procedure -track_slice_sagan -procedure -procedure -track_slice_cav4 -procedure -procedure -track_slice_pancake -procedure -procedure -feval_cav_bmad_probe -procedure -procedure -feval_sagan_probe -procedure -procedure -rk2_sagan_probe -procedure -procedure -rk4_sagan_probe -procedure -procedure -rk6_sagan_probe -procedure -procedure -rk2bmad_cav_probe -procedure -procedure -rk4bmad_cav_probe -procedure -procedure -rk6bmad_cav_probe -procedure -procedure -track_slice_cav4_old -procedure -procedure -track_slice_teapot -procedure -procedure -track_slice_teapot_old -procedure -procedure -track_slice_strex -procedure -procedure -track_slice_strex_old -procedure -procedure -track_slice -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -fake_shift -procedure -procedure -fringe_hel -procedure -procedure -patch_drift -procedure -procedure -get_z_ab -procedure -procedure -adjust_abell -procedure -procedure -adjust_pancake -procedure -procedure -track_fringe -procedure -procedure -fringe_teapot -procedure -procedure -fringe_strex -procedure -procedure -get_z_cav -procedure -procedure -track -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -drift -procedure -procedure -sympintex -procedure -procedure -monti -procedure -procedure -rcollimatori -procedure -procedure -ecollimatori -procedure -procedure -kickcav -procedure -procedure -abmad_trans -procedure -procedure -a_trans -procedure -procedure -procedure -feval_cav -procedure -procedure -feval_cav_imp -procedure -rk1bmad_cav_imp -procedure -feval_cav_bmad -procedure -procedure -feval_teapot -procedure -procedure -feval_abell -procedure -procedure -rk2_abell -procedure -procedure -rk4_abell -procedure -procedure -rk6_abell -procedure -procedure -rk2_cav_trav -procedure -procedure -rk2bmad_cav -procedure -procedure -rk4_cav_trav -procedure -procedure -rk4bmad_cav -procedure -procedure -rk6_cav_trav -procedure -procedure -rk6bmad_cav -procedure -procedure -rk2_teapot -procedure -procedure -feval_teapot_qua -procedure -procedure -rk2_teapot_probe -procedure -procedure -rk4_teapot_probe -procedure -procedure -rk6_teapot_probe -procedure -procedure -rk4_teapot -procedure -procedure -rk6_teapot -procedure -procedure -fringecav -procedure -procedure -adjust_time_cav4 -procedure -procedure -adjust_time_cav_trav_out -procedure -procedure -fringecav_trav -procedure -procedure -fringe_cav_trav -procedure -procedure -cavity -procedure -procedure -multipole_fringe -procedure -procedure -fringe_dipole -procedure -procedure -face -procedure -procedure -procedure -procedure -edge -procedure -procedure -kick -procedure -procedure -kickex -procedure -procedure -elliptical_b -procedure -procedure -inte -procedure -procedure -inte_strex -procedure -procedure -kick_sol -procedure -procedure -fringe2quad -procedure -procedure -getmulb_sol -procedure -procedure -getnewb -procedure -procedure -kickmul -procedure -procedure -intesol -procedure -procedure -septtrack -procedure -procedure -copy -procedure -procedure -procedure -procedure -procedure -procedure -pointers_abell -procedure -procedure -pointers_pancake -procedure -procedure -assignment -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -procedure -alloc -procedure -procedure -procedure -kill -procedure -procedure -procedure -expcosy6 -procedure -procedure -getmat -procedure -procedure -intktk -procedure -procedure -pushktk -procedure -procedure -kickktk -procedure -procedure -expcosy -procedure -procedure -expcosy7 -procedure -procedure -getmat7 -procedure -procedure -pushtkt7 -procedure -procedure -kicktkt7 -procedure -procedure -kickpath -procedure -procedure -procedure -procedure -procedure -procedure -inttkt7 -procedure -procedure -getanbn -procedure -procedure -getaebe -procedure -procedure -getelectric -procedure -procedure -procedure -procedure -getmagnetic -procedure -procedure -sprot -procedure -procedure -ssec -procedure -procedure -ssech1 -procedure -procedure -spar -procedure -procedure -skick -procedure -procedure -sinte -procedure -procedure -wedge -procedure -procedure -wedge_int -procedure -procedure -fx -procedure -procedure -fx_newc -procedure -procedure -fxc -procedure -procedure -step_symp_p_pancake -procedure -procedure -feval_pancake -procedure -procedure -feval_pancake_probe -procedure -procedure -rk4_pancake_probe -procedure -procedure -rk6_pancake_probe -procedure -procedure -rk4_pancake -procedure -procedure -rk6_pancake -procedure -procedure -rks_pancake -procedure -procedure -compute_f4 -procedure -procedure -compute_f4e -procedure -procedure -compute_f4s -procedure -procedure -drift -procedure -procedure -kick_he -procedure -procedure -get_field -procedure -procedure -get_bfield_fringe -procedure -procedure -get_bz_fringe -procedure -procedure -get_bfield -procedure -procedure -b_pancake -procedure -procedure -get_be_cav -procedure -procedure -b_para_perp -procedure -procedure -direction_v -procedure -procedure -push_quaternion -procedure -procedure -get_omega_spin -procedure -procedure -radiate_2 -procedure -procedure -radiate_2_probe -procedure -procedure -makeso3 -procedure -procedure -patch_driftr -patch_driftp -inter_drift1 -intep_drift1 -inter_superdrift -intep_superdrift -super_drift_p -super_drift_r -drift_inter -drift_intep -fringe_straightr -fringe_straightp -adjust_time_cav4r -adjust_time_cav4p -track_slice4r -inte_cav4r -inte_cav4p -track_slice4p -caver -check_symplectic_bmad_cavity -cavep -cavityr -cavityp -abmad_transr -abmad_transp -feval_cav_bmadr -feval_cav_bmadp -get_z_abr -get_z_abp -inter_abell_slice -intep_abell_slice -interabell -intepabell -rk2abellr -rk4abellr -rk6abellr -rk2abellp -rk4abellp -rk6abellp -rk2bmad_cavr -rk4bmad_cavr -rk6bmad_cavr -rk2bmad_cavp -rk4bmad_cavp -rk6bmad_cavp -inte_cavbmad4r -inte_cavbmad4p -fringecavr -fringecavp -kickcavr -kickcavp -driftr -driftp -kicktr -kicktp -multipole_fringer -multipole_fringep -newfacer -newfacep -facer -facep -fringe_dipoler -fringe_dipolep -fringe2quadr -fringe2quadp -edger -edgep -kickr -kickp -inter_dkd2 -intep_dkd2 -inter -intep -sympintr -sympintp -kick_solr -kick_solp -getnewbr -getnewbp -getmulb_solr -getmulb_solp -kickmulr -kickmulp -inter_sol5 -intep_sol5 -intesolr -intesolp -sympintsolr -sympintsolp -getmatr -getmatd -expr -expd -expcosy6r -expcosy6d -inter_ktk -intep_ktk -intktkr -intktkd -pushktkr -pushktkd -kickktkr -kickktkp -sympintktkr -sympintktkd -getmat7r -getmat7d -pushtkt7r -pushtkt7d -kicktkt7r -kicktkt7p -kickpath6r -kickpath6p -kickpathr -kickpathd -inte_tktfr -inte_tktfp -inttkt7r -inttkt7d -sympinttkt7r -sympinttkt7d -expr7 -expd7 -push_nsmi_r -push_nsmi_d -push_ssmi_r -push_ssmi_d -getaeber -getaebep -getmagneticr -getmagneticp -getelectricr -getelectricp -feval_teapotr -feval_teapotp -rk2_teapotr -rk2_teapotp -rk4_teapotr -rk4_teapotp -rk6_teapotr -rk6_teapotp -ssech1r -ssech1p -sprotr -sprotp -ssecr -ssecp -skickr -skickp -inter_teapot -intep_teapot -sinter -sintep -checkpotknob -makepotknob -makepotknob_elec -unmakepotknob -unmakepotknob_elec -fringe_teapotr -fringe_teapotp -ssympintr -ssympintp -montr -montp -montir -montip -rcollimatorr -rcollimatorp -rcollimatorir -rcollimatorip -ecollimatorr -ecollimatorp -ecollimatorir -ecollimatorip -electric_field_septumr -electric_field_septump -sepr -sepp -sympsepr -sympsepp -f_prof -set_f_in_k16 -kickexr -kickexp -inte_strexr -inte_strexp -inteexr -inteexp -fringe_strexr -fringe_strexp -sympintexr -sympintexp -sparr -sparp -check_root_drift -wedger -wedge_intr -wedge_intp -wedgep -adjust_time_cav_trav_outr -adjust_time_cav_trav_outp -get_z_cavr -get_z_cavp -inter_cav_trav -intep_cav_trav -caver_trav -cavep_trav -fringecav_travr -fringecav_travp -fringe_cav_travr -fringe_cav_travp -zeror_cav_trav -zerop_cav_trav -zeror_mon -zerop_mon -zeror_rcol -zerop_rcol -zeror_ecol -zerop_ecol -zeror_dkd2 -zerop_dkd2 -zeror_sol5 -zerop_sol5 -zeror_ktk -zerop_ktk -allocktk -killktk -zeror_tkt7 -zerop_tkt7 -alloctkt7 -killtkt7 -zeror_teapot -zerop_teapot -zero_cav4r -zero_cav4p -zero_abellr -feval_abellr -feval_abellp -zero_abellp -zeror_superdrift -zerop_superdrift -zeror_ramp -alloc_acceleration -alloc_tableau -kill_tableau -kill_acceleration -nullify_acceleration -copy_tableau -copy_acceleration -lecture_fichier -alloc_ramping -alloc_table -kill_table -kill_ramping -nullify_ramping -copy_table -copy_ramping -reading_file -zeror_kickt3 -zerop_kickt3 -zeror_strex -zerop_strex -allocteapot -killteapot -fx_newcr -fx_newcp -fxr_canonical -fxp_canonical -fxr -fxp -zeror_pancake -zerop_pancake -pointers_pancaker -pointers_pancakep -pointers_abellr -pointers_abellp -copyabell_el_elp -copyabell_el_el -copyabell_elp_el -copypancake_el_elp -copypancake_el_el -copypancake_elp_el -reset_pa -reset_abell -step_symp_p_pancaker -step_symp_p_pancakep -feval_pancaker -feval_pancakep -rks_pancaker -rks_pancakep -rk4_pancaker -rk4_pancakep -rk6_pancakep -rk6_pancaker -adjust_abellr -adjust_abellp -adjust_pancaker -adjust_pancakep -inter_pancake -intep_pancake -intpancaker -intpancakep -feval_cav_impr -rk1bmad_cav_impr -feval_cavr -feval_cavp -a_transl -a_transr -a_transp -rk2_cavr -rk2_cavp -rk4_cavr -rk4_cavp -rk6_cavr -rk6_cavp -zeror_he22 -zerop_he22 -compute_f4gr -compute_f4gp -compute_f4r -compute_f4p -compute_f4rold -compute_f4pold -kickr_he -kickp_he -intr_he -intp_he -fake_shiftr -fringe_helr -fringe_help -fake_shiftp -intr_he_tot -intp_he_tot -kickpathr_he -kickpathr_he_exact_nonsymp -kickpathp_he_exact_nonsymp -kickpathp_he -driftr_he -driftp_he -enge_f -zeror_enge -zerop_enge -elliptical_b_r -elliptical_b_p -get_fieldr -get_fieldp -get_bfield_fringer -get_bfield_fringep -get_bz_fringer -get_bz_fringep -get_bfieldr -get_bfieldp -b_pancaker -b_pancakep -get_be_cavr -get_be_cavp -b_para_perpr -b_para_perpp -direction_vr -direction_vp -get_omega_spinr -get_omega_spinp -radiate_2_forcer -radiate_2_forcep -radiate_2_prober -radiate_2_probep -radiate_2r -radiate_2p -crossp -quaternion_r_to_matrix -quaternion_8_to_matrix -feval_sagan_prober -feval_sagan_probep -rk2_sagan_prober -rk2_sagan_probep -rk4_sagan_prober -rk4_sagan_probep -rk6_sagan_prober -rk6_sagan_probep -feval_cav_bmad_prober -feval_cav_bmad_probep -rk2bmad_cav_prober -rk2bmad_cav_probep -rk4bmad_cav_prober -rk4bmad_cav_probep -rk6bmad_cav_prober -rk6bmad_cav_probep -feval_teapot_quar -feval_teapot_quap -rk2_teapot_prober -rk4_teapot_prober -rk6_teapot_prober -rk2_teapot_probep -rk4_teapot_probep -rk6_teapot_probep -inte_pancake_prober -inte_pancake_probep -rk4_pancake_prober -rk4_pancake_probep -rk6_pancake_prober -rk6_pancake_probep -feval_pancake_prober -feval_pancake_probep -inte_cav4_prober -inte_cav4_probep -inte_teapot_prober -inte_teapot_probep -inte_tktf_prober -inte_tktf_probep -inte_strex_prober -inte_strex_probep -inte_sol5_prober -inte_sol5_probep -inte_dkd2_prober -rad_spin_force_prober -rad_spin_force_probep -radiate_envelope -rad_spin_qua_prober -rad_spin_qua_probep -kick_stochastic_before -kick_stochastic_after -clear_compute_stoch_kick -inte_dkd2_probep -push_quaternionr -push_quaternionp -int_sagan_prober -int_sagan_probep - -File: code/cc_dabnew.f90 -c_dabnew -c_daall1 -c_daall -c_daall0 -c_dadal -c_dadal1 -c_davar -c_dacma -c_daini -dalc_lsta -daalc_lno1 -daall -daall1 -c_print_c_nda_dab_c_lda -c_etall1 -c_daall0 -dadal -c_dadal1 -c_count_da -c_davar -c_dacon -c_danot -c_daeps -c_print_eps -c_dapek -c_dapok -daclr -c_dacop -c_real_imag -c_daadd -c_datrunc -c_dasub -c_damul -damult -c_dadiv -dasqr -dasqrt -c_dacad -c_dacsu -c_dasuc -c_dacmu -dacmut -c_dacdi -c_dadic -dacma -dalin -dalint -c_daabs -dacctt1 -dacctt2tpsa -dacctt2da -c_dacctt2datest -c_dacct -dacctt -c_mtree -ppushprint -ppushstore -ppushgetn -ppush -ppush1 -dainvt1 -dainvt2 -c_dainv -dainvt -dapin -c_dapint -c_dader -dadert -c_dacfu -dacfut -c_dapri -c_clean_complex -c_dapri77 -c_dashift -c_darea -c_darea77 -dadeb -dainf -dapac -dachk -damch -dadcd -dancd -c_datra -hash -dehash -c_dacycle -c_dafun -dafunt -c_take -c_daran -c_dapek0 -c_dapok0 -c_etcom +operator +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +operator +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +operator +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +operator +procedure +operator +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +operator +procedure +procedure +operator +procedure +procedure +procedure +operator +procedure +procedure +procedure +procedure +procedure +procedure +operator +procedure +procedure +operator +procedure +procedure +operator +procedure +operator +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +operator +procedure +operator +procedure +procedure +procedure +procedure +operator +procedure +operator +procedure +procedure +procedure +operator +procedure +procedure +procedure +procedure +procedure +procedure +operator +procedure +operator +procedure +operator +procedure +operator +procedure +operator +procedure +procedure +checksymp +procedure +q_part +procedure +c_phasor +procedure +ci_phasor +procedure +clean +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +c_simil +procedure +procedure +texp_inv +procedure +exp_inv +procedure +real +procedure +aimag +procedure +cget_field_c_universal_taylor +procedure +get_field_c_universal_taylor +procedure +exp_mat +procedure +procedure +exp +procedure +procedure +procedure +procedure +procedure +procedure +procedure +makequaternion +procedure +makeso3 +procedure +procedure +average +procedure +iexp +procedure +texp +procedure +procedure +procedure +procedure +procedure +procedure +procedure +abs +procedure +dabs +procedure +exp +procedure +dexp +procedure +cexp +procedure +cdexp +procedure +log +procedure +procedure +procedure +procedure +ln +procedure +cos +procedure +cdcos +procedure +dcos +procedure +ccos +procedure +sin +procedure +cdsin +procedure +ccsin +procedure +dsin +procedure +sqrt +procedure +tan +procedure +dtan +procedure +c_pek +procedure +c_pok +procedure +shiftda +procedure +cfu +procedure +full_abs +procedure +daread +procedure +procedure +procedure +procedure +procedure +procedure +read +procedure +procedure +procedure +procedure +procedure +procedure +daprint +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +print +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +daprint +procedure +procedure +procedure +print +procedure +procedure +procedure +procedure +procedure +alloc +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +alloc_nn +procedure +kill_nn +procedure +matmul_nn +procedure +matmulr_nn +procedure +procedure +kill +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +alloctpsa +procedure +killtpsa +procedure +ass +procedure +alloc +procedure +procedure +kill +procedure +procedure +get_rf +c_get_indices +locally_set_da_pointers +c_count_taylor +unaryadd +unarysub +unarysub_vec +unarysub_q +unarysub_spinor +normalise_spinor +orthogonalise_spin_matrix +dotc_spinor +c_maketree +c_allocda +alloc_c_quaternion +kill_c_quaternion +c_a_opt +k_opt +a_opt_c_damap +k_opt_c_damap +a_opt_c_vector +k_opt_c_vector +c_allocdas +c_killda +c_killdas +alloc_c_damap +alloc_c_damaps +alloc_c_yu_w +kill_c_yu_w +alloc_c_vector_field +alloc_c_factored_lie +alloc_c_normal_form +kill_c_normal_form +kill_c_factored_lie +kill_c_damap +kill_c_damaps +kill_c_vector_field +alloc_c_spinmatrix +alloc_c_spinor +kill_c_spinor +kill_c_spinmatrix +c_real +c_aimag +equalc_t +equalt_c +equalc_ray_ray +equalc_ray_r6 +equalc_ray_r6r +equalc_r6_ray +equalc_r6r_ray +equalc_t_ct +equalc_ct_c +equalc_cmap_map +equalc_map_cmap +equal_c_spinmatrix_probe +equal_probe_c_spinmatrix +equal_c_spinmatrix_3_by_3 +equal_3_by_3_c_spinmatrix +equal_3_by_3_probe +equal_probe_3_by_3 +equalc_cvec_vec +equalc_cspinor_cspinor +equalc_spinor_c_quaternion +equalc_quaternion_c_spinor +equalc_spinor_cspinor +equalc_cspinor_spinor +c_dpekmap +c_dpokmap +equal +equal_map_real8 +equal_map_complex8 +equal_real8_map +equal_complex8_map +equal_c_tayls +equalspinmatrix +cdequal +dequal +requal +daabsequal +cdequaldacon +dequaldacon +dequaldacons +equaldacon +iequaldacon +dexpt +c_logt +flatten_c_factored_lie_r +flatten_c_factored_lie +c_logf_spin +c_logf +c_logc +get_log +full_abst +dtant +dcost +dsint +sqrtt +mul +pbbra +cpbbra +liebraquaternion +liebra +getorder +getordermap +getorderquaternion +getorderspinmatrix +getordervec +from_phasor +to_phasor +cutorder +cutordermap +cutordervec +cutorderspin +cutorderquaternion +cutorderspinor +dputchar +dputcharr +dputint +dputintr +c_dputint0 +c_dputint0r +getcharnd2s +getintnd2s +getintk +getchar +getint +getintmat +getdiff +getdiff_universal +getintegrate +getpb +cgetpb +getpb_from_transverse +derive +getvectorfield +getvectorfield_universal +cgetvectorfield_universal +cgetvectorfield +getdatra +pow +cdmulsc +dmulsc +mulsc +imulsc +cdscmul +dscmul +scmul +iscmul +div +cdscdiv +dscdiv +scdiv +iscdiv +cddivsc +ddivsc +divsc +idivsc +add +addq +absq2 +absq +mulq +mulcq +subq +c_invq +powq +powql +equalq +equalq_c_r +equalq_r_c +equalql_i +equalql_r +qua_ql +equal_c_l_f +compute_lattice_functions_2 +compute_lattice_functions_1 +equalql_c_spin +equalql_q +equalql_cmap +equalcmap_ql +equalq_ql +equal_c_quaternion_complex_quaternion +equal_complex_quaternion_c_quaternion +equalql_ql +print_ql +inv_symplectic66 +inv_c_linear_map +inv_c_linear_map_symplectic +mulqdiv +mul_ql_m +mul_ql_cm +addql +mulql +subql +equalq_c_8 +equalq_8_c +equalq_r +equalq_i +matrix_to_quaternion_in_c_damap +quaternion_to_matrix_in_c_damap +c_linear_map_to_matrix +cdaddsc +daddsca +addsc +iaddsc +cdscadd +dscadd +scadd +iscadd +subs +cdsubsc +dsubsc +subsc +isubsc +cdscsub +dscsub +scsub +iscsub +varf +varf001 +shift000 +c_pek000 +c_pok000 +c_taylor_ran +c_cfu000 +c_taylor_eps +getcharnd2 +getintnd2_universal +lfilter +getintnd2 +getintnd2t +c_taylor_cycle +c_cycle +c_check_snake +check_j +check_harmonic_order +filter +c_filter_part +c_pri_c_ray +pri_matrix +c_pri_matrix +c_pri_map +print_e_ij +c_pri_quaternion +c_read_quaternion +c_read_map +c_pri_vec +c_pri_factored_lie +c_pri_spinmatrix +c_read_spinmatrix +c_full_norm_spin +c_norm_spin +c_pri_spinor +c_read_spinor +c_pri +printcomplex +printpoly +print6 +daprinttaylors +c_rea +dareadtaylors +c_crap1 +c_real_stop +c_ndum_warning_user +set_up +de_set_up +null_it +line_l +ring_l +append_da +insert_da +c_alloc_da +kill_dalevel +dealloc_dascratch +set_up_level +c_report_level +c_assign +c_deassign +c_asstaylor +c_ass0 +c_assmap +c_ass_quaternion +c_ass_spinmatrix +c_ass_spinor +c_ass_vector_field +c_norm +c_clean_yu_w +clean_matrix_complex +clean_vector_complex +clean_matrix +clean_vector +clean_c_universal_taylor +c_clean_taylor +c_clean_linear_map +c_clean_spinmatrix +c_clean_quaternion +c_clean_spinor +c_clean_damap +c_clean_cm +c_clean_c_factored_lie +c_clean_vector_field +c_bmad_reinit +c_init +init_map_all +c_init_all +c_etcct +c_etinv +c_etpin +transform_vector_field_by_map +c_concat +c_concat_tpsa +c_adjoint +c_adjoint_vec +c_spinmatrix_spinmatrix +c_spinmatrix_mul_cray +c_quaternion_mul_cray +c_spinmatrix_spinor +c_transpose +c_spinor_cmap +c_spinor_cmap_tpsa +c_complex_spinmatrix +c_spinmatrix_add_spinmatrix +c_spinmatrix_sub_spinmatrix +c_spinor_add_spinor +c_spinor_sub_spinor +c_taylor_spinor +c_complex_spinor +c_real_spinor +c_spinor_spinor +c_trxspinmatrix +c_trxquaternion +c_trxquaternion_tpsa +c_trxspinmatrixda +c_trxtaylor +c_trxtaylor_da +c_concat_spinor_ray +c_concat_spinmatrix_ray +c_concat_quaternion_ray +c_concat_c_ray +c_concat_map_ray +c_concat_vector_field_ray +c_bra_v_ct +c_bra_v_q +c_bra_v_dm +powmap +powmap_inv +pow_tpsamap +pow_tpsamapnew +powmaps +c_equalmap +c_map_vec +c_equalvec +c_equalcray +c_identityequalmap +c_zero_constant_in_map +c_identityequalspin +c_identityequalspinor +c_identityequalvec +c_identityequalfactored +matrixmapr +r_matrixmapr +matrixvecfr +r_matrixvecfr +mapmatrixr +r_mapmatrixr +c_linear_a +c_linear_a_stoch +c_locate_planes +c_locate_modulated_magnet_planes +c_linear_ac_longitudinal +c_gofix +c_factor_map +c_canonise +c_full_factor_map_old +c_full_canonise +c_identify_resonance +c_full_factorise +c_normal_spin_linear_quaternion +c_normal_spin_linear +c_convert_spin +coast +c_normal_radiation +c_stochastic_kick +check_kernel +check_resonance +check_resonance_spin +c_kernel +c_average +c_expflo_fac +c_expflo_fac_inv +c_add_map +c_sub_map +c_1_vf_q +c_1_map +c_add_vf +c_sub_vf +real_mul_map +complex_mul_map +real_mul_vec +complex_mul_vec +c_taylor_mul_vec +map_mul_vec_q +map_mul_vec +exp_ad +iexp_ad +c_expflo_map +c_expflo +c_flofacg +c_find_n0 +c_n0_to_nr +c_nr_to_n0 +c_q0_to_qr +c_qr_to_q0 +c_find_om_da +c_find_as +c_inv_as +c_find_spin_angle +c_log_spinmatrix +c_vector_field_quaternion +c_exp_spinmatrix +c_exp_quaternion +c_exp_vectorfield_on_quaternion +c_full_norm_damap +c_full_norm_spin_map +c_full_norm_spinmatrix +c_full_norm_quaternion +c_norm_spinmatrix +c_full_norm_vector_field +c_full_norm_spinor +c_full_norm_fourier +c_check_rad +c_check_rad_spin +c_exp_mat_ +c_norm_matrix +exp_mat_ +norm_matrix +c_eig6 +ety +etyt +ety2 +etdiv +teng_edwards_a1 +c_int_partial +copy_damap_matrix +invert_22 +dagger_22 +matmulr_33 +matmult_33 +matmul_33 +dalloc_33t +prin_33t +dkill_33t +copy_matrix_matrix +extract_linear_from_normalised +extract_a0 +extract_only_a0 +extract_a1 +extract_only_a1 +extract_a2 +factor_ely_rest +c_remove_y_rot +produce_orthogonal +orthogonalise_ray +c_identityequalvecfourier +equal_c_vector_field_fourier +alloc_c_vector_field_fourier +kill_c_vector_field_fourier +transform_vector_field_fourier_by_map +transform_vector_field_fourier_to_qr +transform_vector_field_fourier_to_q0 +exp_vector_field_fourier +ddt_vector_field_fourier +print_vector_field_fourier +print_poisson_bracket_fourier +bra_vector_field_fourier +add_vector_field_fourier +mulc_vector_field_fourier +c_clean_vector_field_fourier +c_clean_taylors +c_evaluate_vector_field_fourier +create_rotation_linear_field +symplectify_for_sethna +nth_root +alloc_node_array_tpsa +kill_node_array_tpsa +kill_node_array +alloc_node_array +get_c_yu_w +transform_c_yu_w +c_fast_canonise +canonize_damping +extract_a0_mat +set_tree_g_complex_zhe +set_tree_g_complex_zhe_as_is +fill_tree_element_line_zhe_outside_map +compute_lie_map_matrix_complex +compute_lie_map_matrix +create_taylor_vector +init_moment_map +create_moment_map_one +create_vector_field +create_moment_map_one_complex +create_moment_map +create_yu_map +norm_moment_matrix +matinvn +ludcmp_nr0n +lubksb_nr0n +copy_tree_into_tree_zhe +print_tree_element +print_tree_elements +read_tree_element +read_tree_elements +symplectify_for_zhe +furman_symp +furman_step +checksympn +cholesky_dt +c_kill_uni +c_kill_unis +c_null_uni +c_alloc_u +c_alloc_us +c_get_coeff +c_fill_uni_r +c_fill_uni +c_fill_uni_complextaylor +c_concat_c_uni_ray +c_concat_c_uni_rays +c_equal_uni +c_refill_uni +c_printunitaylors +c_printunitaylor_old +r_field_for_demin +d_field_for_demin +c_uni_reorder +d_mod_demin +check_re +symplectify_general +normalise_vector_field_fourier +check_kernel_ham +check_kernel_spin1 +gramschmidt +c_normal +c_normal_new +c_normal_new_no_fac File: code/n_complex_polymorph.f90 polymorphic_complextaylor @@ -5833,66 +5020,355 @@ temporal_probe temporal_beam c_taylor c_dascratch -c_dalevel -c_spinmatrix -c_spinor -c_yu_w -c_quaternion -c_damap -c_vector_field -c_vector_field_fourier -c_factored_lie -c_normal_form -c_ray -fibre_array -node_array -in_bmad_units -in_ptc_units -alloc_fibre_array -kill_fibre_array -reset_aperture_flag -produce_aperture_flag - -File: code/Se_status.f90 -s_status -kind0 -kind1 -kind2 -kind3 -kind4 -kind5 -kind6 -kind7 -kind8 -kind9 -kind10 -kind11 -kind12 -kind13 -kind14 -kind15 -kind16 -kind17 -kind18 -kind19 -kind20 -kind21 -kind22 -kind23 -kindfitted -kinduser1 -kinduser2 -kindhel -kindwiggler -kindmu -kindpa -kindsuperdrift -kindabell -drift_kick_drift -matrix_kick_matrix -kick_sixtrack_kick -b_cyl -operator +c_dalevel +c_spinmatrix +c_spinor +c_yu_w +c_quaternion +c_damap +c_vector_field +c_vector_field_fourier +c_factored_lie +c_normal_form +c_ray +fibre_array +node_array +in_bmad_units +in_ptc_units +alloc_fibre_array +kill_fibre_array +reset_aperture_flag +produce_aperture_flag + +File: code/Sh_def_kind.f90 +s_def_kind +n_enge +radiate_2_force +procedure +procedure +rad_spin_qua_probe +procedure +procedure +rad_spin_force_probe +procedure +procedure +track_slice_sol5 +procedure +procedure +track_slice_dkd2 +procedure +procedure +track_slice_dkd2_old +procedure +procedure +track_slice_tktf +procedure +procedure +track_slice_sagan +procedure +procedure +track_slice_cav4 +procedure +procedure +track_slice_pancake +procedure +procedure +feval_cav_bmad_probe +procedure +procedure +feval_sagan_probe +procedure +procedure +rk2_sagan_probe +procedure +procedure +rk4_sagan_probe +procedure +procedure +rk6_sagan_probe +procedure +procedure +rk2bmad_cav_probe +procedure +procedure +rk4bmad_cav_probe +procedure +procedure +rk6bmad_cav_probe +procedure +procedure +track_slice_cav4_old +procedure +procedure +track_slice_teapot +procedure +procedure +track_slice_teapot_old +procedure +procedure +track_slice_strex +procedure +procedure +track_slice_strex_old +procedure +procedure +track_slice +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +fake_shift +procedure +procedure +fringe_hel +procedure +procedure +patch_drift +procedure +procedure +get_z_ab +procedure +procedure +adjust_abell +procedure +procedure +adjust_pancake +procedure +procedure +track_fringe +procedure +procedure +fringe_teapot +procedure +procedure +fringe_strex +procedure +procedure +get_z_cav +procedure +procedure +track +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +procedure +drift +procedure +procedure +sympintex +procedure +procedure +monti +procedure +procedure +rcollimatori +procedure +procedure +ecollimatori +procedure +procedure +kickcav +procedure +procedure +abmad_trans +procedure +procedure +a_trans +procedure +procedure +procedure +feval_cav +procedure +procedure +feval_cav_imp +procedure +rk1bmad_cav_imp +procedure +feval_cav_bmad +procedure +procedure +feval_teapot +procedure +procedure +feval_abell +procedure +procedure +rk2_abell +procedure +procedure +rk4_abell +procedure +procedure +rk6_abell +procedure +procedure +rk2_cav_trav +procedure +procedure +rk2bmad_cav +procedure +procedure +rk4_cav_trav +procedure +procedure +rk4bmad_cav +procedure +procedure +rk6_cav_trav +procedure +procedure +rk6bmad_cav +procedure +procedure +rk2_teapot +procedure +procedure +feval_teapot_qua +procedure +procedure +rk2_teapot_probe +procedure +procedure +rk4_teapot_probe +procedure +procedure +rk6_teapot_probe +procedure +procedure +rk4_teapot +procedure +procedure +rk6_teapot +procedure +procedure +fringecav +procedure +procedure +adjust_time_cav4 +procedure +procedure +adjust_time_cav_trav_out +procedure +procedure +fringecav_trav +procedure +procedure +fringe_cav_trav +procedure +procedure +cavity +procedure +procedure +multipole_fringe +procedure +procedure +fringe_dipole +procedure +procedure +face +procedure +procedure +procedure +procedure +edge +procedure +procedure +kick +procedure +procedure +kickex +procedure +procedure +elliptical_b +procedure +procedure +inte +procedure +procedure +inte_strex +procedure +procedure +kick_sol +procedure +procedure +fringe2quad +procedure +procedure +getmulb_sol +procedure +procedure +getnewb +procedure +procedure +kickmul +procedure +procedure +intesol +procedure +procedure +septtrack +procedure +procedure +copy +procedure +procedure +procedure +procedure +procedure +procedure +pointers_abell +procedure +procedure +pointers_pancake +procedure procedure assignment procedure @@ -5900,109 +5376,636 @@ procedure procedure procedure procedure -operator procedure procedure -operator procedure -make_states procedure procedure -check_aperture procedure procedure -check_s_aperture procedure procedure -check_s_aperture_out procedure procedure -init procedure -print procedure -alloc procedure procedure procedure -kill procedure procedure procedure -b2perp procedure procedure -orthonormalise procedure procedure -dtiltd procedure procedure -track_tree_g_complex procedure procedure -track_tree_probe_complex procedure procedure -null_a -alloc_a -dealloc_a -null_p -alloc_p -dealloc_p -kill_s_aperture -alloc_s_aperture -check_s_aperture_r -check_s_aperture_p -check_s_aperture_out_r -check_s_aperture_out_p -equal_a -equal_p -check_aperture_r -check_aperture_p -chkaperpolygon -minu -equaltilt -make_states_0 -print_curv -print_curv_elec -make_set_coef -clear_states -print_s -conv -make_states_m -update_states -equalt -equali -add -sub -para_rema -init_all -s_init -kill_map_cp -init_default -b2perpr -b2perpp -dtiltr_external -dtiltp_external -dd_p -set_s_b -set_s_e -set_s_b_mcmillan -set_s_e_mcmillan -get_bend_electric_coeff -get_bend_magnetic_potential -invert_laplace -make_coef -nul_coef -set_tree_g_complex -track_tree_probe_complexr -orthonormaliser -track_tree_probe_complexp_new -orthonormalisep -furman_rrt -track_tree_g_complexr -track_tree_g_complexp +procedure +alloc +procedure +procedure +procedure +kill +procedure +procedure +procedure +expcosy6 +procedure +procedure +getmat +procedure +procedure +intktk +procedure +procedure +pushktk +procedure +procedure +kickktk +procedure +procedure +expcosy +procedure +procedure +expcosy7 +procedure +procedure +getmat7 +procedure +procedure +pushtkt7 +procedure +procedure +kicktkt7 +procedure +procedure +kickpath +procedure +procedure +procedure +procedure +procedure +procedure +inttkt7 +procedure +procedure +getanbn +procedure +procedure +getaebe +procedure +procedure +getelectric +procedure +procedure +procedure +procedure +getmagnetic +procedure +procedure +sprot +procedure +procedure +ssec +procedure +procedure +ssech1 +procedure +procedure +spar +procedure +procedure +skick +procedure +procedure +sinte +procedure +procedure +wedge +procedure +procedure +wedge_int +procedure +procedure +fx +procedure +procedure +fx_newc +procedure +procedure +fxc +procedure +procedure +step_symp_p_pancake +procedure +procedure +feval_pancake +procedure +procedure +feval_pancake_probe +procedure +procedure +rk4_pancake_probe +procedure +procedure +rk6_pancake_probe +procedure +procedure +rk4_pancake +procedure +procedure +rk6_pancake +procedure +procedure +rks_pancake +procedure +procedure +compute_f4 +procedure +procedure +compute_f4e +procedure +procedure +compute_f4s +procedure +procedure +drift +procedure +procedure +kick_he +procedure +procedure +get_field +procedure +procedure +get_bfield_fringe +procedure +procedure +get_bz_fringe +procedure +procedure +get_bfield +procedure +procedure +b_pancake +procedure +procedure +get_be_cav +procedure +procedure +b_para_perp +procedure +procedure +direction_v +procedure +procedure +push_quaternion +procedure +procedure +get_omega_spin +procedure +procedure +radiate_2 +procedure +procedure +radiate_2_probe +procedure +procedure +makeso3 +procedure +procedure +patch_driftr +patch_driftp +inter_drift1 +intep_drift1 +inter_superdrift +intep_superdrift +super_drift_p +super_drift_r +drift_inter +drift_intep +fringe_straightr +fringe_straightp +adjust_time_cav4r +adjust_time_cav4p +track_slice4r +inte_cav4r +inte_cav4p +track_slice4p +caver +check_symplectic_bmad_cavity +cavep +cavityr +cavityp +abmad_transr +abmad_transp +feval_cav_bmadr +feval_cav_bmadp +get_z_abr +get_z_abp +inter_abell_slice +intep_abell_slice +interabell +intepabell +rk2abellr +rk4abellr +rk6abellr +rk2abellp +rk4abellp +rk6abellp +rk2bmad_cavr +rk4bmad_cavr +rk6bmad_cavr +rk2bmad_cavp +rk4bmad_cavp +rk6bmad_cavp +inte_cavbmad4r +inte_cavbmad4p +fringecavr +fringecavp +kickcavr +kickcavp +driftr +driftp +kicktr +kicktp +multipole_fringer +multipole_fringep +newfacer +newfacep +facer +facep +fringe_dipoler +fringe_dipolep +fringe2quadr +fringe2quadp +edger +edgep +kickr +kickp +inter_dkd2 +intep_dkd2 +inter +intep +sympintr +sympintp +kick_solr +kick_solp +getnewbr +getnewbp +getmulb_solr +getmulb_solp +kickmulr +kickmulp +inter_sol5 +intep_sol5 +intesolr +intesolp +sympintsolr +sympintsolp +getmatr +getmatd +expr +expd +expcosy6r +expcosy6d +inter_ktk +intep_ktk +intktkr +intktkd +pushktkr +pushktkd +kickktkr +kickktkp +sympintktkr +sympintktkd +getmat7r +getmat7d +pushtkt7r +pushtkt7d +kicktkt7r +kicktkt7p +kickpath6r +kickpath6p +kickpathr +kickpathd +inte_tktfr +inte_tktfp +inttkt7r +inttkt7d +sympinttkt7r +sympinttkt7d +expr7 +expd7 +push_nsmi_r +push_nsmi_d +push_ssmi_r +push_ssmi_d +getaeber +getaebep +getmagneticr +getmagneticp +getelectricr +getelectricp +feval_teapotr +feval_teapotp +rk2_teapotr +rk2_teapotp +rk4_teapotr +rk4_teapotp +rk6_teapotr +rk6_teapotp +ssech1r +ssech1p +sprotr +sprotp +ssecr +ssecp +skickr +skickp +inter_teapot +intep_teapot +sinter +sintep +checkpotknob +makepotknob +makepotknob_elec +unmakepotknob +unmakepotknob_elec +fringe_teapotr +fringe_teapotp +ssympintr +ssympintp +montr +montp +montir +montip +rcollimatorr +rcollimatorp +rcollimatorir +rcollimatorip +ecollimatorr +ecollimatorp +ecollimatorir +ecollimatorip +electric_field_septumr +electric_field_septump +sepr +sepp +sympsepr +sympsepp +f_prof +set_f_in_k16 +kickexr +kickexp +inte_strexr +inte_strexp +inteexr +inteexp +fringe_strexr +fringe_strexp +sympintexr +sympintexp +sparr +sparp +check_root_drift +wedger +wedge_intr +wedge_intp +wedgep +adjust_time_cav_trav_outr +adjust_time_cav_trav_outp +get_z_cavr +get_z_cavp +inter_cav_trav +intep_cav_trav +caver_trav +cavep_trav +fringecav_travr +fringecav_travp +fringe_cav_travr +fringe_cav_travp +zeror_cav_trav +zerop_cav_trav +zeror_mon +zerop_mon +zeror_rcol +zerop_rcol +zeror_ecol +zerop_ecol +zeror_dkd2 +zerop_dkd2 +zeror_sol5 +zerop_sol5 +zeror_ktk +zerop_ktk +allocktk +killktk +zeror_tkt7 +zerop_tkt7 +alloctkt7 +killtkt7 +zeror_teapot +zerop_teapot +zero_cav4r +zero_cav4p +zero_abellr +feval_abellr +feval_abellp +zero_abellp +zeror_superdrift +zerop_superdrift +zeror_ramp +alloc_acceleration +alloc_tableau +kill_tableau +kill_acceleration +nullify_acceleration +copy_tableau +copy_acceleration +lecture_fichier +alloc_ramping +alloc_table +kill_table +kill_ramping +nullify_ramping +copy_table +copy_ramping +reading_file +zeror_kickt3 +zerop_kickt3 +zeror_strex +zerop_strex +allocteapot +killteapot +fx_newcr +fx_newcp +fxr_canonical +fxp_canonical +fxr +fxp +zeror_pancake +zerop_pancake +pointers_pancaker +pointers_pancakep +pointers_abellr +pointers_abellp +copyabell_el_elp +copyabell_el_el +copyabell_elp_el +copypancake_el_elp +copypancake_el_el +copypancake_elp_el +reset_pa +reset_abell +step_symp_p_pancaker +step_symp_p_pancakep +feval_pancaker +feval_pancakep +rks_pancaker +rks_pancakep +rk4_pancaker +rk4_pancakep +rk6_pancakep +rk6_pancaker +adjust_abellr +adjust_abellp +adjust_pancaker +adjust_pancakep +inter_pancake +intep_pancake +intpancaker +intpancakep +feval_cav_impr +rk1bmad_cav_impr +feval_cavr +feval_cavp +a_transl +a_transr +a_transp +rk2_cavr +rk2_cavp +rk4_cavr +rk4_cavp +rk6_cavr +rk6_cavp +zeror_he22 +zerop_he22 +compute_f4gr +compute_f4gp +compute_f4r +compute_f4p +compute_f4rold +compute_f4pold +kickr_he +kickp_he +intr_he +intp_he +fake_shiftr +fringe_helr +fringe_help +fake_shiftp +intr_he_tot +intp_he_tot +kickpathr_he +kickpathr_he_exact_nonsymp +kickpathp_he_exact_nonsymp +kickpathp_he +driftr_he +driftp_he +enge_f +zeror_enge +zerop_enge +elliptical_b_r +elliptical_b_p +get_fieldr +get_fieldp +get_bfield_fringer +get_bfield_fringep +get_bz_fringer +get_bz_fringep +get_bfieldr +get_bfieldp +b_pancaker +b_pancakep +get_be_cavr +get_be_cavp +b_para_perpr +b_para_perpp +direction_vr +direction_vp +get_omega_spinr +get_omega_spinp +radiate_2_forcer +radiate_2_forcep +radiate_2_prober +radiate_2_probep +radiate_2r +radiate_2p +crossp +quaternion_r_to_matrix +quaternion_8_to_matrix +feval_sagan_prober +feval_sagan_probep +rk2_sagan_prober +rk2_sagan_probep +rk4_sagan_prober +rk4_sagan_probep +rk6_sagan_prober +rk6_sagan_probep +feval_cav_bmad_prober +feval_cav_bmad_probep +rk2bmad_cav_prober +rk2bmad_cav_probep +rk4bmad_cav_prober +rk4bmad_cav_probep +rk6bmad_cav_prober +rk6bmad_cav_probep +feval_teapot_quar +feval_teapot_quap +rk2_teapot_prober +rk4_teapot_prober +rk6_teapot_prober +rk2_teapot_probep +rk4_teapot_probep +rk6_teapot_probep +inte_pancake_prober +inte_pancake_probep +rk4_pancake_prober +rk4_pancake_probep +rk6_pancake_prober +rk6_pancake_probep +feval_pancake_prober +feval_pancake_probep +inte_cav4_prober +inte_cav4_probep +inte_teapot_prober +inte_teapot_probep +inte_tktf_prober +inte_tktf_probep +inte_strex_prober +inte_strex_probep +inte_sol5_prober +inte_sol5_probep +inte_dkd2_prober +rad_spin_force_prober +rad_spin_force_probep +radiate_envelope +rad_spin_qua_prober +rad_spin_qua_probep +kick_stochastic_before +kick_stochastic_after +clear_compute_stoch_kick +inte_dkd2_probep +push_quaternionr +push_quaternionp +int_sagan_prober +int_sagan_probep File: code/St_pointers.f90 pointer_lattice diff --git a/regression_tests/CMakeLists.txt b/regression_tests/CMakeLists.txt index f24b527b90..81bd403747 100644 --- a/regression_tests/CMakeLists.txt +++ b/regression_tests/CMakeLists.txt @@ -53,6 +53,7 @@ set (EXE_SPECS cmake_files/cmake.wake_test cmake_files/cmake.wall3d_test cmake_files/cmake.write_bmad_test + cmake_files/cmake.write_foreign_test cmake_files/cmake.xraylib_test ) diff --git a/regression_tests/TESTS.LIST b/regression_tests/TESTS.LIST index 7c3a2d03bf..bce31a72e6 100644 --- a/regression_tests/TESTS.LIST +++ b/regression_tests/TESTS.LIST @@ -47,4 +47,5 @@ tracking_method_test wake_test wall3d_test write_bmad_test +write_foreign_test xraylib_test diff --git a/regression_tests/cmake_files/cmake.write_foreign_test b/regression_tests/cmake_files/cmake.write_foreign_test new file mode 100644 index 0000000000..2b836b140a --- /dev/null +++ b/regression_tests/cmake_files/cmake.write_foreign_test @@ -0,0 +1,12 @@ +set (EXENAME write_foreign_test) + +FILE (GLOB SRC_FILES "write_foreign_test/*.f90") + +set (INC_DIRS +) + +set (LINK_LIBS + bmad + sim_utils + ${ACC_BMAD_LINK_LIBS} +) \ No newline at end of file diff --git a/regression_tests/write_foreign_test/gg.bmad b/regression_tests/write_foreign_test/gg.bmad new file mode 100644 index 0000000000..22c4c4edf4 --- /dev/null +++ b/regression_tests/write_foreign_test/gg.bmad @@ -0,0 +1,1624 @@ + field_calc = fieldmap, + gen_grad_map = { + ele_anchor_pt = Center, + field_scale = 1e-6, + dz = 0.010000, + r0 = ( 0.00000000, 0.00000000, 0.00000000), + curve = { + m = 0, + kind = cos, + derivs = { + -0.7000: 0.000000000000E+00 3.251040089939E-03 8.608542034485E-02, + -0.6900: 0.000000000000E+00 4.077238715459E-03 9.497848028434E-02, + -0.6800: 0.000000000000E+00 5.003806066002E-03 1.047538770581E-01, + -0.6700: 0.000000000000E+00 6.035785402591E-03 1.153548084288E-01, + -0.6600: 0.000000000000E+00 7.176308064896E-03 1.270017443677E-01, + -0.6500: 0.000000000000E+00 8.431129521671E-03 1.402316107111E-01, + -0.6400: 0.000000000000E+00 9.812574817946E-03 1.558461959769E-01, + -0.6300: 0.000000000000E+00 1.134258984716E-02 1.748692175529E-01, + -0.6200: 0.000000000000E+00 1.305597521754E-02 1.984892150638E-01, + -0.6100: 0.000000000000E+00 1.500215977786E-02 2.279244149197E-01, + -0.6000: 0.000000000000E+00 1.724399295880E-02 2.643241974051E-01, + -0.5900: 0.000000000000E+00 1.985614539163E-02 3.088041785192E-01, + -0.5800: 0.000000000000E+00 2.292494077989E-02 3.624961869621E-01, + -0.5700: 0.000000000000E+00 2.654747122945E-02 4.265659588680E-01, + -0.5600: 0.000000000000E+00 3.083014198535E-02 5.023463505992E-01, + -0.5500: 0.000000000000E+00 3.589035713465E-02 5.915778291063E-01, + -0.5400: 0.000000000000E+00 4.186154817732E-02 6.965809630282E-01, + -0.5300: 0.000000000000E+00 4.889899177229E-02 8.203797564152E-01, + -0.5200: 0.000000000000E+00 5.718747030639E-02 9.668927075402E-01, + -0.5100: 0.000000000000E+00 6.695274243436E-02 1.141114577354E+00, + -0.5000: 0.000000000000E+00 7.847543739494E-02 1.349215847631E+00, + -0.4900: 0.000000000000E+00 9.210750486106E-02 1.598668529578E+00, + -0.4800: 0.000000000000E+00 1.082956679868E-01 1.898416233831E+00, + -0.4700: 0.000000000000E+00 1.276168855891E-01 2.258903299200E+00, + -0.4600: 0.000000000000E+00 1.508329886153E-01 2.691654702795E+00, + -0.4500: 0.000000000000E+00 1.789784287073E-01 3.207502124321E+00, + -0.4400: 0.000000000000E+00 2.134916205916E-01 3.810870403773E+00, + -0.4300: 0.000000000000E+00 2.565237025319E-01 4.488750683440E+00, + -0.4200: 0.000000000000E+00 3.071558772939E-01 4.906494128730E+00, + -0.4100: 0.000000000000E+00 3.613290512987E-01 5.045660581960E+00, + -0.4000: 0.000000000000E+00 4.154739135354E-01 4.901754355773E+00, + -0.3900: 0.000000000000E+00 4.660194274229E-01 4.479091334967E+00, + -0.3800: 0.000000000000E+00 5.089021022887E-01 3.796028594770E+00, + -0.3700: 0.000000000000E+00 5.431984350519E-01 3.187309294344E+00, + -0.3600: 0.000000000000E+00 5.710582081408E-01 2.666232028798E+00, + -0.3500: 0.000000000000E+00 5.939248723285E-01 2.228774407516E+00, + -0.3400: 0.000000000000E+00 6.128447276868E-01 1.864532448854E+00, + -0.3300: 0.000000000000E+00 6.285978531149E-01 1.562438488318E+00, + -0.3200: 0.000000000000E+00 6.417866259014E-01 1.312494055000E+00, + -0.3100: 0.000000000000E+00 6.528891674652E-01 1.105993447291E+00, + -0.3000: 0.000000000000E+00 6.622892353527E-01 9.353328494585E-01, + -0.2900: 0.000000000000E+00 6.702932213306E-01 7.938630147727E-01, + -0.2800: 0.000000000000E+00 6.771421874163E-01 6.758794719807E-01, + -0.2700: 0.000000000000E+00 6.830232208691E-01 5.767012184930E-01, + -0.2600: 0.000000000000E+00 6.880819954010E-01 4.927387635772E-01, + -0.2500: 0.000000000000E+00 6.924360141698E-01 4.214312358422E-01, + -0.2400: 0.000000000000E+00 6.961858393349E-01 3.610105576662E-01, + -0.2300: 0.000000000000E+00 6.994218975157E-01 3.101787374850E-01, + -0.2200: 0.000000000000E+00 7.022268774736E-01 2.678258045593E-01, + -0.2100: 0.000000000000E+00 7.046754124868E-01 2.328426754073E-01, + -0.2000: 0.000000000000E+00 7.068322488597E-01 2.040236260678E-01, + -0.1900: 0.000000000000E+00 7.087499587678E-01 1.800762252910E-01, + -0.1800: 0.000000000000E+00 7.104680962259E-01 1.597198958681E-01, + -0.1700: 0.000000000000E+00 7.120142362999E-01 1.417712188291E-01, + -0.1600: 0.000000000000E+00 7.134051484349E-01 1.251779073671E-01, + -0.1500: 0.000000000000E+00 7.146475564769E-01 1.090725023736E-01, + -0.1400: 0.000000000000E+00 7.157399300122E-01 9.286802890369E-02, + -0.1300: 0.000000000000E+00 7.166759575862E-01 7.633007894878E-02, + -0.1200: 0.000000000000E+00 7.174487529485E-01 5.957883532956E-02, + -0.1100: 0.000000000000E+00 7.180547122523E-01 4.303733132659E-02, + -0.1000: 0.000000000000E+00 7.184967367011E-01 2.734937082865E-02, + -0.0900: 0.000000000000E+00 7.187864269940E-01 1.324902225715E-02, + -0.0800: 0.000000000000E+00 7.189440989054E-01 1.389765202172E-03, + -0.0700: 0.000000000000E+00 7.189965111645E-01 -7.788965744566E-03, + -0.0600: 0.000000000000E+00 7.189737545633E-01 -1.412176870756E-02, + -0.0500: 0.000000000000E+00 7.189059856985E-01 -1.773717913991E-02, + -0.0400: 0.000000000000E+00 7.188199186423E-01 -1.903396358955E-02, + -0.0300: 0.000000000000E+00 7.187358921691E-01 -1.859976514578E-02, + -0.0200: 0.000000000000E+00 7.186662203072E-01 -1.711208635677E-02, + -0.0100: 0.000000000000E+00 7.186146738468E-01 -1.524875174593E-02, + 0.0000: 0.000000000000E+00 7.185772291273E-01 -1.360920888629E-02, + 0.0100: 0.000000000000E+00 7.185441162185E-01 -1.267412974117E-02, + 0.0200: 0.000000000000E+00 7.185021171428E-01 -1.282066465992E-02, + 0.0300: 0.000000000000E+00 7.184359105426E-01 -1.435651520261E-02, + 0.0400: 0.000000000000E+00 7.183284187902E-01 -1.751744821209E-02, + 0.0500: 0.000000000000E+00 7.181611919956E-01 -2.240461080259E-02, + 0.0600: 0.000000000000E+00 7.179161743433E-01 -2.888431972969E-02, + 0.0700: 0.000000000000E+00 7.175795803841E-01 -3.653660806883E-02, + 0.0800: 0.000000000000E+00 7.171461204766E-01 -4.476082529695E-02, + 0.0900: 0.000000000000E+00 7.166200701067E-01 -5.299553556017E-02, + 0.1000: 0.000000000000E+00 7.160126142671E-01 -6.087931712133E-02, + 0.1100: 0.000000000000E+00 7.153377821401E-01 -6.830101129171E-02, + 0.1200: 0.000000000000E+00 7.146080556146E-01 -7.538336628736E-02, + 0.1300: 0.000000000000E+00 7.138308459869E-01 -8.238335356619E-02, + 0.1400: 0.000000000000E+00 7.130082207494E-01 -8.959034517242E-02, + 0.1500: 0.000000000000E+00 7.121383297128E-01 -9.740121836234E-02, + 0.1600: 0.000000000000E+00 7.112139371724E-01 -1.065165265029E-01, + 0.1700: 0.000000000000E+00 7.102176183085E-01 -1.180183726665E-01, + 0.1800: 0.000000000000E+00 7.091172317607E-01 -1.332418764674E-01, + 0.1900: 0.000000000000E+00 7.078645915166E-01 -1.535179080774E-01, + 0.2000: 0.000000000000E+00 7.063985922508E-01 -1.799165343282E-01, + 0.2100: 0.000000000000E+00 7.046514437807E-01 -2.131729953137E-01, + 0.2200: 0.000000000000E+00 7.025532698544E-01 -2.538524374013E-01, + 0.2300: 0.000000000000E+00 7.000324010928E-01 -3.025651896025E-01, + 0.2400: 0.000000000000E+00 6.970134030899E-01 -3.601078670626E-01, + 0.2500: 0.000000000000E+00 6.934138860917E-01 -4.275778744928E-01, + 0.2600: 0.000000000000E+00 6.891399199548E-01 -5.064200967259E-01, + 0.2700: 0.000000000000E+00 6.840828006703E-01 -5.984041260999E-01, + 0.2800: 0.000000000000E+00 6.781171243059E-01 -7.057561284984E-01, + 0.2900: 0.000000000000E+00 6.710947659099E-01 -8.314683599989E-01, + 0.3000: 0.000000000000E+00 6.628339155204E-01 -9.795201873308E-01, + 0.3100: 0.000000000000E+00 6.531073776646E-01 -1.154963221211E+00, + 0.3200: 0.000000000000E+00 6.416304551367E-01 -1.364012000043E+00, + 0.3300: 0.000000000000E+00 6.280458815788E-01 -1.614147330378E+00, + 0.3400: 0.000000000000E+00 6.119032030129E-01 -1.914235051938E+00, + 0.3500: 0.000000000000E+00 5.926257430399E-01 -2.274640969543E+00, + 0.3600: 0.000000000000E+00 5.694543393632E-01 -2.706929715205E+00, + 0.3700: 0.000000000000E+00 5.413566395088E-01 -3.222055503116E+00, + 0.3800: 0.000000000000E+00 5.068951655939E-01 -3.824582689010E+00, + 0.3900: 0.000000000000E+00 4.639183969779E-01 -4.501714263736E+00, + 0.4000: 0.000000000000E+00 4.133415644836E-01 -4.919168493318E+00, + 0.4100: 0.000000000000E+00 3.592145646529E-01 -5.059038804523E+00, + 0.4200: 0.000000000000E+00 3.050897054388E-01 -4.917458173046E+00, + 0.4300: 0.000000000000E+00 2.545124974496E-01 -4.499265313684E+00, + 0.4400: 0.000000000000E+00 2.115158418896E-01 -3.822954550461E+00, + 0.4500: 0.000000000000E+00 1.769951500502E-01 -3.222851292216E+00, + 0.4600: 0.000000000000E+00 1.487833531761E-01 -2.711309794239E+00, + 0.4700: 0.000000000000E+00 1.254366719693E-01 -2.283017445237E+00, + 0.4800: 0.000000000000E+00 1.059277024201E-01 -1.926192323024E+00, + 0.4900: 0.000000000000E+00 8.951277992935E-02 -1.628565736678E+00, + 0.5000: 0.000000000000E+00 7.563859680111E-02 -1.379380457725E+00, + 0.5100: 0.000000000000E+00 6.388035797950E-02 -1.169848352713E+00, + 0.5200: 0.000000000000E+00 5.390104620013E-02 -9.930227272969E-01, + 0.5300: 0.000000000000E+00 4.542490430582E-02 -8.434931470956E-01, + 0.5400: 0.000000000000E+00 3.821958291437E-02 -7.170500793968E-01, + 0.5500: 0.000000000000E+00 3.208436852356E-02 -6.102910469860E-01, + 0.5600: 0.000000000000E+00 2.684484260734E-02 -5.202141041438E-01, + 0.5700: 0.000000000000E+00 2.235278121241E-02 -4.439510467151E-01, + 0.5800: 0.000000000000E+00 1.848808065717E-02 -3.787067333191E-01, + 0.5900: 0.000000000000E+00 1.515990023818E-02 -3.218786345267E-01, + 0.6000: 0.000000000000E+00 1.230473277339E-02 -2.712864349990E-01, + 0.6100: 0.000000000000E+00 9.880598976698E-03 -2.253792921727E-01, + 0.6200: 0.000000000000E+00 7.858843431498E-03 -1.833298089264E-01, + 0.6300: 0.000000000000E+00 6.215125841387E-03 -1.450062364920E-01, + 0.6400: 0.000000000000E+00 4.921252229866E-03 -1.108033780627E-01, + 0.6500: 0.000000000000E+00 3.940290457305E-03 -8.136607112251E-02, + 0.6600: 0.000000000000E+00 3.225528266940E-03 -5.732050846552E-02, + 0.6700: 0.000000000000E+00 2.721974878740E-03 -3.906129731764E-02, + 0.6800: 0.000000000000E+00 2.369917136463E-03 -2.659920997874E-02, + 0.6900: 0.000000000000E+00 2.109657645014E-03 -1.950752678323E-02, + 0.7000: 0.000000000000E+00 1.886108521876E-03 -1.692876739434E-02 + } + }, + curve = { + m = 1, + kind = sin, + derivs = { + -0.7000: -2.010452540465E+00 2.689718008053E+00 9.019304473165E+01, + -0.6900: -1.980174327441E+00 3.587875820105E+00 8.736325697908E+01, + -0.6800: -1.941406527478E+00 4.454455748305E+00 8.361958720509E+01, + -0.6700: -1.894521792606E+00 5.281270402416E+00 7.901745370410E+01, + -0.6600: -1.839938435550E+00 6.059204879629E+00 7.367404884427E+01, + -0.6500: -1.778261414199E+00 6.778367869350E+00 6.732082258642E+01, + -0.6400: -1.710205084572E+00 7.427864388439E+00 5.973439214134E+01, + -0.6300: -1.636474262239E+00 7.996257344396E+00 5.108751938213E+01, + -0.6200: -1.557896924452E+00 8.471881962019E+00 4.147087605536E+01, + -0.6100: -1.475436490099E+00 8.842853269216E+00 3.096090683625E+01, + -0.6000: -1.389996442257E+00 9.099056769979E+00 2.015483047859E+01, + -0.5900: -1.302432832780E+00 9.236929516687E+00 9.798404847471E+00, + -0.5800: -1.213576748145E+00 9.264050778804E+00 5.813815656570E-01, + -0.5700: -1.124119366192E+00 9.200190225637E+00 -6.686397475353E+00, + -0.5600: -1.034613428718E+00 9.074011676541E+00 -1.146231742225E+01, + -0.5500: -9.455173630968E-01 8.917183692517E+00 -1.375137451705E+01, + -0.5400: -8.571693170136E-01 8.757563030511E+00 -1.393616766974E+01, + -0.5300: -7.697696028067E-01 8.613802559025E+00 -1.262879104972E+01, + -0.5200: -6.834170569421E-01 8.494098729488E+00 -1.057451148272E+01, + -0.5100: -5.981088542843E-01 8.399094673242E+00 -8.401576874689E+00, + -0.5000: -5.137744266061E-01 8.325631001322E+00 -6.544919375503E+00, + -0.4900: -4.302856760983E-01 8.269258479552E+00 -5.188201722250E+00, + -0.4800: -3.474819186064E-01 8.225440617944E+00 -4.303663218365E+00, + -0.4700: -2.652086465747E-01 8.190035887538E+00 -3.773990436151E+00, + -0.4600: -1.833413779818E-01 8.159501144816E+00 -3.462484464239E+00, + -0.4500: -1.018056882767E-01 8.130989527066E+00 -3.276137406695E+00, + -0.4400: -2.059320441580E-02 8.102269437434E+00 -3.214912852324E+00, + -0.4300: 6.025990959243E-02 8.071540850546E+00 -3.317365254150E+00, + -0.4200: 1.406950836752E-01 8.037250857390E+00 -3.633680090213E+00, + -0.4100: 2.206491763277E-01 7.997996469722E+00 -4.203720243674E+00, + -0.4000: 3.000824942738E-01 7.952539136768E+00 -4.995765231191E+00, + -0.3900: 3.789741196710E-01 7.899895493769E+00 -5.900334325109E+00, + -0.3800: 4.573008598922E-01 7.839362168683E+00 -6.796463121636E+00, + -0.3700: 5.350203804744E-01 7.770435063864E+00 -7.584964486619E+00, + -0.3600: 6.120504253819E-01 7.692723643225E+00 -8.265933174378E+00, + -0.3500: 6.882645293939E-01 7.605886204656E+00 -8.953061856347E+00, + -0.3400: 7.635334773767E-01 7.509682790732E+00 -9.757889609576E+00, + -0.3300: 8.377439094439E-01 7.404061852445E+00 -1.073294430392E+01, + -0.3200: 9.108074714186E-01 7.289174595871E+00 -1.185927444535E+01, + -0.3100: 9.826672105844E-01 7.165257069894E+00 -1.300981226735E+01, + -0.3000: 1.053270886235E+00 7.032499556155E+00 -1.403876317374E+01, + -0.2900: 1.122542271974E+00 6.890959562462E+00 -1.488894478529E+01, + -0.2800: 1.190383625686E+00 6.740644764804E+00 -1.560551305337E+01, + -0.2700: 1.256693881638E+00 6.581690559345E+00 -1.626912455411E+01, + -0.2600: 1.321373662256E+00 6.414466093989E+00 -1.696521818102E+01, + -0.2500: 1.384345146216E+00 6.239492348870E+00 -1.770498492234E+01, + -0.2400: 1.445542917319E+00 6.057223534054E+00 -1.844434540508E+01, + -0.2300: 1.504890942212E+00 5.867833503645E+00 -1.916644954345E+01, + -0.2200: 1.562305052967E+00 5.671204042403E+00 -1.989923157999E+01, + -0.2100: 1.617707765077E+00 5.467139918541E+00 -2.065938877872E+01, + -0.2000: 1.671028968635E+00 5.255629495755E+00 -2.144687226918E+01, + -0.1900: 1.722209885280E+00 5.036949037706E+00 -2.223065199852E+01, + -0.1800: 1.771196363733E+00 4.811532031825E+00 -2.294976455597E+01, + -0.1700: 1.817917952338E+00 4.579727473952E+00 -2.358534347557E+01, + -0.1600: 1.862290132112E+00 4.341681067378E+00 -2.418701350514E+01, + -0.1500: 1.904239024191E+00 4.097454648569E+00 -2.478968469222E+01, + -0.1400: 1.943715200049E+00 3.847296120986E+00 -2.537396808289E+01, + -0.1300: 1.980692861140E+00 3.591806812717E+00 -2.588277383941E+01, + -0.1200: 2.015154481594E+00 3.331828382927E+00 -2.623497010450E+01, + -0.1100: 2.047062042457E+00 3.068106718381E+00 -2.641713695371E+01, + -0.1000: 2.076344898493E+00 2.801009258059E+00 -2.653581899078E+01, + -0.0900: 2.102925198757E+00 2.530552845533E+00 -2.673744680724E+01, + -0.0800: 2.126742924389E+00 2.256724479020E+00 -2.710576434357E+01, + -0.0700: 2.147767495953E+00 1.979810930225E+00 -2.764207880342E+01, + -0.0600: 2.166005466717E+00 1.700479654191E+00 -2.821932958645E+01, + -0.0500: 2.181484957241E+00 1.419541610837E+00 -2.863924684699E+01, + -0.0400: 2.194220717070E+00 1.137573217525E+00 -2.877889149122E+01, + -0.0300: 2.204198701665E+00 8.547180577656E-01 -2.864085270250E+01, + -0.0200: 2.211379585199E+00 5.708397586059E-01 -2.833600983192E+01, + -0.0100: 2.215711969320E+00 2.858664540984E-01 -2.805718716030E+01, + 0.0000: 2.217158769093E+00 1.060884929487E-04 -2.795320214089E+01, + 0.0100: 2.215706535444E+00 -2.857507054061E-01 -2.807438364419E+01, + 0.0200: 2.211367634797E+00 -5.709914695223E-01 -2.836847710555E+01, + 0.0300: 2.204177637278E+00 -8.552650178573E-01 -2.868667490705E+01, + 0.0400: 2.194185935606E+00 -1.138623760495E+00 -2.883826228746E+01, + 0.0500: 2.181429732978E+00 -1.421236213605E+00 -2.871468515198E+01, + 0.0600: 2.165921455791E+00 -1.703028893114E+00 -2.831312519292E+01, + 0.0700: 2.147645863180E+00 -1.983478627444E+00 -2.775180619123E+01, + 0.0800: 2.126575856663E+00 -2.261737762188E+00 -2.722014603318E+01, + 0.0900: 2.102707446625E+00 -2.536960882827E+00 -2.683512590992E+01, + 0.1000: 2.076075042663E+00 -2.808546434733E+00 -2.658843373246E+01, + 0.1100: 2.046743310240E+00 -3.076122565824E+00 -2.639623521513E+01, + 0.1200: 2.014795031078E+00 -3.339326289762E+00 -2.612069584036E+01, + 0.1300: 1.980305498377E+00 -3.597598628390E+00 -2.567145298726E+01, + 0.1400: 1.943316574833E+00 -3.850243020880E+00 -2.508184826610E+01, + 0.1500: 1.903848511711E+00 -4.096731709482E+00 -2.445098207650E+01, + 0.1600: 1.861928678225E+00 -4.336980995696E+00 -2.384614410449E+01, + 0.1700: 1.817607019053E+00 -4.571328957454E+00 -2.328549774112E+01, + 0.1800: 1.770956974314E+00 -4.800205113805E+00 -2.272159408344E+01, + 0.1900: 1.722061772146E+00 -5.023726992843E+00 -2.208484088093E+01, + 0.2000: 1.670989844640E+00 -5.241520740563E+00 -2.137300064491E+01, + 0.2100: 1.617792758225E+00 -5.452873984587E+00 -2.063131768713E+01, + 0.2200: 1.562526418187E+00 -5.657090397968E+00 -1.988488333887E+01, + 0.2300: 1.505258156973E+00 -5.853765355909E+00 -1.913839746584E+01, + 0.2400: 1.446063106282E+00 -6.042807718989E+00 -1.838779235647E+01, + 0.2500: 1.385023604453E+00 -6.224250890142E+00 -1.762116293543E+01, + 0.2600: 1.322214139912E+00 -6.398041147496E+00 -1.687014143439E+01, + 0.2700: 1.257698280933E+00 -6.563999421766E+00 -1.618917103018E+01, + 0.2800: 1.191550993546E+00 -6.721966747433E+00 -1.557169272820E+01, + 0.2900: 1.123867384642E+00 -6.871956609993E+00 -1.493098374419E+01, + 0.3000: 1.054742885266E+00 -7.014168195238E+00 -1.417962261204E+01, + 0.3100: 9.842685510531E-01 -7.148814287035E+00 -1.326156257658E+01, + 0.3200: 9.125132401609E-01 -7.275902743537E+00 -1.222137902121E+01, + 0.3300: 8.395215287007E-01 -7.395151671984E+00 -1.119335891573E+01, + 0.3400: 7.653428795307E-01 -7.506113781592E+00 -1.029626686842E+01, + 0.3500: 6.900590791093E-01 -7.608367634475E+00 -9.544215634957E+00, + 0.3600: 6.137788764141E-01 -7.701679897781E+00 -8.881682382932E+00, + 0.3700: 5.366297688146E-01 -7.785992394572E+00 -8.194103287833E+00, + 0.3800: 4.587398717607E-01 -7.861312252596E+00 -7.364288728480E+00, + 0.3900: 3.801964103872E-01 -7.927643116349E+00 -6.389513224709E+00, + 0.4000: 3.010494901377E-01 -7.985063701917E+00 -5.369652327233E+00, + 0.4100: 2.213321457456E-01 -8.033871694638E+00 -4.431700385617E+00, + 0.4200: 1.410766572856E-01 -8.074746883519E+00 -3.696351091985E+00, + 0.4300: 6.033520700686E-02 -8.108783354903E+00 -3.209421653760E+00, + 0.4400: -2.081606286020E-02 -8.137409946554E+00 -2.945363329745E+00, + 0.4500: -1.023059863225E-01 -8.162359301778E+00 -2.866685203009E+00, + 0.4600: -1.840872090222E-01 -8.185737154068E+00 -2.944914325100E+00, + 0.4700: -2.661592615911E-01 -8.210173044749E+00 -3.187203130355E+00, + 0.4800: -3.485908036244E-01 -8.238972140439E+00 -3.690605102156E+00, + 0.4900: -4.315038855895E-01 -8.276167670914E+00 -4.592250174679E+00, + 0.5000: -5.150536109905E-01 -8.326382964285E+00 -6.005220018704E+00, + 0.5100: -5.994036485915E-01 -8.394565298298E+00 -7.947844076079E+00, + 0.5200: -6.846867708768E-01 -8.485435247346E+00 -1.022280672827E+01, + 0.5300: -7.709792480403E-01 -8.602238072429E+00 -1.237977608406E+01, + 0.5400: -8.582900944286E-01 -8.744222377428E+00 -1.377673478533E+01, + 0.5500: -9.465268538656E-01 -8.902929414892E+00 -1.365971801432E+01, + 0.5600: -1.035495584541E+00 -9.059380810672E+00 -1.141500044053E+01, + 0.5700: -1.124864111749E+00 -9.185436692939E+00 -6.664662634812E+00, + 0.5800: -1.214179095214E+00 -9.249256033751E+00 5.882752648937E-01, + 0.5900: -1.302891747131E+00 -9.222124201103E+00 9.793122888473E+00, + 0.6000: -1.390313890492E+00 -9.084309970319E+00 2.013387806811E+01, + 0.6100: -1.475617102910E+00 -8.828316502390E+00 3.091661237671E+01, + 0.6200: -1.557948489882E+00 -8.457811110922E+00 4.139233383063E+01, + 0.6300: -1.636408724318E+00 -7.983043083232E+00 5.096115549085E+01, + 0.6400: -1.710039457592E+00 -7.416067193593E+00 5.954575278110E+01, + 0.6500: -1.778018251537E+00 -6.768725327487E+00 6.705796546031E+01, + 0.6600: -1.839645877147E+00 -6.052586855629E+00 7.333139781278E+01, + 0.6700: -1.894213356883E+00 -5.278582137572E+00 7.859830077262E+01, + 0.6800: -1.941120834739E+00 -4.456518494403E+00 8.313593312569E+01, + 0.6900: -1.979954653914E+00 -3.595333512414E+00 8.683343907475E+01, + 0.7000: -2.010345709821E+00 -2.702993485303E+00 8.963945596485E+01 + } + }, + curve = { + m = 1, + kind = cos, + derivs = { + -0.7000: 4.181085969247E-01 1.391633395639E+01 -1.909847060779E+01, + -0.6900: 5.534700982909E-01 1.368861882682E+01 -2.585667063563E+01, + -0.6800: 6.862824266401E-01 1.339373629453E+01 -3.250905348794E+01, + -0.6700: 8.159515705022E-01 1.303390317361E+01 -3.882953365065E+01, + -0.6600: 9.418112136621E-01 1.261171567258E+01 -4.485171465708E+01, + -0.6500: 1.063207103066E+00 1.212959027778E+01 -5.074746228349E+01, + -0.6400: 1.179620790511E+00 1.159003125353E+01 -5.630752599882E+01, + -0.6300: 1.290533713890E+00 1.099585021316E+01 -6.137387298851E+01, + -0.6200: 1.395402690836E+00 1.035003973182E+01 -6.607631361765E+01, + -0.6100: 1.493814962960E+00 9.656648433008E+00 -7.024618805977E+01, + -0.6000: 1.585464064066E+00 8.922441983017E+00 -7.344154364008E+01, + -0.5900: 1.670090721328E+00 8.158221278902E+00 -7.541897175442E+01, + -0.5800: 1.747603615410E+00 7.379682577913E+00 -7.587981686126E+01, + -0.5700: 1.818055255915E+00 6.606233413707E+00 -7.453954337015E+01, + -0.5600: 1.881552577126E+00 5.857603825404E+00 -7.149031655576E+01, + -0.5500: 1.938279416660E+00 5.150482441127E+00 -6.715188802275E+01, + -0.5400: 1.988509719245E+00 4.496036750415E+00 -6.203684596158E+01, + -0.5300: 2.032545059955E+00 3.898428517985E+00 -5.679198052513E+01, + -0.5200: 2.070732452491E+00 3.355531011634E+00 -5.196892542979E+01, + -0.5100: 2.103468803394E+00 2.861332599541E+00 -4.788092726278E+01, + -0.5000: 2.131179933936E+00 2.408210797087E+00 -4.455801550292E+01, + -0.4900: 2.154285557861E+00 1.988489254548E+00 -4.180750261157E+01, + -0.4800: 2.173153781312E+00 1.595345797742E+00 -3.940065431194E+01, + -0.4700: 2.188072076734E+00 1.223268198211E+00 -3.719914785395E+01, + -0.4600: 2.199248159093E+00 8.681139667704E-01 -3.518813942516E+01, + -0.4500: 2.206821016753E+00 5.267759168233E-01 -3.348867719875E+01, + -0.4400: 2.210897266173E+00 1.966942309960E-01 -3.223368573089E+01, + -0.4300: 2.211576746825E+00 -1.244012348897E-01 -3.146245677034E+01, + -0.4200: 2.208968813111E+00 -4.384243426536E-01 -3.108406449023E+01, + -0.4100: 2.203193645549E+00 -7.466938560417E-01 -3.088435325777E+01, + -0.4000: 2.194374441611E+00 -1.049748368222E+00 -3.059685700534E+01, + -0.3900: 2.182608594103E+00 -1.347471227117E+00 -3.006052228472E+01, + -0.3800: 2.167953448688E+00 -1.639554970187E+00 -2.926944475000E+01, + -0.3700: 2.150426934594E+00 -1.925953022986E+00 -2.836253585194E+01, + -0.3600: 2.130027187992E+00 -2.207041946953E+00 -2.755867716286E+01, + -0.3500: 2.106771028299E+00 -2.483411402881E+00 -2.699266431746E+01, + -0.3400: 2.080712439983E+00 -2.755478169193E+00 -2.664330137575E+01, + -0.3300: 2.051929939783E+00 -3.023252265657E+00 -2.640561922040E+01, + -0.3200: 2.020511987278E+00 -3.286431984644E+00 -2.613656311631E+01, + -0.3100: 1.986534779659E+00 -3.544693025967E+00 -2.573945876817E+01, + -0.3000: 1.950039939802E+00 -3.797962218948E+00 -2.523637822898E+01, + -0.2900: 1.911046887728E+00 -4.046384382534E+00 -2.470717408290E+01, + -0.2800: 1.869582866722E+00 -4.290065478921E+00 -2.418748323325E+01, + -0.2700: 1.825697624215E+00 -4.528799852600E+00 -2.366368313393E+01, + -0.2600: 1.779460638261E+00 -4.762033405610E+00 -2.308720849232E+01, + -0.2500: 1.730949103821E+00 -4.989075974737E+00 -2.240988882472E+01, + -0.2400: 1.680226347855E+00 -5.209455222814E+00 -2.166125814302E+01, + -0.2300: 1.627340044667E+00 -5.423052721375E+00 -2.091574001000E+01, + -0.2200: 1.572344311361E+00 -5.629961119550E+00 -2.020472315084E+01, + -0.2100: 1.515310921369E+00 -5.830192627978E+00 -1.950700112590E+01, + -0.2000: 1.456319394884E+00 -6.023488625176E+00 -1.878852617377E+01, + -0.1900: 1.395452161099E+00 -6.209350919374E+00 -1.802200322262E+01, + -0.1800: 1.332783215453E+00 -6.387284351985E+00 -1.723733278558E+01, + -0.1700: 1.268375525879E+00 -6.556997014494E+00 -1.650220876832E+01, + -0.1600: 1.202304525663E+00 -6.718389982612E+00 -1.582451271189E+01, + -0.1500: 1.134674102268E+00 -6.871337651897E+00 -1.510942197715E+01, + -0.1400: 1.065594396840E+00 -7.015515503764E+00 -1.424967544213E+01, + -0.1300: 9.951715642934E-01 -7.150392789523E+00 -1.318061926348E+01, + -0.1200: 9.234903197862E-01 -7.275427732320E+00 -1.194965988315E+01, + -0.1100: 8.506069846846E-01 -7.390306785591E+00 -1.071655010351E+01, + -0.1000: 7.765791912752E-01 -7.495041839382E+00 -9.635644486540E+00, + -0.0900: 7.014994525814E-01 -7.589817591308E+00 -8.738787591925E+00, + -0.0800: 6.254908385541E-01 -7.674774789101E+00 -7.961551206645E+00, + -0.0700: 5.486950074144E-01 -7.749879403712E+00 -7.178124135494E+00, + -0.0600: 4.712582438213E-01 -7.814924191116E+00 -6.249297336791E+00, + -0.0500: 3.932888174826E-01 -7.869688592286E+00 -5.145654147452E+00, + -0.0400: 3.148570811339E-01 -7.914090701647E+00 -3.949570363770E+00, + -0.0300: 2.360198385802E-01 -7.948206644071E+00 -2.769877106313E+00, + -0.0200: 1.568385244559E-01 -7.972183581017E+00 -1.701252967325E+00, + -0.0100: 7.740022180203E-02 -7.986173162590E+00 -7.690979173387E-01, + 0.0000: -2.169799557705E-03 -7.990254923073E+00 8.428305883165E-02, + 0.0100: -8.173159068418E-02 -7.984466697741E+00 9.367095548132E-01, + 0.0200: -1.611449727492E-01 -7.968805337991E+00 1.867033803070E+00, + 0.0300: -2.402841033278E-01 -7.943193287965E+00 2.935363980289E+00, + 0.0400: -3.190612603630E-01 -7.907437411927E+00 4.118456470226E+00, + 0.0500: -3.974145798167E-01 -7.861322745253E+00 5.321923627296E+00, + 0.0600: -4.752872181023E-01 -7.804712687373E+00 6.434614683049E+00, + 0.0700: -5.526093288821E-01 -7.737669733972E+00 7.369409666757E+00, + 0.0800: -6.292739712889E-01 -7.660463021027E+00 8.149234669098E+00, + 0.0900: -7.051373547061E-01 -7.573437580004E+00 8.906177322497E+00, + 0.1000: -7.800616381654E-01 -7.476860125330E+00 9.760166803356E+00, + 0.1100: -8.539287893219E-01 -7.370889264120E+00 1.077323193574E+01, + 0.1200: -9.266523385872E-01 -7.255646909242E+00 1.191613546314E+01, + 0.1300: -9.981813965459E-01 -7.131366061490E+00 1.304231899256E+01, + 0.1400: -1.068466666993E+00 -6.998479109509E+00 1.400372941184E+01, + 0.1500: -1.137430427877E+00 -6.857479363381E+00 1.476570089961E+01, + 0.1600: -1.204973321495E+00 -6.708694336242E+00 1.540314368958E+01, + 0.1700: -1.270991427073E+00 -6.552156001052E+00 1.602902980337E+01, + 0.1800: -1.335385745127E+00 -6.387679747715E+00 1.673979455522E+01, + 0.1900: -1.398083618928E+00 -6.215075707042E+00 1.752692099637E+01, + 0.2000: -1.459022253814E+00 -6.034374186938E+00 1.832157912811E+01, + 0.2100: -1.518125055120E+00 -5.845821915680E+00 1.909312436649E+01, + 0.2200: -1.575304409114E+00 -5.649663584274E+00 1.986814703854E+01, + 0.2300: -1.630473558226E+00 -5.445898806082E+00 2.067861229261E+01, + 0.2400: -1.683552091558E+00 -5.234279823031E+00 2.154091173587E+01, + 0.2500: -1.734476417107E+00 -5.014546033592E+00 2.241590826491E+01, + 0.2600: -1.783189027029E+00 -4.786752203235E+00 2.321951168929E+01, + 0.2700: -1.829616833464E+00 -4.551429191123E+00 2.391235384608E+01, + 0.2800: -1.873673296733E+00 -4.309439856755E+00 2.453462436348E+01, + 0.2900: -1.915280341846E+00 -4.061585616606E+00 2.513022637764E+01, + 0.3000: -1.954380865644E+00 -3.808338939792E+00 2.571140256969E+01, + 0.3100: -1.990942139204E+00 -3.549842719490E+00 2.624295249032E+01, + 0.3200: -2.024941676375E+00 -3.286177195992E+00 2.664545993573E+01, + 0.3300: -2.056337561913E+00 -3.017634987359E+00 2.689608928952E+01, + 0.3400: -2.085056139889E+00 -2.744787727605E+00 2.708966623088E+01, + 0.3500: -2.111013917408E+00 -2.468235919852E+00 2.736815781658E+01, + 0.3600: -2.134138959562E+00 -2.188295728357E+00 2.783898127586E+01, + 0.3700: -2.154384624317E+00 -1.904832766252E+00 2.853118399604E+01, + 0.3800: -2.171741453121E+00 -1.617415194639E+00 2.932311612570E+01, + 0.3900: -2.186217965616E+00 -1.325635329149E+00 3.001237609187E+01, + 0.4000: -2.197801565321E+00 -1.029288241089E+00 3.047637247508E+01, + 0.4100: -2.206438587345E+00 -7.282342966722E-01 3.073283802762E+01, + 0.4200: -2.212033592148E+00 -4.220320938652E-01 3.094652445556E+01, + 0.4300: -2.214463712307E+00 -1.095932839497E-01 3.137788893707E+01, + 0.4400: -2.213607796204E+00 2.108174965195E-01 3.222634935176E+01, + 0.4500: -2.209354666793E+00 5.412968159616E-01 3.356290205065E+01, + 0.4600: -2.201602204819E+00 8.840239127321E-01 3.532848219856E+01, + 0.4700: -2.190241443584E+00 1.241235564690E+00 3.737575486696E+01, + 0.4800: -2.175131501384E+00 1.615586313008E+00 3.957768522080E+01, + 0.4900: -2.156063748546E+00 2.010756116651E+00 4.195194549232E+01, + 0.5000: -2.132750984936E+00 2.431887833568E+00 4.464690985786E+01, + 0.5100: -2.104826371472E+00 2.885598104401E+00 4.790583395906E+01, + 0.5200: -2.071871911439E+00 3.379553384462E+00 5.193732801793E+01, + 0.5300: -2.033463114694E+00 3.921559650635E+00 5.672603442985E+01, + 0.5400: -1.989203225902E+00 4.517981080392E+00 6.196971369341E+01, + 0.5500: -1.938743939622E+00 5.171413933036E+00 6.712132797163E+01, + 0.5600: -1.881781236810E+00 5.878184703775E+00 7.152997650154E+01, + 0.5700: -1.818037993666E+00 6.627503326200E+00 7.467026137105E+01, + 0.5800: -1.747326800024E+00 7.402840347301E+00 7.610387518179E+01, + 0.5900: -1.669537151919E+00 8.184363832794E+00 7.571905291005E+01, + 0.6000: -1.584613529851E+00 8.952333460302E+00 7.378432135727E+01, + 0.6100: -1.492645578883E+00 9.690574360566E+00 7.058880524632E+01, + 0.6200: -1.393893201366E+00 1.038775859283E+01 6.637322557808E+01, + 0.6300: -1.288666537694E+00 1.103661497534E+01 6.158245383319E+01, + 0.6400: -1.177385117074E+00 1.163265202511E+01 5.639264896561E+01, + 0.6500: -1.060601239353E+00 1.217253233519E+01 5.068581290583E+01, + 0.6600: -9.388436983152E-01 1.265324410367E+01 4.463590400749E+01, + 0.6700: -8.126410097728E-01 1.307228392997E+01 3.847082384857E+01, + 0.6800: -6.826564328877E-01 1.342747249036E+01 3.203679475851E+01, + 0.6900: -5.495637567124E-01 1.371665961841E+01 2.531340583741E+01, + 0.7000: -4.139626051566E-01 1.393819177128E+01 1.853179855038E+01 + } + }, + curve = { + m = 3, + kind = sin, + derivs = { + -0.7000: 4.046801042164E-02 3.610042230491E+00 4.726721733369E+01, + -0.6900: 5.952435191607E-02 4.828864366883E+00 1.490830625494E+02, + -0.6800: 1.266008032899E-01 6.687126007441E+00 4.328370798096E+02, + -0.6700: 1.430562786510E-01 9.480303401500E+00 4.512404638653E+02, + -0.6600: 1.099412311501E-01 1.181368202605E+01 2.218064839718E+02, + -0.6500: 9.879946520474E-02 1.319590583589E+01 7.671339872656E+01, + -0.6400: 9.722126348057E-02 1.448844154448E+01 -2.878161377093E+01, + -0.6300: 1.128183093402E-01 1.566530053627E+01 -4.134365664137E+01, + -0.6200: 1.876442965499E-01 1.684766877498E+01 2.271844481308E+02, + -0.6100: 2.467675486504E-01 1.854240979599E+01 4.169494311418E+02, + -0.6000: 2.016507080109E-01 1.959384831043E+01 1.243686804385E+02, + -0.5900: 1.196532485452E-01 1.833479989589E+01 -3.396226975992E+02, + -0.5800: 6.336748756431E-02 1.507817400474E+01 -6.861378853900E+02, + -0.5700: 2.192620339692E-02 1.053804681539E+01 -9.483105972427E+02, + -0.5600: 2.275089124315E-02 5.280190129917E+00 -9.863221784781E+02, + -0.5500: 1.008469809748E-01 5.865648256436E-01 -6.404931524554E+02, + -0.5400: 2.111514843551E-01 -2.343174876234E+00 -1.212534924828E+02, + -0.5300: 3.144377568678E-01 -3.602862629189E+00 3.830021282711E+02, + -0.5200: 3.853274031677E-01 -3.699679587968E+00 7.452272471587E+02, + -0.5100: 4.094530220120E-01 -3.203689428201E+00 8.903751579407E+02, + -0.5000: 3.660801894146E-01 -2.558614443722E+00 7.202990352751E+02, + -0.4900: 2.596954165411E-01 -2.051325107901E+00 2.585363507108E+02, + -0.4800: 1.208051530438E-01 -1.838876556090E+00 -3.453101116265E+02, + -0.4700: -2.600812788501E-03 -1.988198436847E+00 -8.604408318303E+02, + -0.4600: -5.935148560915E-02 -2.389034764935E+00 -1.045540351311E+03, + -0.4500: -1.699802006101E-02 -2.813708923635E+00 -7.535078739029E+02, + -0.4400: 1.015811820522E-01 -2.917044032520E+00 -9.706039115657E+01, + -0.4300: 2.315430544268E-01 -2.526331276402E+00 6.158530177454E+02, + -0.4200: 3.049211215287E-01 -1.711652705106E+00 1.061588011874E+03, + -0.4100: 2.784507364994E-01 -7.756332526534E-01 1.033690872875E+03, + -0.4000: 1.697544276884E-01 1.917968730855E-02 6.088421451538E+02, + -0.3900: 2.647124285464E-02 5.236103861944E-01 9.008405791505E+00, + -0.3800: -1.008203301852E-01 7.345389007257E-01 -5.257249740345E+02, + -0.3700: -1.762900175991E-01 7.253013383425E-01 -8.225363956709E+02, + -0.3600: -1.862559208121E-01 5.603571965646E-01 -8.158910783337E+02, + -0.3500: -1.506561762934E-01 3.291191127291E-01 -5.995565573889E+02, + -0.3400: -8.628446690414E-02 1.453257636639E-01 -2.578626994456E+02, + -0.3300: -8.638003893584E-03 1.216277012466E-01 1.299899351457E+02, + -0.3200: 6.934995046467E-02 3.806817305391E-01 4.987626719509E+02, + -0.3100: 1.361623190880E-01 1.037504909102E+00 7.944010647318E+02, + -0.3000: 1.667233263790E-01 1.969903828095E+00 9.075037869880E+02, + -0.2900: 1.385151964256E-01 2.835917870556E+00 7.410507631828E+02, + -0.2800: 5.856251994930E-02 3.266993075326E+00 3.318378804748E+02, + -0.2700: -3.588391046631E-02 3.113045046960E+00 -1.451537189278E+02, + -0.2600: -1.117485198397E-01 2.474906103311E+00 -5.323707207139E+02, + -0.2500: -1.421748220469E-01 1.659937553082E+00 -7.003647490940E+02, + -0.2400: -1.328133342086E-01 9.343262269201E-01 -6.662387668503E+02, + -0.2300: -1.119218932074E-01 3.310805539563E-01 -5.532679110380E+02, + -0.2200: -9.475626807477E-02 -2.471321734059E-01 -4.318213111031E+02, + -0.2100: -7.882157365856E-02 -8.283455502306E-01 -2.930793092507E+02, + -0.2000: -5.585117695061E-02 -1.382692579762E+00 -1.034952774145E+02, + -0.1900: -1.075285715442E-02 -1.732314676972E+00 1.988360411063E+02, + -0.1800: 4.837372736875E-02 -1.664382303601E+00 5.700938216087E+02, + -0.1700: 8.651213719621E-02 -1.181674809044E+00 8.424183799152E+02, + -0.1600: 7.436204978052E-02 -4.911747280557E-01 8.710562812669E+02, + -0.1500: 5.297364645456E-03 2.244480470830E-01 6.176565663512E+02, + -0.1400: -1.053269981824E-01 7.261105449573E-01 1.512921737866E+02, + -0.1300: -2.129515483790E-01 9.454418946997E-01 -3.208761652595E+02, + -0.1200: -2.868363542453E-01 9.636663298488E-01 -6.480833286407E+02, + -0.1100: -3.189291276873E-01 7.863395211917E-01 -7.832617068191E+02, + -0.1000: -3.154992786387E-01 3.616957638746E-01 -7.501448006477E+02, + -0.0900: -2.756404132159E-01 -2.278662514615E-01 -5.464806149007E+02, + -0.0800: -2.049500975857E-01 -8.083448532827E-01 -2.018468052105E+02, + -0.0700: -1.096979322462E-01 -1.142906929632E+00 2.483249255625E+02, + -0.0600: -1.388479923506E-02 -8.915990533703E-01 6.907857081609E+02, + -0.0500: 4.068131027530E-02 -5.165085412407E-02 9.364215852822E+02, + -0.0400: 2.573748447772E-02 1.058558265330E+00 8.576649335029E+02, + -0.0300: -6.467117588493E-02 1.987513719376E+00 4.294069921597E+02, + -0.0200: -2.046064341945E-01 2.263370322973E+00 -2.270980572798E+02, + -0.0100: -3.317361890536E-01 1.665424483860E+00 -8.270783178252E+02, + 0.0000: -3.785330901707E-01 4.915734451930E-01 -1.062515786143E+03, + 0.0100: -3.234621134688E-01 -7.152192762026E-01 -8.329743357161E+02, + 0.0200: -1.887136220287E-01 -1.412333086239E+00 -2.389596608848E+02, + 0.0300: -4.244839205328E-02 -1.301086197843E+00 4.116835752495E+02, + 0.0400: 5.242532823950E-02 -5.968022444810E-01 8.346427762721E+02, + 0.0500: 6.950504235217E-02 2.406212953238E-01 9.092379039486E+02, + 0.0600: 1.443451804351E-02 7.770007867356E-01 6.609382779132E+02, + 0.0700: -8.467982220288E-02 7.117426900485E-01 2.171803700939E+02, + 0.0800: -1.860507190502E-01 5.942449934217E-02 -2.334434887530E+02, + 0.0900: -2.655972229855E-01 -8.366517654417E-01 -5.781581871761E+02, + 0.1000: -3.169296202489E-01 -1.740801626430E+00 -7.815815374998E+02, + 0.1100: -3.343381731983E-01 -2.477347793404E+00 -8.136541429294E+02, + 0.1200: -3.186228255008E-01 -2.952790904926E+00 -6.757932636694E+02, + 0.1300: -2.633813286706E-01 -3.196265327090E+00 -3.435524749416E+02, + 0.1400: -1.764507530391E-01 -3.173138229514E+00 1.361141263546E+02, + 0.1500: -8.816870405727E-02 -2.775660270824E+00 6.119413411372E+02, + 0.1600: -4.239402450384E-02 -2.054070097280E+00 8.760328282216E+02, + 0.1700: -5.346625679479E-02 -1.238553553172E+00 8.585780317464E+02, + 0.1800: -1.135350970783E-01 -5.119190856279E-01 5.971158486948E+02, + 0.1900: -1.920412579782E-01 -9.134074501508E-02 2.354182063484E+02, + 0.2000: -2.528766834267E-01 -1.283694727127E-03 -5.977594665833E+01, + 0.2100: -2.872011638805E-01 -6.266058487307E-02 -2.457074333993E+02, + 0.2200: -3.098118125326E-01 -1.405517047032E-01 -3.848716658603E+02, + 0.2300: -3.291173674240E-01 -2.492073618087E-01 -5.105681288184E+02, + 0.2400: -3.481255494531E-01 -4.521493110347E-01 -6.305898093361E+02, + 0.2500: -3.523606366023E-01 -8.672339817482E-01 -6.732029896664E+02, + 0.2600: -3.145006419821E-01 -1.466481904427E+00 -5.140102403368E+02, + 0.2700: -2.299094045278E-01 -1.979294840384E+00 -1.355104967745E+02, + 0.2800: -1.264675515986E-01 -2.094322529779E+00 3.325366171711E+02, + 0.2900: -3.819025911313E-02 -1.713082540179E+00 7.321703839477E+02, + 0.3000: -3.099486822106E-03 -9.916814122619E-01 8.885973168453E+02, + 0.3100: -2.878222170224E-02 -2.998929497970E-01 7.660707261356E+02, + 0.3200: -9.307533048023E-02 3.299824122098E-02 4.632434988458E+02, + 0.3300: -1.711012062622E-01 -8.511356510475E-02 9.095844562505E+01, + 0.3400: -2.514399607017E-01 -4.984132073605E-01 -2.962640757023E+02, + 0.3500: -3.211393383968E-01 -1.045026886781E+00 -6.338269307592E+02, + 0.3600: -3.645050155808E-01 -1.583403377310E+00 -8.437887809776E+02, + 0.3700: -3.643216947162E-01 -1.983340987113E+00 -8.430531700328E+02, + 0.3800: -2.999948760250E-01 -2.148221872610E+00 -5.385661043989E+02, + 0.3900: -1.843877258459E-01 -2.009858186964E+00 3.971898565756E+00, + 0.4000: -5.250799159655E-02 -1.492016042022E+00 6.116632475237E+02, + 0.4100: 4.577606847153E-02 -5.984366753335E-01 1.044141739218E+03, + 0.4200: 6.341879193302E-02 5.151244101947E-01 1.079147734091E+03, + 0.4300: -1.672151602964E-02 1.575230298731E+00 6.398142292367E+02, + 0.4400: -1.510520660386E-01 2.266043048184E+00 -6.770226166770E+01, + 0.4500: -2.714292402474E-01 2.501731432289E+00 -7.201929584844E+02, + 0.4600: -3.129460226050E-01 2.437299420195E+00 -1.010071831342E+03, + 0.4700: -2.527887640565E-01 2.399956965190E+00 -8.249462004300E+02, + 0.4800: -1.236200163716E-01 2.598758991457E+00 -3.123021767868E+02, + 0.4900: 2.307248400519E-02 3.123142543561E+00 2.863060729493E+02, + 0.5000: 1.389209697340E-01 3.883401210963E+00 7.402045040604E+02, + 0.5100: 1.929894487373E-01 4.699950299506E+00 9.003537825366E+02, + 0.5200: 1.803575383896E-01 5.268709562466E+00 7.444025993754E+02, + 0.5300: 1.214060538223E-01 5.142962312428E+00 3.724521049182E+02, + 0.5400: 3.028346119894E-02 3.772949572822E+00 -1.380910895908E+02, + 0.5500: -6.774076025886E-02 6.966212094511E-01 -6.584456864992E+02, + 0.5600: -1.335005531424E-01 -4.121983721301E+00 -1.000207906451E+03, + 0.5700: -1.219552992757E-01 -9.434611759788E+00 -9.549033693775E+02, + 0.5800: -6.807124657026E-02 -1.393962950876E+01 -6.853397214854E+02, + 0.5900: 8.196392829802E-04 -1.708754613174E+01 -3.343445748090E+02, + 0.6000: 9.569084015369E-02 -1.820797653057E+01 1.295883420878E+02, + 0.6100: 1.540032582260E-01 -1.703949026570E+01 4.178697107923E+02, + 0.6200: 1.082592075895E-01 -1.528956168102E+01 2.211417489352E+02, + 0.6300: 4.655576172467E-02 -1.413521665204E+01 -5.537255690631E+01, + 0.6400: 4.311624930934E-02 -1.307577512247E+01 -5.089591137020E+01, + 0.6500: 5.505585785118E-02 -1.198928459704E+01 4.661455984728E+01, + 0.6600: 7.396933878246E-02 -1.089987232574E+01 1.838052449833E+02, + 0.6700: 1.116386468746E-01 -8.942769308052E+00 4.058391708504E+02, + 0.6800: 9.614025453680E-02 -6.597974674916E+00 3.817845578058E+02, + 0.6900: 2.633541543704E-02 -5.232614731650E+00 9.601955136625E+01, + 0.7000: 1.116055617143E-03 -4.503745836149E+00 -2.266076367045E+00 + } + }, + curve = { + m = 3, + kind = cos, + derivs = { + -0.7000: -3.671281213535E-02 -8.584643390395E+00 1.646853065098E+01, + -0.6900: 3.398168069257E-02 -8.014609620246E+00 2.289398112443E+02, + -0.6800: 4.432358092742E-02 -7.314736409891E+00 1.701185098853E+02, + -0.6700: 2.835586291980E-03 -7.403654209653E+00 -1.228360984290E+02, + -0.6600: 3.799284474683E-03 -7.745533453087E+00 -2.070510568077E+02, + -0.6500: 3.412243198603E-02 -7.878274575579E+00 -1.233229412385E+02, + -0.6400: 6.634815112581E-02 -8.203759587482E+00 -5.509477520220E+00, + -0.6300: 1.355228193239E-01 -7.915619730534E+00 2.868152348096E+02, + -0.6200: 1.806665356884E-01 -6.318243307212E+00 4.710109151529E+02, + -0.6100: 1.359408061997E-01 -4.614812591603E+00 2.419282998117E+02, + -0.6000: 8.690846866200E-02 -3.308052706321E+00 -1.195778278684E+01, + -0.5900: 9.775369184820E-02 -1.589493179981E+00 2.042214689137E+01, + -0.5800: 1.254641963144E-01 4.365979024942E-01 1.536080713690E+02, + -0.5700: 1.611580024218E-01 2.315991716634E+00 3.414835431085E+02, + -0.5600: 2.185015397962E-01 4.173476880489E+00 6.384443416804E+02, + -0.5500: 2.549716857912E-01 6.009011202565E+00 8.413464457593E+02, + -0.5400: 2.414875312643E-01 7.281899191391E+00 8.041872942687E+02, + -0.5300: 1.850848671459E-01 7.911488154748E+00 5.581382812007E+02, + -0.5200: 1.009627447828E-01 7.914940805766E+00 1.781731062393E+02, + -0.5100: -2.349475663905E-03 7.353098934819E+00 -2.881299731888E+02, + -0.5000: -1.070977751584E-01 6.114661714420E+00 -7.529363278437E+02, + -0.4900: -1.728900881490E-01 4.308831888174E+00 -1.031383148811E+03, + -0.4800: -1.706931649994E-01 2.336145432366E+00 -9.914038798882E+02, + -0.4700: -9.167697779492E-02 6.866994935454E-01 -5.950213734535E+02, + -0.4600: 4.348369165383E-02 -1.777883704580E-01 5.800642672033E+01, + -0.4500: 1.789142378278E-01 -1.274379403493E-02 7.077513966830E+02, + -0.4400: 2.445191331183E-01 9.246918461230E-01 1.030445986277E+03, + -0.4300: 2.117082254438E-01 2.098893535980E+00 8.902811287470E+02, + -0.4200: 9.490959490301E-02 2.945891495962E+00 3.512932539575E+02, + -0.4100: -4.511146698778E-02 3.059023974383E+00 -3.094333620781E+02, + -0.4000: -1.423507983942E-01 2.488529072989E+00 -7.889886349881E+02, + -0.3900: -1.652923358853E-01 1.589258828069E+00 -9.374882351072E+02, + -0.3800: -1.142818107370E-01 7.550878822087E-01 -7.508922028622E+02, + -0.3700: -1.441379444520E-02 3.437053148921E-01 -3.382187389362E+02, + -0.3600: 9.435030575959E-02 4.890129422397E-01 1.226689942738E+02, + -0.3500: 1.816989496555E-01 9.639286411697E-01 4.927540695971E+02, + -0.3400: 2.400260109868E-01 1.554634637985E+00 7.304546529375E+02, + -0.3300: 2.617684784693E-01 2.080326322095E+00 7.961885718389E+02, + -0.3200: 2.482469658483E-01 2.386940793855E+00 6.907161879417E+02, + -0.3100: 1.947014814502E-01 2.486085046718E+00 3.934232433708E+02, + -0.3000: 1.068206326346E-01 2.378158236858E+00 -6.163039484048E+01, + -0.2900: 1.056601892066E-02 1.993625485022E+00 -5.445332319562E+02, + -0.2800: -4.973143379198E-02 1.345325801842E+00 -8.456660902308E+02, + -0.2700: -5.449324386404E-02 6.273163374509E-01 -8.711017550230E+02, + -0.2600: -8.958872155297E-03 -3.139882637430E-02 -6.458280246944E+02, + -0.2500: 6.169195507679E-02 -4.446077893748E-01 -2.902197028706E+02, + -0.2400: 1.206700312053E-01 -5.319542693512E-01 2.323016461915E+01, + -0.2300: 1.542498200894E-01 -4.055264297357E-01 2.273892538157E+02, + -0.2200: 1.758677250213E-01 -1.967039913751E-01 3.768780221319E+02, + -0.2100: 1.944884459437E-01 8.736778661580E-02 5.068623965244E+02, + -0.2000: 2.133436204859E-01 4.528993009336E-01 6.270076102311E+02, + -0.1900: 2.219269346681E-01 9.522159355847E-01 6.859264273464E+02, + -0.1800: 1.925361754077E-01 1.571942107261E+00 5.594932655984E+02, + -0.1700: 1.150383473397E-01 2.102098033584E+00 2.075436564271E+02, + -0.1600: 1.332290815921E-02 2.263105225586E+00 -2.563322569813E+02, + -0.1500: -7.996380355510E-02 1.950031166283E+00 -6.795098692619E+02, + -0.1400: -1.266635365118E-01 1.268198667927E+00 -8.861367635715E+02, + -0.1300: -1.124948680545E-01 5.192557183916E-01 -8.098543167562E+02, + -0.1200: -5.696390275009E-02 1.908688159834E-02 -5.367016675778E+02, + -0.1100: 1.536455077248E-02 -1.000493751687E-01 -1.751414390452E+02, + -0.1000: 9.035051707616E-02 6.245677333357E-02 2.103223119125E+02, + -0.0900: 1.566848049048E-01 3.856473696166E-01 5.635524129433E+02, + -0.0800: 1.980092037967E-01 7.671488055550E-01 8.037562765186E+02, + -0.0700: 1.982140910858E-01 1.083984525493E+00 8.517182896751E+02, + -0.0600: 1.346592085272E-01 1.237859496905E+00 6.022495448502E+02, + -0.0500: 1.552957121518E-02 1.156352879882E+00 9.651833384798E+01, + -0.0400: -1.267495784333E-01 7.838462096259E-01 -5.076511641614E+02, + -0.0300: -2.430815970647E-01 1.262873268265E-01 -9.757776004604E+02, + -0.0200: -2.839167178183E-01 -6.601825885277E-01 -1.075998425348E+03, + -0.0100: -2.237496110930E-01 -1.321249634907E+00 -6.949050893631E+02, + 0.0000: -9.616401012889E-02 -1.527506041521E+00 4.175874154052E+00, + 0.0100: 3.212632239740E-02 -1.163259888858E+00 7.027822183139E+02, + 0.0200: 9.433074129652E-02 -3.548451389963E-01 1.082397178208E+03, + 0.0300: 5.666065758465E-02 5.556525061299E-01 9.796667286293E+02, + 0.0400: -5.565956098149E-02 1.300478646138E+00 5.082223867816E+02, + 0.0500: -1.933908937119E-01 1.713473512874E+00 -9.954027322302E+01, + 0.0600: -3.077358542018E-01 1.786463399225E+00 -6.084172648169E+02, + 0.0700: -3.665103328255E-01 1.582857108335E+00 -8.598711103903E+02, + 0.0800: -3.616472576865E-01 1.192215860587E+00 -8.121599174286E+02, + 0.0900: -3.157107043249E-01 7.368925342810E-01 -5.700424363973E+02, + 0.1000: -2.445337691589E-01 3.674478796509E-01 -2.125343891547E+02, + 0.1100: -1.640802023436E-01 2.121526290228E-01 1.792988350323E+02, + 0.1200: -8.524112446370E-02 4.099147117440E-01 5.484922728435E+02, + 0.1300: -2.179322255816E-02 1.065761786814E+00 8.292930810455E+02, + 0.1400: 1.910831534900E-03 2.038399404818E+00 9.116617333641E+02, + 0.1500: -3.362391284755E-02 2.986849181629E+00 7.079180599706E+02, + 0.1600: -1.142421970866E-01 3.571323441381E+00 2.834224846444E+02, + 0.1700: -2.019760648360E-01 3.645257596287E+00 -1.857397453706E+02, + 0.1800: -2.644516738750E-01 3.281061499292E+00 -5.456320698320E+02, + 0.1900: -2.781805977017E-01 2.741735529195E+00 -6.809234618594E+02, + 0.2000: -2.538295089628E-01 2.237531688606E+00 -6.302776245250E+02, + 0.2100: -2.197250882898E-01 1.794268230503E+00 -5.170044638766E+02, + 0.2200: -1.870012054621E-01 1.376409762214E+00 -3.924031860159E+02, + 0.2300: -1.529572336275E-01 9.921539613327E-01 -2.471504126749E+02, + 0.2400: -1.089987254097E-01 6.578122944927E-01 -4.645802525863E+01, + 0.2500: -4.186820607111E-02 5.101427966897E-01 2.642422458156E+02, + 0.2600: 3.470166151704E-02 6.675669648090E-01 6.181681856613E+02, + 0.2700: 8.399180738165E-02 1.060790103686E+00 8.431519367314E+02, + 0.2800: 8.087504898326E-02 1.517248730358E+00 8.186235132098E+02, + 0.2900: 2.012910452279E-02 1.917530898492E+00 5.188944537579E+02, + 0.3000: -7.866153073029E-02 2.068288508392E+00 3.711639237095E+01, + 0.3100: -1.711388738362E-01 1.949287931783E+00 -4.174550654306E+02, + 0.3200: -2.312397186160E-01 1.621073307703E+00 -7.145107508181E+02, + 0.3300: -2.530525040485E-01 1.082449090988E+00 -8.188565869664E+02, + 0.3400: -2.409717993294E-01 3.368486107855E-01 -7.496779674331E+02, + 0.3500: -1.931595219308E-01 -4.298547903912E-01 -5.051050750744E+02, + 0.3600: -1.165449195278E-01 -9.956952842145E-01 -1.245652029146E+02, + 0.3700: -1.804816985296E-02 -1.110526182065E+00 3.492755766609E+02, + 0.3800: 7.272886757847E-02 -5.291327913687E-01 7.754959900420E+02, + 0.3900: 1.164998455645E-01 6.090906602352E-01 9.741008575027E+02, + 0.4000: 8.867022513351E-02 1.917760910797E+00 8.339380577031E+02, + 0.4100: -1.086715914770E-02 2.953978830320E+00 3.572274108210E+02, + 0.4200: -1.505890626318E-01 3.301135686626E+00 -3.070321353727E+02, + 0.4300: -2.646944123554E-01 2.846123159707E+00 -8.555891100544E+02, + 0.4400: -2.928321926670E-01 1.942428184031E+00 -1.009906735234E+03, + 0.4500: -2.211266809998E-01 1.120596333477E+00 -7.034698493288E+02, + 0.4600: -7.877872462717E-02 9.119867611973E-01 -6.897499170387E+01, + 0.4700: 6.346560880067E-02 1.600570635010E+00 5.726099294548E+02, + 0.4800: 1.491216547553E-01 2.991525973989E+00 9.631603722313E+02, + 0.4900: 1.570994576872E-01 4.684233535553E+00 1.003643294912E+03, + 0.5000: 9.606901704554E-02 6.249552495898E+00 7.315780576024E+02, + 0.5100: -4.888112289342E-03 7.334824832740E+00 2.772899380833E+02, + 0.5200: -1.051945142724E-01 7.854326561694E+00 -1.770475917539E+02, + 0.5300: -1.868914799586E-01 7.913102619570E+00 -5.466762049993E+02, + 0.5400: -2.413337382514E-01 7.415371088229E+00 -7.867636674933E+02, + 0.5500: -2.532569896168E-01 6.289798121310E+00 -8.236648384055E+02, + 0.5600: -2.155034645185E-01 4.563185471085E+00 -6.253632594419E+02, + 0.5700: -1.569728124705E-01 2.743743512497E+00 -3.353454101938E+02, + 0.5800: -1.200241447597E-01 8.298830449106E-01 -1.539625064781E+02, + 0.5900: -9.091989419721E-02 -1.280552600731E+00 -2.508966007657E+01, + 0.6000: -7.864409259724E-02 -3.104729980954E+00 5.084637682833E+00, + 0.6100: -1.265083115576E-01 -4.523767395593E+00 -2.504337120492E+02, + 0.6200: -1.707265071794E-01 -6.353848150451E+00 -4.821772067639E+02, + 0.6300: -1.261088064407E-01 -8.112875540773E+00 -3.019926591073E+02, + 0.6400: -5.879624037420E-02 -8.611944696773E+00 -1.378862995031E+01, + 0.6500: -3.001091829585E-02 -8.539449330552E+00 1.018258081404E+02, + 0.6600: -4.893145376171E-03 -8.671152690395E+00 1.869452424606E+02, + 0.6700: -1.098306710978E-02 -8.561855220155E+00 1.082463340162E+02, + 0.6800: -6.125536435824E-02 -8.632226066039E+00 -1.756982323553E+02, + 0.6900: -6.103120523031E-02 -9.388572474383E+00 -2.233807857688E+02, + 0.7000: -1.101236671657E-03 -9.897972924388E+00 7.298747527681E-01 + } + }, + curve = { + m = 5, + kind = sin, + derivs = { + -0.7000: -7.193840136883E+00 -1.061781285491E+03 -5.017190372954E+04, + -0.6900: -4.596359101659E-01 -1.184212615307E+03 -7.053243206886E+03, + -0.6800: -6.169006606944E+00 -1.366233051748E+03 -5.706093323075E+04, + -0.6700: -1.355614495362E+01 -1.926410223018E+03 -1.216449065201E+05, + -0.6600: -4.649443140450E+00 -2.494265861845E+03 -6.530085278869E+04, + -0.6500: 3.727119151015E+00 -2.758821263929E+03 -1.021837229933E+04, + -0.6400: -2.921126515435E+00 -3.123551409616E+03 -6.538507595427E+04, + -0.6300: -6.139648356442E+00 -3.666672717006E+03 -9.236616137689E+04, + -0.6200: -2.337891861952E+00 -4.107391847562E+03 -5.930430687828E+04, + -0.6100: -3.579370043256E+00 -4.499862381439E+03 -5.656432886078E+04, + -0.6000: 4.270944058103E+00 -4.734003105943E+03 1.399912763009E+04, + -0.5900: 2.159931837840E+01 -4.345826193249E+03 1.535473684663E+05, + -0.5800: 2.754732006009E+01 -3.433392011049E+03 2.061344672197E+05, + -0.5700: 2.196996396173E+01 -2.318242856687E+03 1.667425498869E+05, + -0.5600: 1.183570827681E+01 -1.142833489727E+03 8.804833355012E+04, + -0.5500: -2.517915357654E+00 -1.418816636044E+02 -2.321354179829E+04, + -0.5400: -1.347104683042E+01 3.900023047811E+02 -1.076406313464E+05, + -0.5300: -1.066918039260E+01 5.600345594974E+02 -8.626330318411E+04, + -0.5200: 3.575918383916E+00 5.716539162693E+02 2.312994650492E+04, + -0.5100: 1.987583941102E+01 5.791534195650E+02 1.473866424762E+05, + -0.5000: 2.574250184706E+01 6.187003960620E+02 1.903168944337E+05, + -0.4900: 1.652289589001E+01 6.271191975999E+02 1.162897172731E+05, + -0.4800: -1.464123920134E+00 5.312248490584E+02 -2.584660735548E+04, + -0.4700: -1.870939980689E+01 3.262061159326E+02 -1.606357850505E+05, + -0.4600: -2.620326328510E+01 6.107479518638E+01 -2.162759627669E+05, + -0.4500: -2.008116695192E+01 -1.691521918071E+02 -1.618403508547E+05, + -0.4400: -5.164961309219E+00 -3.099763637054E+02 -3.512098585319E+04, + -0.4300: 1.106870050677E+01 -3.378168826922E+02 1.021812826198E+05, + -0.4200: 2.082641468513E+01 -2.721339845652E+02 1.856969794119E+05, + -0.4100: 1.799586740641E+01 -1.595135827695E+02 1.663239600176E+05, + -0.4000: 3.097868687778E+00 -9.096940646137E+01 4.935407116211E+04, + -0.3900: -1.551108161595E+01 -1.321396120952E+02 -9.890994617659E+04, + -0.3800: -2.833206248441E+01 -2.898896096559E+02 -2.021277381816E+05, + -0.3700: -2.672758091904E+01 -4.963452927284E+02 -1.927665075160E+05, + -0.3600: -1.083715382400E+01 -6.292053602037E+02 -7.115347636337E+04, + -0.3500: 8.898293073381E+00 -6.103671254106E+02 8.295089439510E+04, + -0.3400: 2.165253141924E+01 -4.535067242909E+02 1.855830917148E+05, + -0.3300: 2.135327305246E+01 -2.387643232849E+02 1.884419995156E+05, + -0.3200: 7.287889246470E+00 -8.386771551513E+01 8.576838790856E+04, + -0.3100: -1.111585869791E+01 -9.279349908656E+01 -5.176669350415E+04, + -0.3000: -2.192118844297E+01 -2.476720071350E+02 -1.348295604018E+05, + -0.2900: -2.066190174426E+01 -4.349790758718E+02 -1.292606256805E+05, + -0.2800: -1.160452019645E+01 -5.391807545547E+02 -6.539402088091E+04, + -0.2700: -1.500860371591E+00 -5.216040287423E+02 7.650155854493E+03, + -0.2600: 2.650897165687E+00 -4.224025134237E+02 3.855242930261E+04, + -0.2500: 9.053864258519E-01 -3.345078427276E+02 2.773488098710E+04, + -0.2400: -9.780524888691E-01 -3.080942987639E+02 1.659331087287E+04, + -0.2300: 4.901427593112E-02 -3.109592219366E+02 2.629253285012E+04, + -0.2200: 1.746669315707E+00 -2.928833804948E+02 3.998113708977E+04, + -0.2100: 2.139514801516E+00 -2.469793060984E+02 4.297552632924E+04, + -0.2000: -1.487865605671E-01 -1.823521237468E+02 2.538915782165E+04, + -0.1900: -4.283011024485E+00 -1.396568974886E+02 -5.716010857544E+03, + -0.1800: -5.659853793720E+00 -1.482334508147E+02 -1.686236948758E+04, + -0.1700: -2.689006379345E+00 -1.744476799942E+02 2.193552944418E+03, + -0.1600: -4.920827759320E-01 -1.734742213735E+02 1.337758233190E+04, + -0.1500: -3.200532953875E+00 -1.715842997708E+02 -1.308283110937E+04, + -0.1400: -1.005580911252E+01 -1.882323931650E+02 -6.982920271776E+04, + -0.1300: -1.726323675578E+01 -2.558289642468E+02 -1.252807245230E+05, + -0.1200: -1.651921844972E+01 -3.761628601553E+02 -1.166462302712E+05, + -0.1100: -3.801991795436E+00 -4.618159339096E+02 -1.542384314997E+04, + -0.1000: 1.464393686779E+01 -4.063992920766E+02 1.294533218720E+05, + -0.0900: 2.746790042585E+01 -1.990570154798E+02 2.310216523790E+05, + -0.0800: 2.710331364422E+01 9.076451234956E+01 2.304229634779E+05, + -0.0700: 1.001492349756E+01 3.387453281848E+02 1.018002139640E+05, + -0.0600: -1.636466480497E+01 3.783552129335E+02 -9.815692781376E+04, + -0.0500: -3.639824462482E+01 1.824597770209E+02 -2.520591863490E+05, + -0.0400: -3.939991339316E+01 -1.388854579143E+02 -2.785359579479E+05, + -0.0300: -2.371159607691E+01 -4.235661565392E+02 -1.645610305344E+05, + -0.0200: 4.081913225233E+00 -5.077965435076E+02 3.975614780560E+04, + -0.0100: 2.890456111358E+01 -3.212093176681E+02 2.221417085996E+05, + 0.0000: 3.871343576890E+01 3.378328633737E+01 2.926251433848E+05, + 0.0100: 2.954935762728E+01 3.847211622578E+02 2.213249055118E+05, + 0.0200: 5.291377471238E+00 5.595106247386E+02 3.816955610488E+04, + 0.0300: -2.207437048733E+01 4.570796390060E+02 -1.667432943073E+05, + 0.0400: -3.749326328358E+01 1.506136585454E+02 -2.809501582230E+05, + 0.0500: -3.437075063322E+01 -1.917841484319E+02 -2.542025739391E+05, + 0.0600: -1.433906450167E+01 -4.033574243319E+02 -9.955208371490E+04, + 0.0700: 1.194303286317E+01 -3.709169693144E+02 1.014263954802E+05, + 0.0800: 2.885801888759E+01 -1.210399488549E+02 2.310480863015E+05, + 0.0900: 2.898354964949E+01 1.779220801520E+02 2.323531310904E+05, + 0.1000: 1.586357351231E+01 3.984481024069E+02 1.310464979605E+05, + 0.1100: -2.915496708185E+00 4.677973697271E+02 -1.401975455585E+04, + 0.1200: -1.596637646978E+01 3.942780418784E+02 -1.157956270187E+05, + 0.1300: -1.699353369485E+01 2.824381050837E+02 -1.252265829350E+05, + 0.1400: -9.961610079379E+00 2.182378357350E+02 -7.065648503451E+04, + 0.1500: -3.129652696127E+00 1.989586985888E+02 -1.467444225227E+04, + 0.1600: -2.835025618166E-01 1.924049521308E+02 1.134205775003E+04, + 0.1700: -2.218506288158E+00 1.809887773287E+02 1.693748342311E+02, + 0.1800: -4.876149456541E+00 1.417533440068E+02 -1.841965942009E+04, + 0.1900: -3.221443500245E+00 1.231539339151E+02 -6.514198512064E+03, + 0.2000: 1.083819259935E+00 1.612570277053E+02 2.537415114655E+04, + 0.2100: 3.402711591204E+00 2.270140754942E+02 4.350872567986E+04, + 0.2200: 2.907366175560E+00 2.779216772282E+02 4.065716018879E+04, + 0.2300: 1.011205514970E+00 3.016332037748E+02 2.667124218344E+04, + 0.2400: -2.576305204196E-01 3.017487431317E+02 1.636377499568E+04, + 0.2500: 1.390786525724E+00 3.265124371170E+02 2.681220062214E+04, + 0.2600: 2.938702600664E+00 4.078376459382E+02 3.704569165069E+04, + 0.2700: -1.360753565346E+00 4.965678224077E+02 5.799844466408E+03, + 0.2800: -1.155609020580E+01 5.018822521344E+02 -6.722855510756E+04, + 0.2900: -2.064472729111E+01 3.867344539280E+02 -1.306279090699E+05, + 0.3000: -2.187319704317E+01 1.934933829798E+02 -1.352880271420E+05, + 0.3100: -1.097417410131E+01 4.110439728652E+01 -5.102673968085E+04, + 0.3200: 7.590061664688E+00 4.489009987010E+01 8.772821920351E+04, + 0.3300: 2.189548519910E+01 2.219061120336E+02 1.913516783445E+05, + 0.3400: 2.253570332003E+01 4.649030149069E+02 1.889699961700E+05, + 0.3500: 1.023763497353E+01 6.512648340607E+02 8.628270995525E+04, + 0.3600: -8.938906609764E+00 6.955822684699E+02 -6.832597507313E+04, + 0.3700: -2.421372614293E+01 5.803048905295E+02 -1.906997329392E+05, + 0.3800: -2.522072572049E+01 3.821938392337E+02 -2.008741341632E+05, + 0.3900: -1.190829911436E+01 2.242540486261E+02 -9.841128316183E+04, + 0.4000: 7.014785501941E+00 1.760939950939E+02 4.918216877324E+04, + 0.4100: 2.202128061371E+01 2.330403553041E+02 1.655869565632E+05, + 0.4200: 2.477200525645E+01 3.317474478299E+02 1.845404007486E+05, + 0.4300: 1.479409836718E+01 3.833094353741E+02 1.007711729865E+05, + 0.4400: -1.737090781582E+00 3.428327110998E+02 -3.664226506029E+04, + 0.4500: -1.696058310598E+01 1.918468477182E+02 -1.633768450685E+05, + 0.4600: -2.333635823604E+01 -4.597357894141E+01 -2.177698456624E+05, + 0.4700: -1.599213002734E+01 -3.168259918899E+02 -1.620548482873E+05, + 0.4800: 1.238805096325E+00 -5.267897439071E+02 -2.716652734815E+04, + 0.4900: 1.935576521600E+01 -6.278649718301E+02 1.151264399810E+05, + 0.5000: 2.883269274057E+01 -6.253462335357E+02 1.894257194172E+05, + 0.5100: 2.330377878550E+01 -5.921809587670E+02 1.468900664007E+05, + 0.5200: 7.348188496604E+00 -5.910609709609E+02 2.306346882275E+04, + 0.5300: -6.632412055085E+00 -5.858249711728E+02 -8.599806443745E+04, + 0.5400: -9.327795277462E+00 -4.226850572349E+02 -1.072407227678E+05, + 0.5500: 1.528270886007E+00 1.015075030734E+02 -2.286795301617E+04, + 0.5600: 1.558798183001E+01 1.094643274931E+03 8.829025702914E+04, + 0.5700: 2.528922832929E+01 2.264029096230E+03 1.670225258883E+05, + 0.5800: 3.038086849167E+01 3.377483001879E+03 2.066935176690E+05, + 0.5900: 2.398085160104E+01 4.294267394410E+03 1.545514557669E+05, + 0.6000: 6.296420233017E+00 4.692445582025E+03 1.538945099348E+04, + 0.6100: -1.785830436284E+00 4.471216294280E+03 -5.509655507518E+04, + 0.6200: -6.489804441406E-01 4.090523914485E+03 -5.816873679660E+04, + 0.6300: -4.437093368087E+00 3.656912241239E+03 -9.184448148020E+04, + 0.6400: -1.107811102930E+00 3.114722637292E+03 -6.548965783044E+04, + 0.6500: 5.712057492396E+00 2.745613942020E+03 -1.070235768330E+04, + 0.6600: -2.480915196185E+00 2.473800543994E+03 -6.577815305818E+04, + 0.6700: -1.124712541113E+01 1.898624333967E+03 -1.217576713267E+05, + 0.6800: -3.809218364628E+00 1.333347441776E+03 -5.659141834720E+04, + 0.6900: 1.841602181248E+00 1.149904950293E+03 -5.909659347991E+03, + 0.7000: -5.051407313810E+00 1.030595921023E+03 -4.833269680122E+04 + } + }, + curve = { + m = 5, + kind = cos, + derivs = { + -0.7000: 7.140423142140E+00 -2.842281619794E+03 4.528226020741E+04, + -0.6900: 5.612584877090E+00 -2.643948753537E+03 3.242277303520E+04, + -0.6800: -2.207308349986E+00 -2.569086192363E+03 -2.266278518466E+04, + -0.6700: 7.036316989684E-01 -2.633745568573E+03 6.320317401268E+03, + -0.6600: 7.708779500676E+00 -2.472894859204E+03 6.375391999135E+04, + -0.6500: 1.939001995133E-02 -2.238274642066E+03 9.653936353728E+03, + -0.6400: -4.989040051426E+00 -2.277761198243E+03 -2.548707007284E+04, + -0.6300: 4.120336230609E+00 -2.218450340437E+03 4.287764496197E+04, + -0.6200: 7.973626759941E+00 -1.822037733826E+03 7.359554686056E+04, + -0.6100: 6.224462501422E+00 -1.436102243728E+03 6.481109640359E+04, + -0.6000: 1.192865570470E+01 -9.876774515808E+02 1.075504475475E+05, + -0.5900: 1.140412951597E+01 -2.998665824209E+02 9.884786008374E+04, + -0.5800: 1.803612017558E+00 3.686902528693E+02 2.112968210219E+04, + -0.5700: -3.267483734748E+00 8.985783694994E+02 -2.277378712135E+04, + -0.5600: -8.542440277652E-01 1.349531475155E+03 -1.016908437979E+04, + -0.5500: 4.770427260397E+00 1.674518663808E+03 3.014819333210E+04, + -0.5400: 1.673801378834E+01 1.841343048941E+03 1.212076849287E+05, + -0.5300: 2.721460098206E+01 1.971518723073E+03 2.022584134372E+05, + -0.5200: 2.712226787482E+01 2.053564146817E+03 2.025096720712E+05, + -0.5100: 1.155618517862E+01 2.035656498415E+03 8.512274483299E+04, + -0.5000: -1.453736050413E+01 1.805909647368E+03 -1.115428887869E+05, + -0.4900: -3.627697443188E+01 1.353023682676E+03 -2.758099771545E+05, + -0.4800: -4.193024105459E+01 7.978514797885E+02 -3.185303224522E+05, + -0.4700: -2.887319495463E+01 3.047176246234E+02 -2.193238630483E+05, + -0.4600: -2.330920590690E+00 2.950013041094E+01 -1.838133939147E+04, + -0.4500: 2.362255681935E+01 5.195109579881E+01 1.786299341285E+05, + -0.4400: 3.607238182057E+01 2.870911879204E+02 2.748481097070E+05, + -0.4300: 2.996687003387E+01 5.708880633456E+02 2.315854343770E+05, + -0.4200: 7.847146888195E+00 7.396356063404E+02 6.824014828333E+04, + -0.4100: -1.980593470900E+01 6.726073705258E+02 -1.364882374564E+05, + -0.4000: -3.782225718337E+01 4.008638356212E+02 -2.693596915185E+05, + -0.3900: -3.805540492207E+01 6.281639685242E+01 -2.684499235706E+05, + -0.3800: -2.064148220180E+01 -1.894202817245E+02 -1.349255627217E+05, + -0.3700: 5.656656721638E+00 -2.307125684083E+02 6.404664455479E+04, + -0.3600: 2.537599019383E+01 -4.548711544810E+01 2.120347256802E+05, + -0.3500: 2.889874927880E+01 2.252178154297E+02 2.359633124139E+05, + -0.3400: 1.830084311119E+01 4.471621363366E+02 1.502397444246E+05, + -0.3300: 3.389470460369E-01 5.324635142330E+02 7.340164083440E+03, + -0.3200: -1.402682759000E+01 4.566057907922E+02 -1.082632651635E+05, + -0.3100: -1.672004116725E+01 3.122770394845E+02 -1.337743168027E+05, + -0.3000: -1.004907852668E+01 2.026688128322E+02 -8.444174291167E+04, + -0.2900: -2.309568726271E+00 1.569395390899E+02 -2.247698973444E+04, + -0.2800: 1.628710095187E+00 1.500499957440E+02 1.252717498178E+04, + -0.2700: 4.058683378186E-01 1.632176080068E+02 8.186777127210E+03, + -0.2600: -2.932246831697E+00 1.506392377492E+02 -1.380724505328E+04, + -0.2500: -2.548599236603E+00 1.345994974478E+02 -1.026114292001E+04, + -0.2400: 1.271263079349E+00 1.555521584367E+02 1.844432917905E+04, + -0.2300: 4.044275451721E+00 2.035929850724E+02 4.022155071311E+04, + -0.2200: 4.046998017263E+00 2.440799340786E+02 4.156427619214E+04, + -0.2100: 2.367420680825E+00 2.686746447663E+02 3.011172253674E+04, + -0.2000: 6.569125188418E-01 2.743983523341E+02 1.811947453333E+04, + -0.1900: 1.507849491651E+00 2.936729992554E+02 2.482147860675E+04, + -0.1800: 3.020192491132E+00 3.647311702719E+02 3.740563239235E+04, + -0.1700: -4.013922049869E-01 4.588092184622E+02 1.566511271238E+04, + -0.1600: -1.020625060740E+01 4.944244301765E+02 -5.132766701636E+04, + -0.1500: -2.010911711098E+01 4.282819283394E+02 -1.181913237144E+05, + -0.1400: -2.318831268647E+01 2.835231396201E+02 -1.351494756426E+05, + -0.1300: -1.445336942930E+01 1.533114405581E+02 -6.697860616506E+04, + -0.1200: 3.423485906887E+00 1.467566977563E+02 6.529700983238E+04, + -0.1100: 1.935302464234E+01 2.968146023255E+02 1.787313306131E+05, + -0.1000: 2.267772232741E+01 5.159636809322E+02 1.941781694690E+05, + -0.0900: 1.241339093912E+01 6.884695449147E+02 1.053015481553E+05, + -0.0800: -6.135822917398E+00 7.317442821715E+02 -4.494894772114E+04, + -0.0700: -2.310667935909E+01 6.178054819645E+02 -1.788680707897E+05, + -0.0600: -2.722423062085E+01 4.118165758270E+02 -2.095693326729E+05, + -0.0500: -1.629626921987E+01 2.364678823307E+02 -1.207581959245E+05, + -0.0400: 1.986911251712E+00 1.807847973818E+02 2.728539173742E+04, + -0.0300: 1.802266786187E+01 2.546119774252E+02 1.571815297643E+05, + -0.0200: 2.299790986448E+01 4.047328802839E+02 1.981032701499E+05, + -0.0100: 1.468924549324E+01 5.344749372812E+02 1.310743218072E+05, + 0.0000: -1.319403445836E+00 5.887553232742E+02 1.415156362519E+02, + 0.0100: -1.729812362177E+01 5.420450173748E+02 -1.308809536236E+05, + 0.0200: -2.553157872261E+01 4.175585655467E+02 -1.981654741456E+05, + 0.0300: -2.047260884435E+01 2.686516148600E+02 -1.576215725307E+05, + 0.0400: -4.388572028932E+00 1.912183347605E+02 -2.815547769740E+04, + 0.0500: 1.386980393705E+01 2.386950387845E+02 1.194800980484E+05, + 0.0600: 2.467667293414E+01 4.022360871772E+02 2.079579705297E+05, + 0.0700: 2.033693552177E+01 5.942242633395E+02 1.770261231753E+05, + 0.0800: 3.061165376153E+00 6.935642922188E+02 4.302215080074E+04, + 0.0900: -1.583124563943E+01 6.370404820376E+02 -1.070773909702E+05, + 0.1000: -2.641804080616E+01 4.549933295738E+02 -1.954975855051E+05, + 0.1100: -2.334315667330E+01 2.320681284561E+02 -1.793377072520E+05, + 0.1200: -7.559067703564E+00 8.478676469357E+01 -6.508354660304E+04, + 0.1300: 1.028135878582E+01 9.988412210683E+01 6.793787211518E+04, + 0.1400: 1.905979516160E+01 2.422447574559E+02 1.365932621112E+05, + 0.1500: 1.605271004665E+01 3.997482951464E+02 1.197443030551E+05, + 0.1600: 6.207797627323E+00 4.766636318159E+02 5.269723141003E+04, + 0.1700: -3.569091162744E+00 4.491661790015E+02 -1.452498840240E+04, + 0.1800: -6.985824250894E+00 3.619479751768E+02 -3.630914637649E+04, + 0.1900: -5.471562028488E+00 2.989352870857E+02 -2.349002712181E+04, + 0.2000: -4.596460608042E+00 2.910775284090E+02 -1.633834900234E+04, + 0.2100: -6.238633433398E+00 3.010108869078E+02 -2.784421626061E+04, + 0.2200: -7.789543692321E+00 2.954631414397E+02 -3.897686694288E+04, + 0.2300: -7.584862238183E+00 2.752427577735E+02 -3.762293579558E+04, + 0.2400: -4.526506575278E+00 2.458337065071E+02 -1.619596544839E+04, + 0.2500: -3.342384764381E-01 2.388565009124E+02 1.182335212795E+04, + 0.2600: 5.012662459615E-01 2.616471631553E+02 1.443798706918E+04, + 0.2700: -2.328081928258E+00 2.722877728431E+02 -8.587376785296E+03, + 0.2800: -3.022592141450E+00 2.484944546258E+02 -1.388588140130E+04, + 0.2900: 1.415276907465E+00 2.375954365500E+02 2.036737328018E+04, + 0.3000: 9.573405683783E+00 2.608989585124E+02 8.181285318179E+04, + 0.3100: 1.653676294598E+01 3.456282091974E+02 1.307812216343E+05, + 0.3200: 1.398414923119E+01 4.635157957611E+02 1.049880976044E+05, + 0.3300: -3.915239775887E-01 5.116601009817E+02 -1.077196324005E+04, + 0.3400: -1.848748557756E+01 3.984771167942E+02 -1.535233432754E+05, + 0.3500: -2.930340331402E+01 1.511511108321E+02 -2.385923987723E+05, + 0.3600: -2.604357689821E+01 -1.384497123066E+02 -2.134460262789E+05, + 0.3700: -6.602497402580E+00 -3.321185199475E+02 -6.383009169402E+04, + 0.3800: 1.942181446738E+01 -2.866443811396E+02 1.368786093281E+05, + 0.3900: 3.657439673653E+01 -1.811479175677E+01 2.718895818143E+05, + 0.4000: 3.608684083482E+01 3.452362555769E+02 2.737095747712E+05, + 0.4100: 1.781047925990E+01 6.462230741552E+02 1.409779233674E+05, + 0.4200: -1.011771575211E+01 7.406708624788E+02 -6.439552889297E+04, + 0.4300: -3.252899318872E+01 5.925009533663E+02 -2.290368491338E+05, + 0.4400: -3.893223880099E+01 3.189182357338E+02 -2.739868894732E+05, + 0.4500: -2.676146033765E+01 8.220142421769E+01 -1.794613460779E+05, + 0.4600: -1.037322507970E+00 4.787151074229E+01 1.627756225288E+04, + 0.4700: 2.534624327433E+01 3.051886711600E+02 2.166648823686E+05, + 0.4800: 3.832166073428E+01 7.800635191431E+02 3.161088688629E+05, + 0.4900: 3.266424386093E+01 1.322089553646E+03 2.742991707626E+05, + 0.5000: 1.099671457725E+01 1.770916403395E+03 1.113562311194E+05, + 0.5100: -1.495427387594E+01 2.007066162156E+03 -8.390870941569E+04, + 0.5200: -3.032206762133E+01 2.040353871494E+03 -2.001491521089E+05, + 0.5300: -3.019310223772E+01 1.978929815632E+03 -1.992892431479E+05, + 0.5400: -1.952982490181E+01 1.869252302867E+03 -1.183989739340E+05, + 0.5500: -7.478277280195E+00 1.716581870189E+03 -2.835974240633E+04, + 0.5600: -1.922467617703E+00 1.393961527594E+03 1.025833808636E+04, + 0.5700: 2.508020916739E-01 9.307985962537E+02 2.092736293806E+04, + 0.5800: -5.222533691714E+00 3.750523057358E+02 -2.460442084292E+04, + 0.5900: -1.536046212620E+01 -3.283495664884E+02 -1.031871446787E+05, + 0.6000: -1.652077185357E+01 -1.052695418220E+03 -1.117797550073E+05, + 0.6100: -1.150604820894E+01 -1.531447270944E+03 -6.804845166154E+04, + 0.6200: -1.393657853135E+01 -1.935127517184E+03 -7.526564596765E+04, + 0.6300: -1.067074249321E+01 -2.333289222576E+03 -4.277456415238E+04, + 0.6400: -1.955668769638E+00 -2.378238310562E+03 2.726563021253E+04, + 0.6500: -7.078512799946E+00 -2.310775823736E+03 -6.482730501615E+03, + 0.6600: -1.456029938424E+01 -2.508002953390E+03 -5.959406789308E+04, + 0.6700: -7.046733131867E+00 -2.627298607081E+03 -1.704585106559E+03, + 0.6800: -3.401264298255E+00 -2.522609333322E+03 2.709480596480E+04, + 0.6900: -1.036301582815E+01 -2.564443141563E+03 -2.882642307428E+04, + 0.7000: -1.101830027812E+01 -2.741452172956E+03 -4.307762990056E+04 + } + }, + curve = { + m = 7, + kind = sin, + derivs = { + -0.7000: -1.528822810640E+03 -4.635846559181E+04 -1.189844405645E+07, + -0.6900: -1.028386221876E+03 -9.620571623303E+04 -4.265399099303E+06, + -0.6800: 7.312162947793E+02 -9.792196015379E+04 1.473183192807E+07, + -0.6700: 7.975929748725E+02 -3.702014130732E+04 1.487457542487E+07, + -0.6600: -4.852126137197E+02 -1.210194803512E+04 -6.967236435094E+05, + -0.6500: -1.054354423722E+03 -5.828624379067E+04 -1.038160232881E+07, + -0.6400: -1.653127409933E+03 -1.204741950546E+05 -1.838959122796E+07, + -0.6300: -1.782366873977E+03 -1.905024331934E+05 -1.830736893491E+07, + -0.6200: 2.285137262521E+02 -2.382425191403E+05 4.239148934942E+06, + -0.6100: 2.120421792940E+03 -2.069391181621E+05 2.399299724412E+07, + -0.6000: 1.404126460576E+03 -1.419285599804E+05 1.510991039884E+07, + -0.5900: 1.436414316880E+02 -1.132781901536E+05 -2.269214056407E+06, + -0.5800: -4.858092208651E+02 -9.523144054498E+04 -1.448601967436E+07, + -0.5700: -1.438908411899E+03 -7.982619574842E+04 -2.739518203796E+07, + -0.5600: -1.946532803254E+03 -8.550117304051E+04 -3.161370983604E+07, + -0.5500: -8.217017749740E+02 -8.613072014856E+04 -1.578996589931E+07, + -0.5400: 9.500426664369E+02 -5.668215215563E+04 8.651537597763E+06, + -0.5300: 2.891491009930E+03 -1.783797106692E+04 3.412236283089E+07, + -0.5200: 4.564294473441E+03 2.297019813251E+04 5.432655319197E+07, + -0.5100: 5.385339037204E+03 6.360164415782E+04 6.293660591741E+07, + -0.5000: 4.346010507589E+03 9.684486854288E+04 5.054113441142E+07, + -0.4900: 1.342194642170E+03 1.117167431331E+05 1.720326796858E+07, + -0.4800: -2.714305001543E+03 9.959577789959E+04 -2.664439859174E+07, + -0.4700: -6.230721368000E+03 5.798176119950E+04 -6.409892834527E+07, + -0.4600: -7.484638525285E+03 -1.864313618216E+03 -7.750966602588E+07, + -0.4500: -5.404797109421E+03 -5.965496418160E+04 -5.642316214713E+07, + -0.4400: -7.754207453786E+02 -8.900760290662E+04 -9.209044170348E+06, + -0.4300: 4.238063501595E+03 -7.733287079737E+04 4.196663263855E+07, + -0.4200: 7.369235053586E+03 -3.119889455160E+04 7.383047334076E+07, + -0.4100: 7.165630499935E+03 2.500652141993E+04 7.141641909621E+07, + -0.4000: 4.219099880298E+03 6.795869758494E+04 4.014236761573E+07, + -0.3900: 1.342521631206E+02 8.297269725101E+04 -3.697677099539E+06, + -0.3800: -3.377269446376E+03 6.767895390875E+04 -4.223912122294E+07, + -0.3700: -5.134661394220E+03 2.926351727647E+04 -6.243438677656E+07, + -0.3600: -4.794525634566E+03 -2.216446897339E+04 -5.975564910500E+07, + -0.3500: -3.215436749999E+03 -7.422464514914E+04 -4.196320415678E+07, + -0.3400: -1.116748679738E+03 -1.147598882808E+05 -1.638255216957E+07, + -0.3300: 9.505399188828E+02 -1.340628179312E+05 1.056493174249E+07, + -0.3200: 2.713998823586E+03 -1.247840992109E+05 3.437821677191E+07, + -0.3100: 4.108602647728E+03 -8.164399242363E+04 5.261841328412E+07, + -0.3000: 4.646708810253E+03 -1.426732479358E+04 5.940469061088E+07, + -0.2900: 3.739910694888E+03 5.425677414434E+04 4.874021853533E+07, + -0.2800: 1.541642716634E+03 9.865561909163E+04 2.259525605712E+07, + -0.2700: -9.628153363509E+02 1.064144609085E+05 -8.194083102829E+06, + -0.2600: -2.927056981006E+03 8.053126996496E+04 -3.384111963868E+07, + -0.2500: -3.578485154278E+03 3.814743051227E+04 -4.545355424193E+07, + -0.2400: -3.070750715309E+03 -3.436123430567E+03 -4.337109058253E+07, + -0.2300: -2.277006179296E+03 -3.828803173083E+04 -3.547133974145E+07, + -0.2200: -1.676149115044E+03 -6.762195305520E+04 -2.668459653988E+07, + -0.2100: -1.185442901535E+03 -8.986312264436E+04 -1.686022302072E+07, + -0.2000: -5.117091964521E+02 -1.027608953743E+05 -4.161814582119E+06, + -0.1900: 9.319257959083E+02 -9.844158946913E+04 1.561725880072E+07, + -0.1800: 3.023590910066E+03 -6.877317788086E+04 4.001785807961E+07, + -0.1700: 4.702715620996E+03 -1.826620842646E+04 5.790131597868E+07, + -0.1600: 4.983775753824E+03 3.711867395749E+04 5.910470730236E+07, + -0.1500: 3.543910931298E+03 8.396646096265E+04 4.068642429029E+07, + -0.1400: 7.728238665909E+02 1.069328162963E+05 7.444980659489E+06, + -0.1300: -1.925837356361E+03 1.020827198751E+05 -2.588336068270E+07, + -0.1200: -3.559776656151E+03 7.596277954008E+04 -4.802165502432E+07, + -0.1100: -3.910259023445E+03 3.330839567479E+04 -5.524463943344E+07, + -0.1000: -3.326903426851E+03 -2.239247843946E+04 -4.997189832493E+07, + -0.0900: -1.948918741243E+03 -7.933488177318E+04 -3.355650960822E+07, + -0.0800: -6.747560643974E+01 -1.223427391490E+05 -9.429592813082E+06, + -0.0700: 2.189331547753E+03 -1.362722502847E+05 1.939598273999E+07, + -0.0600: 4.323509358458E+03 -1.049050373506E+05 4.607828254154E+07, + -0.0500: 5.374641302114E+03 -3.497292229867E+04 5.978207255299E+07, + -0.0400: 4.722116862127E+03 4.755036735245E+04 5.353959274480E+07, + -0.0300: 2.210078480076E+03 1.109758028729E+05 2.619064854163E+07, + -0.0200: -1.574722503106E+03 1.256662516954E+05 -1.485544858609E+07, + -0.0100: -5.043697105185E+03 8.082909345383E+04 -5.221767259367E+07, + 0.0000: -6.382300179365E+03 -1.208938559238E+03 -6.667824698045E+07, + 0.0100: -5.039505556463E+03 -8.291685050138E+04 -5.211860496344E+07, + 0.0200: -1.565989597041E+03 -1.269483887274E+05 -1.469406333177E+07, + 0.0300: 2.224628170355E+03 -1.113561572312E+05 2.636323377987E+07, + 0.0400: 4.743766595328E+03 -4.726670998657E+04 5.367688667400E+07, + 0.0500: 5.403037362402E+03 3.544817774634E+04 5.985425698470E+07, + 0.0600: 4.356156586775E+03 1.050213943551E+05 4.608340817007E+07, + 0.0700: 2.221708280239E+03 1.356472295988E+05 1.935933050837E+07, + 0.0800: -4.169461930349E+01 1.209274790885E+05 -9.470736706634E+06, + 0.0900: -1.936971192005E+03 7.740416397837E+04 -3.356976201345E+07, + 0.1000: -3.335837679258E+03 2.043528617558E+04 -4.994273975795E+07, + 0.1100: -3.946326037614E+03 -3.475821925344E+04 -5.518430787201E+07, + 0.1200: -3.627960160058E+03 -7.653840958107E+04 -4.796480970434E+07, + 0.1300: -2.028829076456E+03 -1.017486143246E+05 -2.587247932878E+07, + 0.1400: 6.364003731058E+02 -1.059631460075E+05 7.383848189358E+06, + 0.1500: 3.380549908019E+03 -8.270920991353E+04 4.055787671847E+07, + 0.1600: 4.803808751128E+03 -3.577132248860E+04 5.893453365821E+07, + 0.1700: 4.517605238613E+03 1.965943263551E+04 5.771745045439E+07, + 0.1800: 2.843419675982E+03 7.018636189628E+04 3.984018039825E+07, + 0.1900: 7.634664672228E+02 9.976478376984E+04 1.545639462343E+07, + 0.2000: -6.658778054811E+02 1.037809664332E+05 -4.300793373489E+06, + 0.2100: -1.326324539053E+03 9.034301819492E+04 -1.697191343031E+07, + 0.2200: -1.807120014420E+03 6.743433583669E+04 -2.676332902513E+07, + 0.2300: -2.402758224446E+03 3.746004346373E+04 -3.551761725066E+07, + 0.2400: -3.196026640062E+03 2.059320938188E+03 -4.339292219702E+07, + 0.2500: -3.706842355224E+03 -4.000629588263E+04 -4.546011003971E+07, + 0.2600: -3.060817917299E+03 -8.284423108089E+04 -3.384088326213E+07, + 0.2700: -1.103415717915E+03 -1.092116085528E+05 -8.196284867469E+06, + 0.2800: 1.394793843949E+03 -1.019825074380E+05 2.258895623497E+07, + 0.2900: 3.590286393659E+03 -5.797683707805E+04 4.874003784546E+07, + 0.3000: 4.499026599469E+03 1.056956795623E+04 5.941900867571E+07, + 0.3100: 3.966964648423E+03 7.849004062195E+04 5.264532147104E+07, + 0.3200: 2.581111079145E+03 1.226115544816E+05 3.441121689952E+07, + 0.3300: 8.262883095320E+02 1.330885233762E+05 1.059201426444E+07, + 0.3400: -1.235466220563E+03 1.148201042250E+05 -1.637394326703E+07, + 0.3500: -3.332598712783E+03 7.488025562300E+04 -4.196910829600E+07, + 0.3600: -4.915051764724E+03 2.304854927773E+04 -5.976516517411E+07, + 0.3700: -5.266206644243E+03 -2.835915208019E+04 -6.245440228796E+07, + 0.3800: -3.528904769486E+03 -6.690417084214E+04 -4.228540850203E+07, + 0.3900: -4.578667173462E+01 -8.234760116617E+04 -3.778175492878E+06, + 0.4000: 4.003308629541E+03 -6.737474646296E+04 4.001936111491E+07, + 0.4100: 6.909391227974E+03 -2.441678825019E+04 7.124472752911E+07, + 0.4200: 7.073373684981E+03 3.175672401783E+04 7.362600013843E+07, + 0.4300: 3.908465796390E+03 7.786974445126E+04 4.176366446766E+07, + 0.4400: -1.130617052329E+03 8.956884095797E+04 -9.381654194489E+06, + 0.4500: -5.776135361101E+03 6.024479566274E+04 -5.654732432811E+07, + 0.4600: -7.861243516498E+03 2.538556043380E+03 -7.757308127262E+07, + 0.4700: -6.602290180345E+03 -5.704282303186E+04 -6.411187221687E+07, + 0.4800: -3.073008006125E+03 -9.829560865258E+04 -2.665348425875E+07, + 0.4900: 1.003089531099E+03 -1.102565009065E+05 1.714259502255E+07, + 0.5000: 4.033274332456E+03 -9.561344404339E+04 5.039909422972E+07, + 0.5100: 5.103819657945E+03 -6.295645474579E+04 6.271331195221E+07, + 0.5200: 4.315202299558E+03 -2.308058413231E+04 5.404736797149E+07, + 0.5300: 2.671991795080E+03 1.716515072936E+04 3.382934686836E+07, + 0.5400: 7.526630900016E+02 5.599987435629E+04 8.377010291451E+06, + 0.5500: -1.008032745818E+03 8.601939101617E+04 -1.604589781191E+07, + 0.5600: -2.132587779255E+03 8.620933761309E+04 -3.187881256637E+07, + 0.5700: -1.631011313167E+03 8.117201605770E+04 -2.770367464389E+07, + 0.5800: -6.838570481809E+02 9.675713190813E+04 -1.485736636351E+07, + 0.5900: -5.472773570199E+01 1.145476437436E+05 -2.700472505843E+06, + 0.6000: 1.213544474321E+03 1.427607930249E+05 1.463615960209E+07, + 0.6100: 1.945660438577E+03 2.074037143944E+05 2.350061497772E+07, + 0.6200: 7.696332385473E+01 2.385236594489E+05 3.757037446953E+06, + 0.6300: -1.904366454109E+03 1.907903170584E+05 -1.875452664106E+07, + 0.6400: -1.741765167906E+03 1.208314068266E+05 -1.879711961351E+07, + 0.6500: -1.109316039839E+03 5.852860478745E+04 -1.076337887484E+07, + 0.6600: -5.099488589561E+02 1.188736817760E+04 -1.067954237315E+06, + 0.6700: 7.952155748114E+02 3.607725395422E+04 1.450764034252E+07, + 0.6800: 7.394065719124E+02 9.621040900141E+04 1.437593242934E+07, + 0.6900: -1.022600474854E+03 9.399851059268E+04 -4.586087674336E+06, + 0.7000: -1.536393978176E+03 4.426043370267E+04 -1.214562068397E+07 + } + }, + curve = { + m = 7, + kind = cos, + derivs = { + -0.7000: -3.498425172536E+02 7.212032172994E+04 -4.278816737792E+04, + -0.6900: 1.249624227462E+03 1.140274780286E+05 1.509374255180E+07, + -0.6800: 1.091285591833E+03 1.640918333630E+05 1.121364274079E+07, + -0.6700: -8.153130531031E+02 1.490346873177E+05 -1.058596886221E+07, + -0.6600: -1.335715334906E+03 1.000147380547E+05 -1.797904571866E+07, + -0.6500: -7.603028828546E+02 6.012736450917E+04 -1.153336984168E+07, + -0.6400: -2.485200705457E+02 1.654013020153E+04 -2.915554879572E+06, + -0.6300: 1.282894571362E+03 1.894774523904E+04 1.543107590236E+07, + -0.6200: 2.155183339332E+03 9.673770974564E+04 2.499522870458E+07, + -0.6100: 1.978903922664E+02 1.458518146245E+05 4.422166143265E+06, + -0.6000: -1.962325124170E+03 1.069383003087E+05 -1.943933947592E+07, + -0.5900: -2.024820839001E+03 3.198804256997E+04 -2.139484227339E+07, + -0.5800: -1.302305176107E+03 -5.444949489996E+04 -1.233293360276E+07, + -0.5700: -1.987482621679E+02 -1.421557779784E+05 3.487190445265E+06, + -0.5600: 1.783244869728E+03 -1.863488901030E+05 2.890959030174E+07, + -0.5500: 3.341376654324E+03 -1.623571008449E+05 4.883435013978E+07, + -0.5400: 3.454543334528E+03 -1.025979700108E+05 5.117485670699E+07, + -0.5300: 2.348618412632E+03 -3.092813440180E+04 3.786298212845E+07, + -0.5200: 5.807274294039E+02 3.093611769099E+04 1.506115760281E+07, + -0.5100: -1.610321959588E+03 6.753148347293E+04 -1.315421769494E+07, + -0.5000: -3.863402497430E+03 5.983960480624E+04 -4.116058755556E+07, + -0.4900: -5.195792080149E+03 8.284262529865E+03 -5.785902162282E+07, + -0.4800: -4.920347652700E+03 -6.478487985973E+04 -5.555950390329E+07, + -0.4700: -2.762035680118E+03 -1.278470891878E+05 -3.176073736352E+07, + -0.4600: 8.584896990414E+02 -1.488737866218E+05 7.826707641295E+06, + -0.4500: 4.513953731431E+03 -1.098373788221E+05 4.741359497491E+07, + -0.4400: 6.271137730424E+03 -2.699243999050E+04 6.657346138047E+07, + -0.4300: 5.350888492033E+03 6.212673957577E+04 5.677587762210E+07, + -0.4200: 2.113930783939E+03 1.176259876921E+05 2.203898703515E+07, + -0.4100: -1.782100629173E+03 1.125190685816E+05 -2.002773432656E+07, + -0.4000: -4.572716652827E+03 5.336805244964E+04 -5.048783773629E+07, + -0.3900: -5.510101280732E+03 -2.949256883918E+04 -6.024259703476E+07, + -0.3800: -4.658328928676E+03 -1.023458011771E+05 -4.923545799680E+07, + -0.3700: -2.609744433131E+03 -1.375713796000E+05 -2.394483449753E+07, + -0.3600: -2.855740099348E+02 -1.262376842675E+05 5.262289114248E+06, + -0.3500: 1.663817690956E+03 -8.460040599345E+04 3.016319308580E+07, + -0.3400: 3.145950356183E+03 -2.950896885575E+04 4.793477578296E+07, + -0.3300: 3.880609216211E+03 2.523199872399E+04 5.506215725637E+07, + -0.3200: 3.728900687526E+03 6.818340614854E+04 5.014646238892E+07, + -0.3100: 2.330178009969E+03 9.692311528963E+04 3.055343098085E+07, + -0.3000: -2.372657117523E+02 1.064551007153E+05 -1.370510196678E+06, + -0.2900: -3.132028893302E+03 8.844722024243E+04 -3.577950278548E+07, + -0.2800: -4.899687946708E+03 4.298427269634E+04 -5.741510828487E+07, + -0.2700: -4.936782584870E+03 -1.441137960443E+04 -5.943142652678E+07, + -0.2600: -3.481132234642E+03 -6.882049535129E+04 -4.378948069405E+07, + -0.2500: -1.393368743510E+03 -1.024875882050E+05 -1.939348491104E+07, + -0.2400: 1.648361910887E+02 -1.081559926622E+05 1.707643243245E+06, + -0.2300: 8.817448778321E+02 -9.401841260375E+04 1.525268964703E+07, + -0.2200: 1.329358183881E+03 -7.105222338147E+04 2.523305233096E+07, + -0.2100: 1.871729810937E+03 -4.248727032949E+04 3.402865629126E+07, + -0.2000: 2.638445063481E+03 -9.177311587657E+03 4.217457376277E+07, + -0.1900: 3.287267347676E+03 3.133088356811E+04 4.597970427596E+07, + -0.1800: 2.902829626985E+03 7.602201895300E+04 3.708749312907E+07, + -0.1700: 1.141301526236E+03 1.083873126893E+05 1.329435905842E+07, + -0.1600: -1.325118181389E+03 1.081673470122E+05 -1.746960969723E+07, + -0.1500: -3.649543900866E+03 6.867841501916E+04 -4.540468398106E+07, + -0.1400: -4.812515283854E+03 1.171343950071E+02 -5.925546562943E+07, + -0.1300: -4.459852702942E+03 -7.234716308217E+04 -5.496729044162E+07, + -0.1200: -3.151719875462E+03 -1.225120474089E+05 -3.808834013321E+07, + -0.1100: -1.415427371382E+03 -1.376124745696E+05 -1.475276605300E+07, + -0.1000: 5.973423736646E+02 -1.220065833665E+05 1.185346903704E+07, + -0.0900: 2.705074483240E+03 -8.407739371291E+04 3.801869881227E+07, + -0.0800: 4.388233543801E+03 -3.312674579314E+04 5.742393894718E+07, + -0.0700: 4.998901452251E+03 1.884335973844E+04 6.326253846617E+07, + -0.0600: 3.597216580548E+03 6.016058402498E+04 4.684390141407E+07, + -0.0500: 3.257402839893E+02 8.014118891400E+04 1.064998626141E+07, + -0.0400: -3.770788572235E+03 7.064650077404E+04 -3.357642249317E+07, + -0.0300: -7.029553561837E+03 3.100649370659E+04 -6.834217290621E+07, + -0.0200: -7.768838147394E+03 -2.589089124480E+04 -7.648119920171E+07, + -0.0100: -5.128075923458E+03 -7.775953594124E+04 -4.979813338979E+07, + 0.0000: -2.463629833059E+02 -9.800172850238E+04 -1.810077911490E+05, + 0.0100: 4.639975177107E+03 -7.674945112297E+04 4.942435501276E+07, + 0.0200: 7.295052837399E+03 -2.417128394882E+04 7.608507171845E+07, + 0.0300: 6.580037480100E+03 3.304394795967E+04 6.793834398090E+07, + 0.0400: 3.354145361943E+03 7.269596235826E+04 3.319673683915E+07, + 0.0500: -7.037664274985E+02 8.204305207050E+04 -1.096894767211E+07, + 0.0600: -3.934472387526E+03 6.193543446938E+04 -4.707153025409E+07, + 0.0700: -5.297224093419E+03 2.069482142423E+04 -6.338726504070E+07, + 0.0800: -4.653474947225E+03 -3.091631976360E+04 -5.746258939166E+07, + 0.0900: -2.946111734611E+03 -8.133647992243E+04 -3.800994192144E+07, + 0.1000: -8.238444024821E+02 -1.188123140078E+05 -1.183562433919E+07, + 0.1100: 1.195297390307E+03 -1.342511312621E+05 1.476113482820E+07, + 0.1200: 2.932066843769E+03 -1.193334823893E+05 3.808835428767E+07, + 0.1300: 4.236554508263E+03 -6.969870723961E+04 5.496663893954E+07, + 0.1400: 4.582780637006E+03 1.870437937490E+03 5.925858908064E+07, + 0.1500: 3.411639153054E+03 6.920271833111E+04 4.541172827728E+07, + 0.1600: 1.077815090799E+03 1.073171111827E+05 1.748027672332E+07, + 0.1700: -1.399185620156E+03 1.063242420822E+05 -1.327800710186E+07, + 0.1800: -3.171912620692E+03 7.318345710547E+04 -3.706053594114E+07, + 0.1900: -3.566247862251E+03 2.832179799759E+04 -4.593542789274E+07, + 0.2000: -2.923525164680E+03 -1.170760476552E+04 -4.211335843441E+07, + 0.2100: -2.157145908382E+03 -4.404585081189E+04 -3.396928275331E+07, + 0.2200: -1.607919724375E+03 -7.151208370397E+04 -2.520818073062E+07, + 0.2300: -1.145853959044E+03 -9.366477462378E+04 -1.529139734647E+07, + 0.2400: -4.082438186639E+02 -1.075507418782E+05 -1.818843563342E+06, + 0.2500: 1.174906322502E+03 -1.021854625985E+05 1.923519761923E+07, + 0.2600: 3.289908625376E+03 -6.900059180482E+04 4.363917498177E+07, + 0.2700: 4.771794764403E+03 -1.475155549526E+04 5.933415330808E+07, + 0.2800: 4.756407823477E+03 4.296789041822E+04 5.737267324714E+07, + 0.2900: 3.006023268442E+03 8.901094487990E+04 3.576680873272E+07, + 0.3000: 1.270752664729E+02 1.075947528036E+05 1.364996085798E+06, + 0.3100: -2.424033434647E+03 9.846046026145E+04 -3.056302276629E+07, + 0.3200: -3.804738553012E+03 6.987850768326E+04 -5.014706166361E+07, + 0.3300: -3.936556254417E+03 2.712667123191E+04 -5.501636253868E+07, + 0.3400: -3.184171439558E+03 -2.695578109994E+04 -4.782595056003E+07, + 0.3500: -1.692425568620E+03 -8.097788727910E+04 -3.002511721382E+07, + 0.3600: 2.563577142860E+02 -1.216473224339E+05 -5.151740698190E+06, + 0.3700: 2.571259321473E+03 -1.326413331384E+05 2.398261921863E+07, + 0.3800: 4.605319389804E+03 -9.802482500456E+04 4.918905154191E+07, + 0.3900: 5.442725148046E+03 -2.666689856153E+04 6.014933099747E+07, + 0.4000: 4.495528531357E+03 5.429935290116E+04 5.040699820011E+07, + 0.4100: 1.700415154958E+03 1.116400748257E+05 1.999194909717E+07, + 0.4200: -2.194587869347E+03 1.152221232259E+05 -2.202569001092E+07, + 0.4300: -5.423710199431E+03 5.866231918745E+04 -5.671272257736E+07, + 0.4400: -6.329978494044E+03 -3.078553388382E+04 -6.646544095750E+07, + 0.4500: -4.555600014058E+03 -1.130946713886E+05 -4.727980214757E+07, + 0.4600: -8.825971066711E+02 -1.507939623150E+05 -7.692565468016E+06, + 0.4700: 2.753187322874E+03 -1.278598791425E+05 3.186333281949E+07, + 0.4800: 4.922669225973E+03 -6.277402379772E+04 5.559469534553E+07, + 0.4900: 5.206014748788E+03 1.190832037154E+04 5.781170887625E+07, + 0.5000: 3.880979094687E+03 6.434072645442E+04 4.105275207149E+07, + 0.5100: 1.637895503912E+03 7.211184739952E+04 1.303740368006E+07, + 0.5200: -5.369729991654E+02 3.496616820714E+04 -1.512164061688E+07, + 0.5300: -2.280047526439E+03 -2.775951286164E+04 -3.781550436276E+07, + 0.5400: -3.352334021385E+03 -1.003458222012E+05 -5.100708372774E+07, + 0.5500: -3.197467864087E+03 -1.609344826540E+05 -4.856358272140E+07, + 0.5600: -1.591542706900E+03 -1.854697036757E+05 -2.855887965534E+07, + 0.5700: 4.392924668170E+02 -1.413338484324E+05 -3.085034121305E+06, + 0.5800: 1.586474338353E+03 -5.323460893072E+04 1.274925520971E+07, + 0.5900: 2.343754636473E+03 3.378870711583E+04 2.179253069619E+07, + 0.6000: 2.306979914165E+03 1.092327212649E+05 1.979993381140E+07, + 0.6100: 1.652805679911E+02 1.483602764798E+05 -4.104173484099E+06, + 0.6200: -1.778532705003E+03 9.915440074073E+04 -2.471361911992E+07, + 0.6300: -8.968255629786E+02 2.111315203909E+04 -1.516986498220E+07, + 0.6400: 6.389883862126E+02 1.853277636782E+04 3.171451534239E+06, + 0.6500: 1.147566646826E+03 6.215281843399E+04 1.178125495406E+07, + 0.6600: 1.710355760859E+03 1.020890949395E+05 1.819833673650E+07, + 0.6700: 1.170241467207E+03 1.508359911101E+05 1.076861004199E+07, + 0.6800: -7.580492871554E+02 1.652371557777E+05 -1.104425507372E+07, + 0.6900: -9.373854237893E+02 1.143427849953E+05 -1.490887321481E+07, + 0.7000: 6.414499545992E+02 7.156760936580E+04 2.513226445529E+05 + } + }, + curve = { + m = 9, + kind = sin, + derivs = { + -0.7000: -1.737338082807E+04 -1.017615426949E+07 -4.621940024994E+08, + -0.6900: 8.719984869792E+04 -2.251548800540E+06 1.781933481361E+09, + -0.6800: -2.656358259850E+03 6.635512012876E+06 6.694708557515E+08, + -0.6700: -1.374872681826E+05 2.366983199430E+06 -1.565815321086E+09, + -0.6600: 1.437006694859E+04 -1.120715933838E+06 2.737384554110E+08, + -0.6500: 1.678293087217E+05 7.943049231884E+06 1.988999410766E+09, + -0.6400: 5.611106278463E+04 1.226890615686E+07 -4.941791265368E+08, + -0.6300: 2.806041576495E+04 7.695389089187E+06 -1.615187208274E+09, + -0.6200: 1.257304347505E+05 5.424627094542E+06 -9.609667327460E+07, + -0.6100: 3.593089183406E+04 2.056646266267E+06 -4.281628609874E+08, + -0.6000: -1.672008032332E+04 -3.117772192154E+06 2.700939437199E+08, + -0.5900: 4.440434572306E+04 1.170136384078E+06 2.666442640637E+09, + -0.5800: -6.018546642866E+04 8.780713840322E+06 2.054721017695E+09, + -0.5700: -2.590616489743E+05 1.131989065371E+07 -9.518966072507E+08, + -0.5600: -3.911396386640E+05 1.099279466090E+07 -3.836682278711E+09, + -0.5500: -4.615166320124E+05 7.760754919928E+06 -6.200229515553E+09, + -0.5400: -4.039387704306E+05 -1.260041590774E+06 -6.556100838859E+09, + -0.5300: -1.337920154829E+05 -9.064592479901E+06 -3.164103665158E+09, + -0.5200: 2.559665545224E+05 -1.127956355856E+07 2.567162380363E+09, + -0.5100: 6.021648882671E+05 -7.233581892364E+06 7.813959423992E+09, + -0.5000: 7.001582109842E+05 5.484292959510E+05 9.106976890495E+09, + -0.4900: 4.862639695883E+05 7.282060070461E+06 5.368967008607E+09, + -0.4800: 9.984840294382E+04 8.870806788312E+06 -1.150663475599E+09, + -0.4700: -2.703264039102E+05 4.607912478645E+06 -7.188341688858E+09, + -0.4600: -4.428701294571E+05 -3.418674941048E+06 -9.621227468373E+09, + -0.4500: -3.373963696931E+05 -1.076226573811E+07 -7.064485808861E+09, + -0.4400: -4.922905106789E+04 -1.431056551295E+07 -1.147704119987E+09, + -0.4300: 2.671844898099E+05 -1.251919208236E+07 5.287431160363E+09, + -0.4200: 4.495664318293E+05 -6.176312008264E+06 9.249877100827E+09, + -0.4100: 3.740227410035E+05 2.252214219280E+06 8.536450663311E+09, + -0.4000: 5.154128326672E+04 8.379121221236E+06 3.395230021998E+09, + -0.3900: -3.499033641773E+05 9.101881566823E+06 -3.314647948715E+09, + -0.3800: -6.429684359903E+05 4.238982795127E+06 -8.316684628032E+09, + -0.3700: -6.538817457295E+05 -3.051741966318E+06 -8.728097058978E+09, + -0.3600: -3.742499547010E+05 -7.437542772610E+06 -4.407709622783E+09, + -0.3500: 1.273145635191E+04 -5.593445835049E+06 1.599041040423E+09, + -0.3400: 3.169929518141E+05 1.800644962163E+06 6.057531967507E+09, + -0.3300: 4.288259024501E+05 1.112707780732E+07 7.050712987122E+09, + -0.3200: 3.143045345116E+05 1.737491511772E+07 4.156000817899E+09, + -0.3100: 1.111932647484E+05 1.630830876345E+07 -2.234466487224E+08, + -0.3000: -1.049640439879E+03 8.634337588014E+06 -3.024533705309E+09, + -0.2900: 2.847268612961E+04 -1.092417045758E+06 -3.173101262355E+09, + -0.2800: 1.197124980618E+05 -8.123180258575E+06 -1.725619695965E+09, + -0.2700: 1.808070294170E+05 -1.058604945091E+07 -1.271854076063E+08, + -0.2600: 1.238214656892E+05 -9.539437044782E+06 1.067370139340E+08, + -0.2500: -2.112017773084E+04 -8.015387896074E+06 -7.481035203442E+08, + -0.2400: -1.340501860105E+05 -7.583820886380E+06 -1.127081937540E+09, + -0.2300: -1.635948801352E+05 -7.060020986981E+06 -4.462402443088E+08, + -0.2200: -1.605421033585E+05 -4.920128025085E+06 4.606170813996E+08, + -0.2100: -1.562066387503E+05 -1.424990580116E+06 1.033101549811E+09, + -0.2000: -1.660527337408E+05 2.678426892222E+06 9.735228455597E+08, + -0.1900: -1.754813144816E+05 5.792098495943E+06 5.666595752485E+08, + -0.1800: -1.091433600329E+05 6.961279271663E+06 9.521330273999E+08, + -0.1700: 3.856255974002E+04 7.429732992314E+06 2.213850376197E+09, + -0.1600: 1.424984670651E+05 8.538625926308E+06 2.613121555228E+09, + -0.1500: 1.113447124685E+05 8.719860502668E+06 9.622193373174E+08, + -0.1400: -3.461474142463E+04 6.824007377711E+06 -2.246402505210E+09, + -0.1300: -2.164553894238E+05 1.804677937753E+06 -5.492896281590E+09, + -0.1200: -2.608033630525E+05 -5.574457389799E+06 -6.079551788586E+09, + -0.1100: -7.700286584682E+04 -1.108159030613E+07 -2.781889980619E+09, + -0.1000: 2.361193646874E+05 -1.026020071878E+07 2.594799655884E+09, + -0.0900: 4.850908477531E+05 -3.009886153279E+06 6.801624622546E+09, + -0.0800: 5.465819619161E+05 7.203491828675E+06 7.665863933350E+09, + -0.0700: 3.381106567831E+05 1.491450736595E+07 4.065874464318E+09, + -0.0600: -4.714469725483E+04 1.370711826427E+07 -2.211294088183E+09, + -0.0500: -3.742714523555E+05 3.168986771238E+06 -7.210522901092E+09, + -0.0400: -4.935120534148E+05 -1.155464742295E+07 -8.290662952006E+09, + -0.0300: -3.776086725678E+05 -2.343755304211E+07 -5.045387822501E+09, + -0.0200: -9.262518004209E+04 -2.590197357417E+07 1.038137469139E+09, + -0.0100: 1.684991020317E+05 -1.655518096008E+07 6.434956471242E+09, + 0.0000: 2.672401220120E+05 5.842840285286E+04 8.499118737979E+09, + 0.0100: 1.696759327062E+05 1.665082520632E+07 6.431805186105E+09, + 0.0200: -9.029414726636E+04 2.595877026851E+07 1.034250062317E+09, + 0.0300: -3.744026113586E+05 2.347492262870E+07 -5.049032768689E+09, + 0.0400: -4.899777037611E+05 1.159671095881E+07 -8.295435320113E+09, + 0.0500: -3.710165622686E+05 -3.113146703985E+06 -7.217946693033E+09, + 0.0600: -4.473757096673E+04 -1.364479866246E+07 -2.222422182490E+09, + 0.0700: 3.392248286490E+05 -1.487394611896E+07 4.050776939681E+09, + 0.0800: 5.462403536954E+05 -7.220340756288E+06 7.648795602754E+09, + 0.0900: 4.833929725393E+05 2.922365613993E+06 6.785787060897E+09, + 0.1000: 2.332745423827E+05 1.011582040531E+07 2.581766909396E+09, + 0.1100: -8.070736312412E+04 1.090414403258E+07 -2.792601532912E+09, + 0.1200: -2.649970308395E+05 5.386045645284E+06 -6.089426185298E+09, + 0.1300: -2.207443199305E+05 -1.988698978346E+06 -5.503399510348E+09, + 0.1400: -3.866388586286E+04 -6.992764192136E+06 -2.257686477098E+09, + 0.1500: 1.077125324433E+05 -8.857699352143E+06 9.515329594721E+08, + 0.1600: 1.392384554216E+05 -8.623265237486E+06 2.604387280331E+09, + 0.1700: 3.546117272124E+04 -7.443405807155E+06 2.207033591335E+09, + 0.1800: -1.123343937535E+05 -6.902982688720E+06 9.457595228746E+08, + 0.1900: -1.789171454696E+05 -5.682700685790E+06 5.585347414178E+08, + 0.2000: -1.697114894368E+05 -2.557017246825E+06 9.621537088741E+08, + 0.2100: -1.598810501737E+05 1.516569514356E+06 1.019171216503E+09, + 0.2200: -1.639215270280E+05 4.958934195080E+06 4.467235158328E+08, + 0.2300: -1.663723122656E+05 7.053222384959E+06 -4.573504258074E+08, + 0.2400: -1.360031938947E+05 7.562468996487E+06 -1.133883015053E+09, + 0.2500: -2.219746004905E+04 8.013866077465E+06 -7.510725756338E+08, + 0.2600: 1.234992292740E+05 9.571476770611E+06 1.057274319747E+08, + 0.2700: 1.810621860332E+05 1.064803348510E+07 -1.270861471479E+08, + 0.2800: 1.202822455656E+05 8.220491285813E+06 -1.723998805496E+09, + 0.2900: 2.893356305500E+04 1.239979444419E+06 -3.170497130671E+09, + 0.3000: -1.053994031332E+03 -8.430162106158E+06 -3.022409237712E+09, + 0.3100: 1.106806816671E+05 -1.605057597297E+07 -2.235388130933E+08, + 0.3200: 3.134950641276E+05 -1.708683535531E+07 4.150668088639E+09, + 0.3300: 4.281629620008E+05 -1.086963550744E+07 7.038208288960E+09, + 0.3400: 3.171077724660E+05 -1.639915959181E+06 6.040690465756E+09, + 0.3500: 1.403929841139E+04 5.631007230378E+06 1.582833574076E+09, + 0.3600: -3.718132431220E+05 7.358593907508E+06 -4.420240028534E+09, + 0.3700: -6.506595387317E+05 2.881668074359E+06 -8.735471154386E+09, + 0.3800: -6.394278878868E+05 -4.457768120434E+06 -8.319163610870E+09, + 0.3900: -3.465641644181E+05 -9.336216599459E+06 -3.315029532020E+09, + 0.4000: 5.432681079919E+04 -8.622273457326E+06 3.394330342160E+09, + 0.4100: 3.760970028450E+05 -2.501937230326E+06 8.534619809987E+09, + 0.4200: 4.507689322965E+05 5.931185151437E+06 9.247585730298E+09, + 0.4300: 2.673419263671E+05 1.228918854347E+07 5.285270432152E+09, + 0.4400: -5.017941329692E+04 1.410570146708E+07 -1.148799177688E+09, + 0.4500: -3.394227637539E+05 1.059685267256E+07 -7.064054037866E+09, + 0.4600: -4.458955286254E+05 3.299455680604E+06 -9.619629669008E+09, + 0.4700: -2.741530713992E+05 -4.690345997499E+06 -7.185263622607E+09, + 0.4800: 9.556252769881E+04 -8.922324330553E+06 -1.144337231451E+09, + 0.4900: 4.818255777570E+05 -7.287269315212E+06 5.379884978791E+09, + 0.5000: 6.957456843667E+05 -4.856750479702E+05 9.122037094376E+09, + 0.5100: 5.979718484883E+05 7.376019641187E+06 7.831664833933E+09, + 0.5200: 2.522715135583E+05 1.150119332195E+07 2.584922894109E+09, + 0.5300: -1.366544201566E+05 9.341965962783E+06 -3.149952395174E+09, + 0.5400: -4.055239879838E+05 1.545974017708E+06 -6.547926403496E+09, + 0.5500: -4.613315826233E+05 -7.508153623211E+06 -6.197566022445E+09, + 0.5600: -3.889167807498E+05 -1.078717663395E+07 -3.837738463829E+09, + 0.5700: -2.549283797494E+05 -1.115378507754E+07 -9.552000010363E+08, + 0.5800: -5.459784743531E+04 -8.643483813377E+06 2.049954617106E+09, + 0.5900: 5.083979259677E+04 -1.062442770899E+06 2.660414135031E+09, + 0.6000: -9.965599099402E+03 3.181552841433E+06 2.631023964258E+08, + 0.6100: 4.269899721327E+04 -2.047749797264E+06 -4.352122784767E+08, + 0.6200: 1.323567916420E+05 -5.460582066119E+06 -1.024119183565E+08, + 0.6300: 3.443112189882E+04 -7.748327889468E+06 -1.620592737217E+09, + 0.6400: 6.216794928461E+04 -1.230415472815E+07 -4.986255197445E+08, + 0.6500: 1.735945576365E+05 -7.928826073521E+06 1.985558981272E+09, + 0.6600: 1.997595168357E+04 1.199028130024E+06 2.714674447338E+08, + 0.6700: -1.317274225036E+05 -2.229211283411E+06 -1.566114580849E+09, + 0.6800: 3.676188933651E+03 -6.448811149854E+06 6.715395074773E+08, + 0.6900: 9.442661008529E+04 2.469265408610E+06 1.785041969109E+09, + 0.7000: -9.081126493106E+03 1.038784347156E+07 -4.597317837363E+08 + } + }, + curve = { + m = 9, + kind = cos, + derivs = { + -0.7000: 1.334949301617E+04 3.071187303325E+05 1.770678440351E+09, + -0.6900: -2.646982712685E+04 1.027302052548E+07 7.448182770851E+08, + -0.6800: -1.313079770075E+05 1.240403428614E+07 -1.568978639285E+09, + -0.6700: -1.482948804029E+03 5.745906183833E+06 -2.658245157404E+08, + -0.6600: 1.833482405940E+05 5.582682797459E+06 1.935969710403E+09, + -0.6500: 4.107137667948E+04 6.403518906334E+06 -4.383721440738E+08, + -0.6400: -9.810718523201E+04 -4.534775527092E+06 -2.155585124223E+09, + -0.6300: -1.742233383913E+04 -1.080719922147E+07 -5.213484150018E+07, + -0.6200: -4.268257573541E+04 -2.729287541851E+06 7.142763971852E+08, + -0.6100: -1.294848053267E+05 3.699952358811E+06 3.348287592396E+08, + -0.6000: -4.158177051709E+04 7.496560919546E+06 1.766001753686E+09, + -0.5900: -6.549023893496E+04 1.281543269477E+07 7.409847073977E+08, + -0.5800: -2.377962586431E+05 1.086120067997E+07 -2.871074587467E+09, + -0.5700: -3.069408385560E+05 1.484438518663E+06 -4.895512386080E+09, + -0.5600: -2.373118217157E+05 -7.706749935991E+06 -4.509534709594E+09, + -0.5500: -9.956988852897E+04 -1.390045779134E+07 -2.560759519921E+09, + -0.5400: 1.850996155219E+05 -1.541458198014E+07 1.932921780385E+09, + -0.5300: 4.639902815541E+05 -8.602517305065E+06 6.343573622966E+09, + -0.5200: 5.750864265766E+05 2.473081167246E+06 7.854911667610E+09, + -0.5100: 4.179549132014E+05 1.214167730180E+07 4.969549562142E+09, + -0.5000: 4.675198141237E+04 1.358226760494E+07 -1.134009050326E+09, + -0.4900: -3.083789912678E+05 5.034978573241E+06 -6.613668416682E+09, + -0.4800: -4.725385994918E+05 -9.148501756894E+06 -8.445560153936E+09, + -0.4700: -4.008027305700E+05 -2.204673611270E+07 -5.899520436427E+09, + -0.4600: -1.372391809787E+05 -2.667691118451E+07 -8.423433089494E+07, + -0.4500: 1.393193899594E+05 -1.925300014053E+07 5.683582569059E+09, + -0.4400: 2.685550162316E+05 -3.173664725339E+06 8.434434909773E+09, + -0.4300: 2.006076973094E+05 1.424889056963E+07 7.061841515757E+09, + -0.4200: -4.262687755648E+04 2.537511544395E+07 2.090689112437E+09, + -0.4100: -3.404333980673E+05 2.475615875321E+07 -4.137927180413E+09, + -0.4000: -4.932407710268E+05 1.372331377354E+07 -8.020245471975E+09, + -0.3900: -4.120917470423E+05 -1.244465752463E+06 -7.677747527903E+09, + -0.3800: -1.109775482985E+05 -1.286088990582E+07 -3.216542726648E+09, + -0.3700: 2.823205240526E+05 -1.545043972452E+07 3.118379016312E+09, + -0.3600: 5.327692312468E+05 -8.515965590741E+06 7.368833352015E+09, + -0.3500: 5.103866833966E+05 1.826075765908E+06 7.189830244246E+09, + -0.3400: 2.841516100652E+05 9.636393248276E+06 3.403922008949E+09, + -0.3300: -2.936758435362E+04 1.132278175452E+07 -1.972874744325E+09, + -0.3200: -2.449397307433E+05 6.394134397497E+06 -5.803655140340E+09, + -0.3100: -2.349294949673E+05 -9.106219899131E+05 -5.829781364784E+09, + -0.3000: -6.379599818266E+04 -6.209744240803E+06 -2.832491343991E+09, + -0.2900: 9.453267131312E+04 -8.349239568181E+06 5.287681904248E+08, + -0.2800: 1.443811860485E+05 -8.520542449956E+06 2.483508339503E+09, + -0.2700: 5.940292225699E+04 -7.636083756462E+06 2.400144577889E+09, + -0.2600: -9.138378783026E+04 -7.289867804926E+06 1.139086564312E+09, + -0.2500: -1.723915014340E+05 -6.363614332025E+06 5.734497520720E+08, + -0.2400: -1.697193391157E+05 -3.342906793261E+06 9.211328378266E+08, + -0.2300: -1.571283382162E+05 9.861509902833E+05 1.087953895307E+09, + -0.2200: -1.621751414105E+05 4.679237705457E+06 5.865377494572E+08, + -0.2100: -1.685664347526E+05 6.891567172955E+06 -3.028151233860E+08, + -0.2000: -1.492420220020E+05 7.383155103929E+06 -1.086431419724E+09, + -0.1900: -4.864983373960E+04 7.586573801393E+06 -8.737783127437E+08, + -0.1800: 9.992015444538E+04 9.116193000500E+06 1.578632873262E+07, + -0.1700: 1.783786771920E+05 1.078970583324E+07 5.172658405217E+07, + -0.1600: 1.314742619099E+05 9.285828941976E+06 -1.409005124987E+09, + -0.1500: 3.713152744518E+04 2.962880588351E+06 -3.008139903558E+09, + -0.1400: -9.684587087441E+03 -6.777743867427E+06 -3.233416565743E+09, + -0.1300: 7.978199511918E+04 -1.541776554130E+07 -8.716162075858E+08, + -0.1200: 2.809396041643E+05 -1.788062997399E+07 3.434835748544E+09, + -0.1100: 4.265186855280E+05 -1.258719443399E+07 6.810791626535E+09, + -0.1000: 3.555367113732E+05 -3.297451885213E+06 6.506640150226E+09, + -0.0900: 7.715785644051E+04 4.731138912299E+06 2.511018835747E+09, + -0.0800: -3.073888343920E+05 7.592157720397E+06 -3.431211007075E+09, + -0.0700: -6.213125137920E+05 4.010621330543E+06 -8.298585060868E+09, + -0.0600: -6.649505432509E+05 -3.159876471204E+06 -8.766541633524E+09, + -0.0500: -4.091731069926E+05 -8.685241249253E+06 -4.362421375310E+09, + -0.0400: -1.371444690712E+04 -8.879605363103E+06 2.298011534365E+09, + -0.0300: 3.335812134233E+05 -3.544615697011E+06 7.931788677880E+09, + -0.0200: 4.555845731351E+05 4.714220906681E+06 9.510672692197E+09, + -0.0100: 3.072203114324E+05 1.146193514009E+07 6.217743036272E+09, + 0.0000: 4.937815267971E+02 1.409073165866E+07 2.091203744590E+06, + 0.0100: -3.060778539042E+05 1.147179457700E+07 -6.213625564794E+09, + 0.0200: -4.540054292082E+05 4.727343460355E+06 -9.506932357809E+09, + 0.0300: -3.313636758511E+05 -3.540133726616E+06 -7.928814212933E+09, + 0.0400: 1.664735564247E+04 -8.895079613334E+06 -2.295782862276E+09, + 0.0500: 4.127634193012E+05 -8.723826611204E+06 4.364422954022E+09, + 0.0600: 6.690580924302E+05 -3.211482166360E+06 8.769040978940E+09, + 0.0700: 6.257656724571E+05 3.969710871245E+06 8.301860040125E+09, + 0.0800: 3.119472680220E+05 7.589261558704E+06 3.434305747590E+09, + 0.0900: -7.287839203432E+04 4.777132644161E+06 -2.510136003745E+09, + 0.1000: -3.520476784339E+05 -3.221701639326E+06 -6.509734341359E+09, + 0.1100: -4.243505861442E+05 -1.252238918966E+07 -6.818157371969E+09, + 0.1200: -2.805527510905E+05 -1.786611702530E+07 -3.445175377673E+09, + 0.1300: -8.150419356868E+04 -1.547318433121E+07 8.603256331982E+08, + 0.1400: 5.771851023884E+03 -6.897055911962E+06 3.222770249317E+09, + 0.1500: -4.295315696077E+04 2.809494345409E+06 2.998968501831E+09, + 0.1600: -1.386040132819E+05 9.144017485992E+06 1.401706453032E+09, + 0.1700: -1.860974538496E+05 1.070311874319E+07 -5.715719855165E+07, + 0.1800: -1.075423710120E+05 9.106289083851E+06 -1.952646653981E+07, + 0.1900: 4.174210424708E+04 7.648560860110E+06 8.720947773571E+08, + 0.2000: 1.435489415409E+05 7.496716126447E+06 1.087487562661E+09, + 0.2100: 1.644046193183E+05 7.027117103542E+06 3.067014395833E+08, + 0.2200: 1.596923516539E+05 4.800207564293E+06 -5.801821693520E+08, + 0.2300: 1.563272925169E+05 1.057277269247E+06 -1.079347770795E+09, + 0.2400: 1.704401066425E+05 -3.349887545282E+06 -9.102735477143E+08, + 0.2500: 1.743700123428E+05 -6.466402674345E+06 -5.595002714430E+08, + 0.2600: 9.433654243222E+04 -7.476034511418E+06 -1.120102843417E+09, + 0.2700: -5.587454570611E+04 -7.849201511222E+06 -2.375761324312E+09, + 0.2800: -1.408813920690E+05 -8.694966782151E+06 -2.457620408885E+09, + 0.2900: -9.164495329494E+04 -8.458876221770E+06 -5.072336316608E+08, + 0.3000: 6.573496538122E+04 -6.270552075816E+06 2.845593087645E+09, + 0.3100: 2.357636559129E+05 -9.623287490805E+05 5.833069123680E+09, + 0.3200: 2.447150911204E+05 6.306588985567E+06 5.800080561698E+09, + 0.3300: 2.838047326593E+04 1.119865822433E+07 1.970435388875E+09, + 0.3400: -2.857133860711E+05 9.545407996494E+06 -3.398044275168E+09, + 0.3500: -5.127037046652E+05 1.849578410368E+06 -7.174811712746E+09, + 0.3600: -5.360758370082E+05 -8.347944569041E+06 -7.348123408442E+09, + 0.3700: -2.866234504604E+05 -1.516164220893E+07 -3.096337151608E+09, + 0.3800: 1.058710778592E+05 -1.251705325524E+07 3.235607615152E+09, + 0.3900: 4.066014772846E+05 -9.333902285970E+05 7.691547917257E+09, + 0.4000: 4.879477707454E+05 1.393428162893E+07 8.029118944844E+09, + 0.4100: 3.358072822006E+05 2.483616874468E+07 4.142630477311E+09, + 0.4200: 3.896073004190E+04 2.531510590236E+07 -2.089263066833E+09, + 0.4300: -2.030690390596E+05 1.406594338465E+07 -7.061405007557E+09, + 0.4400: -2.696522474836E+05 -3.426025441824E+06 -8.432199399783E+09, + 0.4500: -1.390831781382E+05 -1.949959461186E+07 -5.677595767947E+09, + 0.4600: 1.385745119872E+05 -2.684311507004E+07 9.460602017939E+07, + 0.4700: 4.027991140858E+05 -2.208057911625E+07 5.912762224340E+09, + 0.4800: 4.746103414113E+05 -9.044147529543E+06 8.458210081033E+09, + 0.4900: 3.099287837871E+05 5.234917581686E+06 6.622185081813E+09, + 0.5000: -4.625248520173E+04 1.380678411648E+07 1.136034702063E+09, + 0.5100: -4.189352875345E+05 1.231025661497E+07 -4.974783627937E+09, + 0.5200: -5.778275462647E+05 2.515142648988E+06 -7.866076788191E+09, + 0.5300: -4.686158387581E+05 -8.725199129235E+06 -6.357886989973E+09, + 0.5400: -1.915654279780E+05 -1.570054548979E+07 -1.947758237346E+09, + 0.5500: 9.157579393411E+04 -1.431077916924E+07 2.547665762988E+09, + 0.5600: 2.283647294257E+05 -8.161971132409E+06 4.500396409820E+09, + 0.5700: 2.976528090783E+05 1.090767632403E+06 4.891285132105E+09, + 0.5800: 2.286148680502E+05 1.062138466370E+07 2.870569548534E+09, + 0.5900: 5.667294698459E+04 1.277144741360E+07 -7.400485614955E+08, + 0.6000: 3.325848058274E+04 7.634501467240E+06 -1.765521495109E+09, + 0.6100: 1.217212938241E+05 3.970015276555E+06 -3.359076887337E+08, + 0.6200: 3.548354861962E+04 -2.388892907285E+06 -7.179200213365E+08, + 0.6300: 1.071723705650E+04 -1.045777023518E+07 4.493118984202E+07, + 0.6400: 9.175796205025E+04 -4.224983085791E+06 2.144864381375E+09, + 0.6500: -4.735499730660E+04 6.647592518452E+06 4.247925678201E+08, + 0.6600: -1.900617756531E+05 5.741531838181E+06 -1.952668447059E+09, + 0.6700: -6.124458729505E+03 5.790159098660E+06 2.459123762692E+08, + 0.6800: 1.226306088608E+05 1.231680566952E+07 1.547669491419E+09, + 0.6900: 1.675762315695E+04 1.007315843965E+07 -7.652426807181E+08, + 0.7000: -2.396589176370E+04 3.489769026616E+04 -1.789122464791E+09 + } + } + } diff --git a/regression_tests/write_foreign_test/output.correct b/regression_tests/write_foreign_test/output.correct new file mode 100644 index 0000000000..28f0c1bfc9 --- /dev/null +++ b/regression_tests/write_foreign_test/output.correct @@ -0,0 +1,6 @@ +"write_foreign_test.mad8" STR "GOOD" +"write_foreign_test.madx" STR "GOOD" +!"write_foreign_test.sad" STR "GOOD" +"write_foreign_test.lte" STR "GOOD" +"write_foreign_test.julia" STR "GOOD" +!"write_foreign_test.opal" STR "GOOD" diff --git a/regression_tests/write_foreign_test/run.py b/regression_tests/write_foreign_test/run.py new file mode 100644 index 0000000000..a54a0c6c3d --- /dev/null +++ b/regression_tests/write_foreign_test/run.py @@ -0,0 +1,41 @@ +import subprocess +import os +import sys +import difflib + +out_file = open('output.now', 'w') + +#----------- + +exe = sys.argv[1] + 'write_foreign_test' +results = subprocess.run([exe], stdout=subprocess.PIPE).stdout.decode('utf-8') +d = difflib.Differ() + +files = ['write_foreign_test.mad8', 'write_foreign_test.madx', 'write_foreign_test.sad', + 'write_foreign_test.lte', 'write_foreign_test.julia', 'write_foreign_test.opal'] + +files = ['write_foreign_test.mad8', 'write_foreign_test.madx', + 'write_foreign_test.lte', 'write_foreign_test.julia'] + +for file in files: + f1 = open(file + '.correct', 'r') + lines1 = f1.readlines() + + f2 = open(file + '.now', 'r') + lines2 = f2.readlines() + + differ = False + for line in d.compare(lines1, lines2): + if line[0] == ' ': continue + if 'Bmad Lattice File' in line: continue + if not differ: + print('\n' + file) + differ = True + print(line) + + if differ: + out_file.write ('"' + file + '" STR "BAD"\n') + print(results) + else: + out_file.write ('"' + file + '" STR "GOOD"\n') + diff --git a/regression_tests/write_foreign_test/to_correct b/regression_tests/write_foreign_test/to_correct new file mode 100755 index 0000000000..2b11716141 --- /dev/null +++ b/regression_tests/write_foreign_test/to_correct @@ -0,0 +1,6 @@ +cp write_foreign_test.mad8.now write_foreign_test.mad8.correct +cp write_foreign_test.madx.now write_foreign_test.madx.correct +cp write_foreign_test.sad.now write_foreign_test.sad.correct +cp write_foreign_test.lte.now write_foreign_test.lte.correct +cp write_foreign_test.julia.now write_foreign_test.julia.correct +cp write_foreign_test.opal.now write_foreign_test.opal.correct diff --git a/regression_tests/write_foreign_test/write_foreign_test.bmad b/regression_tests/write_foreign_test/write_foreign_test.bmad new file mode 100644 index 0000000000..8a7274cda6 --- /dev/null +++ b/regression_tests/write_foreign_test/write_foreign_test.bmad @@ -0,0 +1,147 @@ +no_digested +parameter[ran_seed] = 1234 +parameter[n_part] = 1e10 +parameter[ptc_exact_model] = true +parameter[geometry] = open +beginning[beta_a] = 10 +beginning[beta_b] = 10 + +particle_start[x] = 0.001 +particle_start[px] = 0.002 +particle_start[y] = 0.003 +particle_start[py] = 0.004 +particle_start[z] = 0.005 +particle_start[pz] = 0.006 +particle_start[spin_x] = 0.3 +particle_start[spin_y] = 0.4 +particle_start[spin_z] = 0.5 + + +ab_multipole1: ab_multipole, a2 = 1e2, b2 = 1e2, x_offset = 0.02, tilt = 0.1 +ac_kicker1: ac_kicker, l = 0.3, hkick = 0.01, amp_vs_time = {(-1e-8, 1.0), (2e-8, 0.7)}, t_offset = 1e-9 +ac_kicker2: ac_kicker, l = 0.4, vkick = 0.01, frequencies = {(1e8, 1.7, 0.1),(2e8, 2.0, 0.3)}, t_offset = 2e-9 +ac_kicker3: ac_kicker, l = 0.4, vkick = 0.01, frequencies = {(1e8, 1.7, 0.1)}, t_offset = 2e-9 +beambeam1: beambeam, sig_x = 3e-3, sig_y = 3e-4, sig_z = 0.1, n_slice = 4, ks = 1, + x_offset = 2e-3+particle_start[x], y_offset = particle_start[y], y_pitch = 0.05 +crab_cavity1: crab_cavity, l = 0.2, voltage = 1e3, phi0 = -0.2, rf_frequency = 1e8 +drift1: drift, l = 4.5, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, tilt = 0.1 +e_gun1: e_gun, l = 2, voltage = 0.5e6, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, tilt = 0.1 +ecollimator1: ecollimator, l = 4.5, x_limit = 0.2, y_limit = 0.1, num_steps = 10, x_offset = 0.02, y_pitch = 0.001, tilt = 0.1, hkick = 0.01, vkick = 0.002 +elseparator1: elseparator, l = 4.5, hkick = 0.005, gap = 0.11, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, tilt = 0.1 +elseparator2: elseparator, l = 4.5, vkick = 0.005, gap = 0.11, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, tilt = 0.1 +em_field1: em_field, l = 1.4, call::gg.bmad +em_field2: em_field1, integrator_order = 6 +fiducial1: fiducial, dx_origin = 0.1, dy_origin = 0.2, dz_origin = 0.3, dtheta_origin = 0.01, dphi_origin = 0.02, dpsi_origin = 0.4 +foil1: foil, material_type = "Cu", thickness = 1e-4 +foil2: foil, material_type = "B4C", thickness = 1e-4, density = (2.37e3, 2e3), radiation_length = (5.26868, 4.26983), dthickness_dx = 0.01 +foil3: foil, material_type = "C", thickness = 0, area_density = 2.37e-1, scatter_method = lynch_dahl +floor_shift1: floor_shift, x_offset = 0.1, y_offset = 0.2, z_offset = 0.3, x_pitch = 0.01, y_pitch = 0.02, tilt = 0.4 +gkicker1: gkicker, x_kick = 0.01, px_kick = 0.02, y_kick = 0.03, py_kick = 0.04, z_kick = 0.05, pz_kick = 0.06 +hkicker1: hkicker, l = 4.5, kick = 0.005, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, tilt = 0.1 +instrument1: instrument, l = 4.5, num_steps = 10 +kicker1: kicker, l = 4.5, b0 = 0.002 , vkick = 0.003, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, tilt = 0.1 +lcavity1: lcavity, l = 4.5, rf_frequency = 500e6, voltage = 5e3, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, tilt = 0.1, phi0 = 0.15, phi0_err = -0.34 +lcavity2: lcavity, l = 4.5, rf_frequency = 500e6, voltage = 5, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, tilt = 0.1, phi0 = 0.15, phi0_err = -0.34 +lcavity3: lcavity, l = 4.5, rf_frequency = 500e6, voltage = 5e3, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, + tilt = 0.1, coupler_at = both_ends, coupler_strength = 0.05, gradient_err = 10, phi0 = 0.15, phi0_err = -0.34, cavity_type = traveling_wave +match1: match, delta_time = 1e-9, beta_a0 = 1, beta_b0 = 2, beta_a1 = 2, beta_b1 = 3, + c11_mat0 = 0.1, c12_mat0 = 0.2, c21_mat0 = 0.3, c22_mat0 = 0.4, + c11_mat1 = 0.4, c12_mat1 = 0.3, c21_mat1 = 0.2, c22_mat1 = 0.1, + spin_tracking_model = transverse_field + +monitor1: monitor, l = 4.5, num_steps = 10 +multipole1: multipole, k1l = 1, t1, k3l = 4.5, t3 = 0.31*pi, x_offset = 0.05 + +octupole1: octupole, l = 4.5, k3 = 1e3, tilt, num_steps = 10, x_offset = 0.01, y_pitch = 0.001 + +patch1: patch, x_offset = 0.001, y_offset = 0.002, z_offset = 0.004, t_offset = 1e-11, x_pitch = 0.001, y_pitch = 0.002, tilt = 2 + +q0: quadrupole, a0 = 0.01, a1 = 0.1, vkick = -0.0001, b0_elec = -2e3, a1_elec = 2e4 +quadrupole1: q0, l = 0.6, k1 = 1, tilt, num_steps = 10, x_offset = 0.05, y_pitch = 0.001 +quadrupole2: q0, l = 0.6, k1 = -1, tilt, num_steps = 10, x_offset = 0.05, y_pitch = 0.001 +quadrupole3: q0, l = 0.6, k1 = 1e-20, tilt, num_steps = 10, x_offset = 0.05, y_pitch = 0.001 +quadrupole4: q0, l = 0.6, k1 = 1, tilt, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, fringe_type = full +quadrupole5: q0, l = 0.6, k1 = -1, tilt, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, fringe_type = full +rcollimator1: rcollimator, l = 4.5, x_limit = 0.2, y_limit = 0.1, num_steps = 10, x_offset = 0.02, y_pitch = 0.001, tilt = 0.1 +rfcavity1: rfcavity, l = 4.5, rf_frequency = 500e6, voltage = 1e5, phi0 = 0.1, num_steps = 10, x_offset = 0.05, + y_pitch = 0.001, tilt = 0.1 +rfcavity2: rfcavity, l = 4.5, rf_frequency = 500e6, voltage = 1e5, phi0 = 0.1, num_steps = 10, x_offset = 0.05, + y_pitch = 0.001, tilt = 0.1, coupler_at = both_ends, coupler_strength = 0.1, cavity_type = traveling_wave +rfcavity3: rfcavity, rf_frequency = 500e6, voltage = 1e5, phi0 = 0.1, num_steps = 10, x_offset = 0.05, + y_pitch = 0.001, tilt = 0.1 +sad_mult1: sad_mult, l = 0.1, fringe_type = full, a1 = 2e-2, b2 = 4e1, a10 = 1e20, fq1 = 1, fq2 = 2, ks = 0.5 +sad_mult2: sad_mult, fringe_type = full, a1 = 2e-2, b2 = 4e1, a10 = 1e20, fq1 = 1, fq2 = 2, ks = 0.5 + + +sb0: sbend, a0 = 0.01, a1 = 0.1, vkick = -0.0001, b0_elec = -2e3, a1_elec = 2e4, r0_mag = 2, r0_elec = 3 +rb0: rbend, a0 = 0.01, a1 = 0.1, vkick = -0.0001, b0_elec = -2e3, a1_elec = 2e4, r0_mag = 2, r0_elec = 3 + +sbend1: sb0, l = 0.6, k1 = 0.3, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, ref_tilt = 0.1, exact_multipole=vertically_pure +rbend2: rb0, l = 0.6, k2 = 3, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, ref_tilt = 0.1, exact_multipole=horizontally_pure +sbend3: sb0, l = 0.6, k1 = 0.3, k2 = 3, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, ref_tilt = 0.1 +rbend4: rb0, l = 0.6, g = 0.01, dg = -0.0099, e1 = 0.1, e2 = 0.2, num_steps = 10, + fringe_type = full, x_offset = 0.05, y_pitch = 0.001, ref_tilt = 0.1 +sbend5: sb0, l = 0.6, g = 0.01, e1 = 0.1, e2 = 0.2, num_steps = 10, fringe_type = full, + x_offset = 0.05, y_pitch = 0.001, ref_tilt = 0.1, fint = 0.7, hgap = 2 +rbend6: rb0, l = 0.6, g = 0.01, dg = -0.0099999, e1 = 0.1, e2 = 0.2, num_steps = 10, + x_offset = 0.05, y_pitch = 0.001, ref_tilt = 0.1 +sbend7: sb0, l = 0.6, g = 0.01, e1 = 0.1, e2 = 0.2, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, ref_tilt = 0.1 + +sextupole1: sextupole, l = 0.6, k2 = 1, tilt, num_steps = 10, x_offset = 0.05, y_pitch = 0.001 +solenoid1: solenoid, l = 2.6, ks = 1, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, tilt = 0.1 +solenoid2: solenoid, l = 2.6, ks = 1e-12, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, tilt = 0.1 +sol_quad1: sol_quad, l = 2.6, k1 = 1, ks = 1, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, tilt = 0.1 +sol_quad2: sol_quad, l = 2.6, k1 = 1e-5, ks = 1, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, tilt = 0.1 +taylor1: taylor, l = 0.5, {s1: 0.6|}, {sx: 0.7|}, {sy: 0.8|}, {sz: 0.23|133}, + {1: -0.009548848273192 |}, {1: 1.0044545389465 | 1}, {1: 8.8121098650987 | 2}, {1: 3.1588658629825E-06 | 3}, + {1: 6.2473608609793E-07 | 4}, {1: -0.00079443016535773 | 5}, {1: -0.0015989734203102 | 6}, {1: -0.18688671328749 | 11}, + {1: -4.4998640546185E-08 | 14}, {1: 2.2651451374404E-06 | 24}, {1: 0.073788700448494 | 34}, {1: 0.007484956273838 | 44}, + {1: 0.00082601396763208 | 55}, {1: -0.0028821993367623 | 16}, {1: -5.8123275619217 | 26}, {1: -2.265886079839E-06 | 36}, + {1: -1.0735265475719E-06 | 46}, {1: -2.5977503757166E-05 | 56}, {1: 0.001599145934809 | 66}, {2: 0.000275022360283 |}, + {2: 0.00051707642703828 | 1}, {2: 1.0001015415885 | 2}, {2: 3.6671688283007E-07 | 3}, {2: 7.2562277969591E-08 | 4}, + {2: -0.00082466736904442 | 22}, {2: 0.021696204516247 | 33}, {2: -1.6688665581997E-08 | 14}, {2: -1.00550787364E-07 | 24}, + {2: 0.0085656912718635 | 34}, {2: 0.00087607181539392 | 44}, {2: 1.5386804916133E-06 | 15}, {2: 0.0029708711792291 | 25}, + {2: -7.7463649579207E-08 | 46}, {2: -8.1698276776954E-07 | 56}, {2: 2.8869908085531E-08 | 66}, {3: 3.2610587848949E-05 |}, + {3: -8.4878689763542E-06 | 5}, {3: -1.6296474350809E-05 | 6}, {3: 5.2306276920315E-08 | 12}, {3: 9.9263012775823E-07 | 22}, + {3: 0.37377502367754 | 13}, {3: 0.073779185147525 | 23}, {3: 0.073717614772643 | 14}, {3: 0.01455164869765 | 24}, + {3: -0.0014099480251362 | 35}, {3: -3.0176045012421 | 45}, {3: 8.4155398883643E-06 | 55}, {3: -2.265461523986E-06 | 16}, + {3: -1.0704091926158E-06 | 26}, {3: 0.0028826770573567 | 36}, {3: -5.8094307630203 | 46}, {3: 1.1948119498249E-07 | 56}, + {4: -0.00051721102259608 | 3}, {4: 0.99989735493446 | 4}, {4: 8.3316347911185E-09 | 5}, {4: -7.3754939754283E-08 | 22}, + {4: -1.6488657985452E-08 | 34}, {4: -1.7426362705245E-07 | 44}, {4: -1.5335666645362E-06 | 35}, {4: 0.00297026174678 | 45}, + {4: -2.4061772320287E-08 | 16}, {4: -7.7038857344361E-08 | 26}, {4: -2.3149938691032E-06 | 36}, {4: 0.00010238081722251 | 46}, + {5: -8.6213990823047E-05 |}, {5: -7.9767882767976E-07 | 1}, {5: -0.0015988799230182 | 2}, {5: 7.5743225597097E-09 | 3}, + {5: -3.4279364209869E-05 | 33}, {5: -2.1930300969081E-06 | 14}, {5: -8.1288561193211E-07 | 24}, {5: 0.0028890834757965 | 34}, + {5: -2.9048688615274 | 44}, {5: 8.0459784624258E-07 | 15}, {5: -2.3619439665921E-05 | 25}, {5: 1.4526115573872E-07 | 45}, + {5: 1.4504319745257E-08 | 56}, {5: -7.4136661038076E-07 | 66}, {6: -7.5702326313154E-06 |}, {6: 1.2266225971909E-06 | 1}, + {6: 0.00079221093326577 | 2}, {6: 4.2434113169099E-09 | 3}, {6: 8.4636393264336E-06 | 4}, {6: 0.0059409439272306 | 5}, + {6: 3.6954232986861E-07 | 13}, {6: 1.1765753082019E-06 | 23}, {6: 1.6057156163853E-05 | 33}, {6: 1.1766022575118E-06 | 14}, + {6: 4.782914122933E-07 | 24}, {6: 0.0014203210587175 | 34}, {6: 1.504474955002 | 44}, {6: -5.3002411118529E-07 | 15}, + {6: 3.2952059293287E-05 | 26}, {6: -4.6831132007123E-08 | 46} +thick_multipole1: thick_multipole, l = 4.5, a2 = 1, b3 = 20, x_offset = 0.02, tilt = 0.1 +vkicker1: vkicker, l = 4.5, kick = 0.005, num_steps = 10, x_offset = 0.05, y_pitch = 0.001, tilt = 0.1 +wiggler_map1: wiggler, l = 1.6, num_steps = 10, field_calc = fieldmap, cartesian_map = { + term = {3e-4, 3, 4, 5, 0.002, 3e-4, 0.63, x}, term = {3e-4, 3, 4, 5, 0.002, 3e-4, 0.63, y}, + term = {3e-4, 5, 3, 4, 0.002, 3e-4, 0.63, x}, term = {3e-4, 5, 3, 4, 0.002, 3e-4, 0.63, y}, + term = {3e-4, 4, 5, 3, 0.002, 3e-4, 0.63, x}, term = {3e-4, 4, 5, 3, 0.002, 3e-4, 0.63, y}}, + tracking_method = symp_lie_ptc, x_offset = 0.05, y_pitch = 0.001, tilt = 0.1 +wiggler_flat1: wiggler, l = 1, b_max = 0.0001, n_pole = 20, num_steps = 1, x_offset = 0.01, y_pitch = 0.001, tilt = 0.1 +wiggler_heli1: wiggler, l = 1, b_max = 0.0001, n_pole = 20, num_steps = 1, x_offset = 0.01, y_pitch = 0.001, tilt = 0.1, field_calc = helical_model + +!----------- +! Put lcavity elements last since they shift reference energy +!l1: line = (ab_multipole1, ac_kicker1, ac_kicker2, ac_kicker3, beambeam1, crab_cavity1, drift1, ecollimator1, elseparator1, elseparator2, +l1: line = (ab_multipole1, ac_kicker1, ac_kicker2, ac_kicker3, beambeam1, crab_cavity1, ecollimator1, elseparator1, elseparator2, + em_field1, em_field2, fiducial1, floor_shift1, gkicker1, hkicker1, instrument1, kicker1, + match1, monitor1, multipole1, octupole1, patch1, quadrupole1, + quadrupole2, quadrupole3, quadrupole4, quadrupole5, rcollimator1, rfcavity1, rfcavity2, rfcavity3, sad_mult1, sad_mult2, + sbend1, rbend2, sbend3, rbend4, sbend5, rbend6, sbend7, sextupole1, solenoid1, solenoid2, sol_quad1, sol_quad2, + thick_multipole1, taylor1, vkicker1, lcavity1, lcavity2, lcavity3) +! thick_multipole1, taylor1, vkicker1, wiggler_map1, wiggler_flat1, wiggler_heli1, lcavity1, lcavity2, lcavity3) + + +l1[e_tot] = 1e6 +l1[geometry] = open +l1[beta_a] = 10 +l1[beta_b] = 10 + +use, l1 diff --git a/regression_tests/write_foreign_test/write_foreign_test.f90 b/regression_tests/write_foreign_test/write_foreign_test.f90 new file mode 100644 index 0000000000..66567803a3 --- /dev/null +++ b/regression_tests/write_foreign_test/write_foreign_test.f90 @@ -0,0 +1,49 @@ +program write_foreign_test + +use write_lattice_file_mod + +type (lat_struct) lat + +integer nargs +logical debug_mode + +character(200) lat_file, out_file + +! + +bmad_com%auto_bookkeeper = .false. +global_com%exit_on_error = .false. +write_lat_debug_flag = .true. ! Limit output precision to prevent output shifts when running with different compilers +lat_file = 'write_foreign_test.bmad' + +debug_mode = .false. +nargs = command_argument_count() + +if (nargs > 0) then + call get_command_argument(1, lat_file) + print *, 'Using ', trim(lat_file) + debug_mode = .true. +endif + +if (.not. debug_mode) call output_direct(-1, .false., s_info$, s_error$) +call bmad_parser (lat_file, lat, .false.) + +call file_suffixer(lat_file, out_file, 'mad8.now', .true.) +call write_lattice_in_foreign_format ('MAD-8', out_file, lat) + +call file_suffixer(lat_file, out_file, 'madx.now', .true.) +call write_lattice_in_foreign_format ('MAD-X', out_file, lat) + +!call file_suffixer(lat_file, out_file, 'sad.now', .true.) +!call write_lattice_in_foreign_format ('SAD', out_file, lat) + +call file_suffixer(lat_file, out_file, 'lte.now', .true.) +call write_lattice_in_foreign_format ('ELEGANT', out_file, lat) + +call file_suffixer(lat_file, out_file, 'julia.now', .true.) +call write_lattice_in_foreign_format ('JULIA', out_file, lat) + +!call file_suffixer(lat_file, out_file, 'opal.now', .true.) +!call write_lattice_in_foreign_format ('OPAL-T', out_file, lat) + +end program diff --git a/regression_tests/write_foreign_test/write_foreign_test.julia.correct b/regression_tests/write_foreign_test/write_foreign_test.julia.correct new file mode 100644 index 0000000000..7812fe2559 --- /dev/null +++ b/regression_tests/write_foreign_test/write_foreign_test.julia.correct @@ -0,0 +1,96 @@ +# Lattice file translated from Bmad. + +@ele begin1 = BeginningEle(pc_ref = 859581, species_ref = species("positron"), beta_a = 10, beta_b = 10, + particle.orbit = [1E-3, 2E-3, 3E-3, 4E-3, 5E-3, 6E-3], particle.spin = [0.3, 0.4, 0.5]) +@ele ab_multipole1 = Multipole(Ks2L = 200, Kn2L = 200, tilt = 0.1) +@ele ac_kicker1 = ACKicker(L = 0.3, Kn0 = -0.0333333) +@ele ac_kicker2 = ACKicker(L = 0.4, Ks0 = 0.025) +@ele ac_kicker3 = ACKicker(L = 0.4, Ks0 = 0.025) +@ele beambeam1 = BeamBeam(x_offset = 3E-3, y_offset = 3E-3, y_pitch = 0.05, ksol = 1) +@ele crab_cavity1 = CrabCavity(L = 0.2, frequency = 1E8, voltage = 1000, phase = -0.2) +@ele ecollimator1 = Collimator(L = 4.5, Ks0 = 2.20372E-4, Kn0 = -2.25549E-3x_limit = [-0.2, + 0.2]y_limit = [-0.1, 0.1], x_offset = 0.02, y_pitch = 1E-3, tilt = 0.1) +@ele elseparator1 = ELSeparator(L = 4.5, En0 = -955.09, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.1) +@ele elseparator2 = ELSeparator(L = 4.5, Es0 = 955.09, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.1) +@ele em_field1 = EMField(L = 1.4) +@ele em_field2 = EMField(L = 1.4) +@ele fiducial1 = Fiducial() +@ele floor_shift1 = FloorShift(x_offset = 0.1, y_offset = 0.2, z_offset = 0.3, x_pitch = 0.01, + y_pitch = 0.02, tilt = 0.4) +@ele gkicker1 = Kicker() +@ele hkicker1 = Kicker(L = 4.5, Kn0 = -1.11111E-3, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.1) +@ele instrument1 = Instrument(L = 4.5) +@ele kicker1 = Kicker(L = 4.5, Ks0 = 6.66667E-4, Kn0 = 1.33333E-6, x_offset = 0.05, y_pitch = 1E-3, + tilt = 0.1) +@ele match1 = Match() +@ele monitor1 = Instrument(L = 4.5) +@ele multipole1 = Multipole(Ks1L = -1, Kn1L = 6.12323E-17, Ks3L = 3.08046, Kn3L = -3.28036) +@ele octupole1 = Octupole(L = 4.5, Kn3 = 10.9739, x_offset = 0.01, y_pitch = 1E-3, tilt = 0.392699) +@ele patch1 = Patch(L = 4.00499E-3, x_offset = 1E-3, y_offset = 2E-3, z_offset = 4E-3, x_pitch = 1E-3, + y_pitch = 2E-3, tilt = 2) +@ele quadrupole1 = Quadrupole(L = 0.6, Ks0 = 9.88215E-3, Kn0 = 1.17851E-4, Ks1 = 0.166667, Kn1 = 1.66667, + En0 = -2000, Es1 = 20000, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.785398) +@ele quadrupole2 = Quadrupole(L = 0.6, Ks0 = -0.0101179, Kn0 = 1.17851E-4, Ks1 = -0.166667, + Kn1 = -1.66667, En0 = -2000, Es1 = 20000, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.785398) +@ele quadrupole3 = Quadrupole(L = 0.6, Ks0 = -1.17851E-4, Kn0 = 1.17851E-4, Ks1 = 1.66667E-21, + Kn1 = 1.66667E-20, En0 = -2000, Es1 = 20000, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.785398) +@ele quadrupole4 = Quadrupole(L = 0.6, Ks0 = 9.88215E-3, Kn0 = 1.17851E-4, Ks1 = 0.166667, Kn1 = 1.66667, + En0 = -2000, Es1 = 20000, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.785398) +@ele quadrupole5 = Quadrupole(L = 0.6, Ks0 = -0.0101179, Kn0 = 1.17851E-4, Ks1 = -0.166667, + Kn1 = -1.66667, En0 = -2000, Es1 = 20000, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.785398) +@ele rcollimator1 = Collimator(L = 4.5x_limit = [-0.2, 0.2]y_limit = [-0.1, 0.1], x_offset = 0.02, + y_pitch = 1E-3, tilt = 0.1) +@ele rfcavity1 = RFCavity(L = 4.5, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.1, frequency = 5E8, + voltage = 100000, phase = 0.1, n_cell = 1, cavity_type = standing_wave) +@ele rfcavity2 = RFCavity(L = 4.5, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.1, frequency = 5E8, + voltage = 100000, phase = 0.1, n_cell = 1, cavity_type = traveling_wave) +@ele rfcavity3 = RFCavity(x_offset = 0.05, y_pitch = 1E-3, tilt = 0.1, frequency = 5E8, voltage = 100000, + phase = 0.1, n_cell = 1, cavity_type = standing_wave) +@ele sad_mult1 = SadMult(L = 0.1, Ks1 = 2, Kn2 = 80000, Ks10 = 3.6288E37, ksol = 0.5) +@ele sad_mult2 = SadMult(Ks1L = 0.02, Kn2L = 80, Ks10L = 3.6288E26, ksol = 0.5) +@ele sbend1 = Bend(L = 0.6, ref_tilt = 0.1, Ks0 = -1.65834E-4, Kn0 = 1.66389E-5, Kn1 = 0.5, En0 = -2000, + Es1 = 6666.67, x_offset = 0.05, y_pitch = 1E-3) +@ele rbend2 = Bend(bend_type = rbend, L_chord = 0.6, ref_tilt = 0.1, Ks0 = -1.65834E-4, Kn0 = 1.66389E-5, + Kn2 = 8.33333, En0 = -2000, Es1 = 6666.67, x_offset = 0.05, y_pitch = 1E-3) +@ele sbend3 = Bend(L = 0.6, ref_tilt = 0.1, Ks0 = -1.65834E-4, Kn0 = 1.66389E-5, Kn1 = 0.5, + Kn2 = 8.33333, En0 = -2000, Es1 = 6666.67, x_offset = 0.05, y_pitch = 1E-3) +@ele rbend4 = Bend(bend_type = rbend, L_chord = 0.6, e1_rect = 0.1, e2_rect = 0.2, g = 0.01, + ref_tilt = 0.1, Ks0 = -1.64834E-4, Kn0 = -9.88336E-3, Ks1 = 8.33332E-6, En0 = -2000, Es1 = 6666.67, + x_offset = 0.05, y_pitch = 1E-3) +@ele sbend5 = Bend(L = 0.6, e1 = 0.1, e2 = 0.2, g = 0.01, ref_tilt = 0.1, fint1 = 0.7, fint2 = 0.7, + hgap1 = 2, hgap2 = 2, Ks0 = -6.5834E-5, Kn0 = 1.66389E-5, Ks1 = 8.33333E-4, En0 = -2000, Es1 = 6666.67, + x_offset = 0.05, y_pitch = 1E-3) +@ele rbend6 = Bend(bend_type = rbend, L_chord = 0.6, e1_rect = 0.1, e2_rect = 0.2, g = 0.01, + ref_tilt = 0.1, Ks0 = -1.65833E-4, Kn0 = -9.98326E-3, Ks1 = 8.33332E-9, En0 = -2000, Es1 = 6666.67, + x_offset = 0.05, y_pitch = 1E-3) +@ele sbend7 = Bend(L = 0.6, e1 = 0.1, e2 = 0.2, g = 0.01, ref_tilt = 0.1, Ks0 = -6.5834E-5, + Kn0 = 1.66389E-5, Ks1 = 8.33333E-4, En0 = -2000, Es1 = 6666.67, x_offset = 0.05, y_pitch = 1E-3) +@ele sextupole1 = Sextupole(L = 0.6, Kn2 = 2.77778, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.523599) +@ele solenoid1 = Solenoid(L = 2.6, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.1, ksol = 1) +@ele solenoid2 = Solenoid(L = 2.6, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.1, ksol = 1E-12) +@ele sol_quad1 = Solenoid(L = 2.6, Kn1 = 0.384615, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.1, ksol = 1) +@ele sol_quad2 = Solenoid(L = 2.6, Kn1 = 3.84615E-6, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.1, + ksol = 1) +@ele thick_multipole1 = ThickMultipole(L = 4.5, Ks2 = 0.0219479, Kn3 = 0.292638, x_offset = 0.02, + tilt = 0.1) +@ele taylor1 = Taylor(L = 0.5) +@ele vkicker1 = Kicker(L = 4.5, Ks0 = 1.11111E-3, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.1) +@ele lcavity1 = LCavity(L = 4.5, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.1, frequency = 5E8, + voltage_ref = 5000, phase_ref = 0.15, phase_err = -0.34, n_cell = 1, cavity_type = standing_wave) +@ele lcavity2 = LCavity(L = 4.5, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.1, frequency = 5E8, + voltage_ref = 5, phase_ref = 0.15, phase_err = -0.34, n_cell = 1, cavity_type = standing_wave) +@ele lcavity3 = LCavity(L = 4.5, x_offset = 0.05, y_pitch = 1E-3, tilt = 0.1, frequency = 5E8, + voltage_ref = 5000, voltage_err = 45, phase_ref = 0.15, phase_err = -0.34, n_cell = 1, + cavity_type = traveling_wave) +@ele end1 = Marker() + + +l1 = beamline("l1", [begin1, ab_multipole1, ac_kicker1, ac_kicker2, ac_kicker3, beambeam1, crab_cavity1, + ecollimator1, elseparator1, elseparator2, em_field1, em_field2, fiducial1, floor_shift1, gkicker1, + hkicker1, instrument1, kicker1, match1, monitor1, multipole1, octupole1, patch1, quadrupole1, + quadrupole2, quadrupole3, quadrupole4, quadrupole5, rcollimator1, rfcavity1, rfcavity2, rfcavity3, + sad_mult1, sad_mult2, sbend1, rbend2, sbend3, rbend4, sbend5, rbend6, sbend7, sextupole1, solenoid1, + solenoid2, sol_quad1, sol_quad2, thick_multipole1, taylor1, vkicker1, lcavity1, lcavity2, lcavity3, + end1], geometry = open) + +lat = expand("l1", [l1]) diff --git a/regression_tests/write_foreign_test/write_foreign_test.lte.correct b/regression_tests/write_foreign_test/write_foreign_test.lte.correct new file mode 100644 index 0000000000..efac7d6cf4 --- /dev/null +++ b/regression_tests/write_foreign_test/write_foreign_test.lte.correct @@ -0,0 +1,172 @@ +! File generated by: write_lattice_in_elegant_format +! Bmad Lattice File: /nfs/acc/user/dcs16/bmad-ecosystem/regression_tests/write_foreign_test/write_foreign_test.bmad + +AB_MULTIPOLE1__2: mult, knl = 282.843, tilt = -0.161799, order = 2, dx = 0.02 +A_KICKER_1: ekicker, hkick = 5E-3 +AC_KICKER1: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = 3.0375E-8, & + r55 = 1, r66 = 1 +A_KICKER_2: ekicker, vkick = 5E-3 +AC_KICKER2: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = 1.9869E-5, & + r55 = 1, r66 = 1 +A_KICKER_3: ekicker, vkick = 5E-3 +AC_KICKER3: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = 7.04361E-7, & + r55 = 1, r66 = 1 +BEAMBEAM1: beambeam, charge = -1.60218E-9, xcenter = 3E-3, ycenter = 3E-3, & + xsize = 3E-3, ysize = 3E-4 +CRAB_CAVITY1: rfdf, phase = -72, l = 0.2, voltage = 1000, frequency = 1E8 +E_KICKER_4: ekicker, hkick = 5E-3, vkick = 1E-3 +ECOLLIMATOR1: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = 1.93052E-5, & + r55 = 1, r66 = 1 +E_KICKER_5: ekicker, hkick = 2.5E-3 +ELSEPARATOR1: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = 1.40626E-5, & + r55 = 1, r66 = 1 +E_KICKER_6: ekicker, vkick = 2.5E-3 +ELSEPARATOR2: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = 1.40626E-5, & + r55 = 1, r66 = 1 +EM_FIELD1: drift, l = 1.4 +EM_FIELD2: drift, l = 1.4 +FIDUCIAL1: drift +FLOOR_SHIFT1: floor, x = 0.117176, y = 0.429109, z = 0.59532, & + theta = 0.011422, phi = 0.0423152, psi = 0.800056 +GKICKER1: malign, dx = 0.01, dy = 0.03, dz = 0.05, dxp = 0.02, & + dyp = 0.04, dp = 0.06 +HKICKER1: ehkick, l = 4.5, kick = 5E-3, tilt = 0.1, dx = 0.05 +INSTRUMENT1: moni, l = 4.5 +KICKER1: ekicker, l = 4.5, vkick = 3E-3, tilt = 0.1, dx = 0.05 +MATCH1: ematrix +MONITOR1: moni, l = 4.5 +MULTIPOLE1__1: mult, knl = 1, tilt = 0.785398, order = 1, dx = 0.05 +MULTIPOLE1__3: mult, knl = 4.5, tilt = 0.973894, order = 3, dx = 0.05 +OCTUPOLE1: koct, k3 = 1000, tilt = 0.392699, pitch = -1E-3, dx = 9.2388E-3, & + dy = 3.82683E-3, dz = -3.82683E-6, l = 4.5 +DRIFT_PATCH1: edrift, l = 4E-3 +PATCH1: malign, dx = 1E-3, dy = 2E-3, dt = 1E-11, dxp = 1E-3, dyp = 2E-3 +QMULTIPOLE_8__1: mult, knl = 0.03, tilt = -3.06162E-17, order = 1 +Q_KICKER_9: ekicker, vkick = -5E-5 +QUADRUPOLE1: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = 7.47961E-5, & + r55 = 1, r66 = 1 +QMULTIPOLE_10__1: mult, knl = -0.03, order = 1 +Q_KICKER_11: ekicker, vkick = -5E-5 +QUADRUPOLE2: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = 8.70229E-5, & + r55 = 1, r66 = 1 +QMULTIPOLE_12__1: mult, knl = 3E-22, tilt = -3.06162E-17, order = 1 +Q_KICKER_13: ekicker, vkick = -5E-5 +QUADRUPOLE3: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = -9.57925E-6, & + r55 = 1, r66 = 1 +QMULTIPOLE_14__1: mult, knl = 0.03, tilt = -3.06162E-17, order = 1 +Q_KICKER_15: ekicker, vkick = -5E-5 +QUADRUPOLE4: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = 7.53958E-5, & + r55 = 1, r66 = 1 +QMULTIPOLE_16__1: mult, knl = -0.03, order = 1 +Q_KICKER_17: ekicker, vkick = -5E-5 +QUADRUPOLE5: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = 8.76901E-5, & + r55 = 1, r66 = 1 +RCOLLIMATOR1: rcol, x_max = 0.2, dx = 0.02, y_max = 0.1 +RFCAVITY1: rfca, phase = 36, body_focus_model="SRS", standing_wave = 1, & + end1_focus=1, end2_focus=1, l = 4.5, volt = 100000, freq = 5E8 +RFCAVITY2: rfca, phase = 36, l = 4.5, volt = 100000, freq = 5E8 +RFCAVITY3: rfca, phase = 36, body_focus_model="SRS", standing_wave = 1, & + end1_focus=1, end2_focus=1, volt = 100000, freq = 5E8 +SAD_MULT1: drift, l = 0.1 +SAD_MULT2: drift +S_KICKER_18: ekicker, vkick = -5E-5 +SBEND1: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = -1.50601E-5, & + r55 = 1, r66 = 1 +S_KICKER_19: ekicker, vkick = -5E-5 +RBEND2: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = -1.94059E-5, & + r55 = 1, r66 = 1 +S_KICKER_20: ekicker, vkick = -5E-5 +SBEND3: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = -1.79032E-5, & + r55 = 1, r66 = 1 +SMULTIPOLE_21__1: mult, knl = 1.5E-6, tilt = -0.685398, order = 1 +S_KICKER_22: ekicker, hkick = 2.95517E-3, vkick = 2.46506E-4 +RBEND4: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = -2.30659E-5, & + r55 = 1, r66 = 1 +SMULTIPOLE_23__1: mult, knl = 1.5E-4, tilt = -0.685398, order = 1 +S_KICKER_24: ekicker, vkick = -5E-5 +SBEND5: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = -2.15574E-5, & + r55 = 1, r66 = 1 +SMULTIPOLE_25__1: mult, knl = 1.5E-9, tilt = -0.685398, order = 1 +S_KICKER_26: ekicker, hkick = 2.98499E-3, vkick = 2.49498E-4 +RBEND6: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = -2.3072E-5, & + r55 = 1, r66 = 1 +SMULTIPOLE_27__1: mult, knl = 1.5E-4, tilt = -0.685398, order = 1 +S_KICKER_28: ekicker, vkick = -5E-5 +SBEND7: ematrix, r11 = 1, r22 = 1, r33 = 1, r44 = 1, c5 = -2.15645E-5, & + r55 = 1, r66 = 1 +SEXTUPOLE1: ksext, malign_method = 2, k2 = 1, tilt = 0.523599, & + pitch = -1E-3, dx = 0.0433013, dy = 0.025, dz = -2.5E-5, l = 0.6 +SOLENOID1: sole, l = 2.6, ks = 1, dx = 0.05 +SOLENOID2: sole, l = 2.6, ks = 1E-12, dx = 0.05 +DRIFT_Z29: edrift, l = 1.3 +SOL_QUAD1: ematrix +DRIFT_Z30: edrift, l = 1.3 +SOL_QUAD2: ematrix +TMULTIPOLE_31__2: mult, knl = 1, tilt = -0.423599, order = 2 +TMULTIPOLE_31__3: mult, knl = 60, tilt = 0.1, order = 3 +THICK_MULTIPOLE1: drift, l = 4.5 +TAYLOR1: ematrix, c1 = -9.54885E-3, r11 = 1.00445, r11 = -0.186887, & + r12 = 8.81211, r13 = 3.15887E-6, r14 = 6.24736E-7, r14 = -4.49986E-8, & + r14 = 2.26515E-6, r14 = 0.0737887, r14 = 7.48496E-3, r15 = -7.9443E-4, & + r15 = 8.26014E-4, r16 = -1.59897E-3, r16 = -2.8822E-3, r16 = -5.81233, & + r16 = -2.26589E-6, r16 = -1.07353E-6, r16 = -2.59775E-5, & + r16 = 1.59915E-3, c2 = 2.75022E-4, r21 = 5.17076E-4, r22 = 1.0001, & + r22 = -8.24667E-4, r23 = 3.66717E-7, r23 = 0.0216962, r24 = 7.25623E-8, & + r24 = -1.66887E-8, r24 = -1.00551E-7, r24 = 8.56569E-3, r24 = 8.76072E-4, & + r25 = 1.53868E-6, r25 = 2.97087E-3, r26 = -7.74636E-8, r26 = -8.16983E-7, & + r26 = 2.88699E-8, c3 = 3.26106E-5, r32 = 5.23063E-8, r32 = 9.9263E-7, & + r33 = 1, r33 = 0.373775, r33 = 0.0737792, r34 = 0.0737176, & + r34 = 0.0145516, r35 = -8.48787E-6, r35 = -1.40995E-3, r35 = -3.0176, & + r35 = 8.41554E-6, r36 = -1.62965E-5, r36 = -2.26546E-6, r36 = -1.07041E-6, & + r36 = 2.88268E-3, r36 = -5.80943, r36 = 1.19481E-7, r42 = -7.37549E-8, & + r43 = -5.17211E-4, r44 = 0.999897, r44 = -1.64887E-8, r44 = -1.74264E-7, & + r45 = 8.33163E-9, r45 = -1.53357E-6, r45 = 2.97026E-3, r46 = -2.40618E-8, & + r46 = -7.70389E-8, r46 = -2.31499E-6, r46 = 1.02381E-4, c5 = -8.6214E-5, & + r51 = -7.97679E-7, r52 = -1.59888E-3, r53 = 7.57432E-9, r53 = -3.42794E-5, & + r54 = -2.19303E-6, r54 = -8.12886E-7, r54 = 2.88908E-3, r54 = -2.90487, & + r55 = 1, r55 = 8.04598E-7, r55 = -2.36194E-5, r55 = 1.45261E-7, & + r56 = 1.45043E-8, r56 = -7.41367E-7, c6 = -7.57023E-6, r61 = 1.22662E-6, & + r62 = 7.92211E-4, r63 = 4.24341E-9, r63 = 3.69542E-7, r63 = 1.17658E-6, & + r63 = 1.60572E-5, r64 = 8.46364E-6, r64 = 1.1766E-6, r64 = 4.78291E-7, & + r64 = 1.42032E-3, r64 = 1.50447, r65 = 5.94094E-3, r65 = -5.30024E-7, & + r66 = 1, r66 = 3.29521E-5, r66 = -4.68311E-8, l = 0.5 +VKICKER1: evkick, l = 4.5, kick = 5E-3, tilt = 0.1, dx = 0.05 +LCAVITY1: rfca, change_p0 = 1, phase = 144, body_focus_model="SRS", & + standing_wave = 1, end1_focus=1, end2_focus=1, l = 4.5, volt = 5000, & + freq = 5E8 +LCAVITY2: rfca, change_p0 = 1, phase = 144, body_focus_model="SRS", & + standing_wave = 1, end1_focus=1, end2_focus=1, l = 4.5, volt = 5, & + freq = 5E8 +LCAVITY3: rfca, change_p0 = 1, phase = 144, l = 4.5, volt = 5000, freq = 5E8 +END: mark + +! --------------------------------- + +line_1: line = (AB_MULTIPOLE1, AB_MULTIPOLE1__2, A_KICKER_1, AC_KICKER1, & + A_KICKER_1, A_KICKER_2, AC_KICKER2, A_KICKER_2, A_KICKER_3, AC_KICKER3, & + A_KICKER_3, BEAMBEAM1, CRAB_CAVITY1, E_KICKER_4, ECOLLIMATOR1, E_KICKER_4, & + E_KICKER_5, ELSEPARATOR1, E_KICKER_5, E_KICKER_6, ELSEPARATOR2, E_KICKER_6, & + EM_FIELD1, EM_FIELD2, FIDUCIAL1, FLOOR_SHIFT1, GKICKER1, HKICKER1, & + INSTRUMENT1, KMULTIPOLE_7, KICKER1, KMULTIPOLE_7, MATCH1, MONITOR1, & + MULTIPOLE1, MULTIPOLE1__1, MULTIPOLE1__3, OCTUPOLE1, DRIFT_PATCH1, PATCH1, PATCH1_rot, & + QMULTIPOLE_8, QMULTIPOLE_8__1, Q_KICKER_9, QUADRUPOLE1, Q_KICKER_9, & + QMULTIPOLE_8, QMULTIPOLE_10, QMULTIPOLE_10__1, Q_KICKER_11, QUADRUPOLE2, & + Q_KICKER_11, QMULTIPOLE_10, QMULTIPOLE_12, QMULTIPOLE_12__1, Q_KICKER_13, & + QUADRUPOLE3, Q_KICKER_13, QMULTIPOLE_12, QMULTIPOLE_14, QMULTIPOLE_14__1, & + Q_KICKER_15, QUADRUPOLE4, Q_KICKER_15, QMULTIPOLE_14, QMULTIPOLE_16, & + QMULTIPOLE_16__1, Q_KICKER_17, QUADRUPOLE5, Q_KICKER_17, QMULTIPOLE_16, & + RCOLLIMATOR1, RFCAVITY1, RFCAVITY2, RFCAVITY3, SAD_MULT1, SAD_MULT2, & + S_KICKER_18, SBEND1, S_KICKER_18, S_KICKER_19, RBEND2, S_KICKER_19, & + S_KICKER_20, SBEND3, S_KICKER_20, SMULTIPOLE_21, SMULTIPOLE_21__1, & + S_KICKER_22, RBEND4, S_KICKER_22, SMULTIPOLE_21, SMULTIPOLE_23, & + SMULTIPOLE_23__1, S_KICKER_24, SBEND5, S_KICKER_24, SMULTIPOLE_23, & + SMULTIPOLE_25, SMULTIPOLE_25__1, S_KICKER_26, RBEND6, S_KICKER_26, & + SMULTIPOLE_25, SMULTIPOLE_27, SMULTIPOLE_27__1, S_KICKER_28, SBEND7, & + S_KICKER_28, SMULTIPOLE_27, SEXTUPOLE1, SOLENOID1, SOLENOID2, DRIFT_Z29, & + SOL_QUAD1, DRIFT_Z29, DRIFT_Z30, SOL_QUAD2, DRIFT_Z30, TMULTIPOLE_31, & + TMULTIPOLE_31__2, TMULTIPOLE_31__3, THICK_MULTIPOLE1, TMULTIPOLE_31, & + TAYLOR1, VKICKER1, LCAVITY1, LCAVITY2, LCAVITY3, END) + +! --------------------------------- + +lat: line = (line_1) diff --git a/regression_tests/write_foreign_test/write_foreign_test.mad8.correct b/regression_tests/write_foreign_test/write_foreign_test.mad8.correct new file mode 100644 index 0000000000..817e486a0f --- /dev/null +++ b/regression_tests/write_foreign_test/write_foreign_test.mad8.correct @@ -0,0 +1,312 @@ +! File generated by: write_lattice_in_mad_format +! Bmad Lattice File: /nfs/acc/user/dcs16/bmad-ecosystem/regression_tests/write_foreign_test/write_foreign_test.bmad + +beam_def: Beam, Particle = Positron, Energy = 1E-3, Npart = 1E10 + +AB_MULTIPOLE1: multipole, K2L = 282.843, T2 = -0.161799 +A_KICKER_1: kicker, l = 0, hkick = 5E-3 +AC_KICKER1: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4, & + 4) = 1, rm(5,5) = 1, kick(5) = 3.0375E-8, rm(6,6) = 1 +A_KICKER_2: kicker, l = 0, vkick = 5E-3 +AC_KICKER2: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4, & + 4) = 1, rm(5,5) = 1, kick(5) = 1.9869E-5, rm(6,6) = 1 +A_KICKER_3: kicker, l = 0, vkick = 5E-3 +AC_KICKER3: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4, & + 4) = 1, rm(5,5) = 1, kick(5) = 7.04361E-7, rm(6,6) = 1 +BEAMBEAM1: beambeam, sigx = 3E-3, sigy = 3E-4, xma = 3E-3, yma = 3E-3, & + charge = -1 +CRAB_CAVITY1: drift, l = 0.2 +E_KICKER_4: kicker, l = 0, hkick = 5E-3, vkick = 1E-3 +ECOLLIMATOR1: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4, & + 4) = 1, rm(5,5) = 1, kick(5) = 1.93052E-5, rm(6,6) = 1 +E_KICKER_5: kicker, l = 0, hkick = 2.5E-3 +ELSEPARATOR1: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4, & + 4) = 1, rm(5,5) = 1, kick(5) = 1.40626E-5, rm(6,6) = 1 +E_KICKER_6: kicker, l = 0, vkick = 2.5E-3 +ELSEPARATOR2: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4, & + 4) = 1, rm(5,5) = 1, kick(5) = 1.40626E-5, rm(6,6) = 1 +EM_FIELD1: drift, l = 1.4 +EM_FIELD2: drift, l = 1.4 +FIDUCIAL1: drift, l = 0 +FLOOR_SHIFT1: drift, l = 0 +GKICKER1: drift, l = 0 +HKICKER1: hkicker, l = 4.5, kick = 5E-3, tilt = 0.1 +INSTRUMENT1: drift, l = 4.5 +KMULTIPOLE_7: multipole, K0L = 3E-6, T0 = 0.1 +KICKER1: kicker, l = 4.5, vkick = 3E-3, tilt = 0.1 +MATCH1: matrix +MONITOR1: drift, l = 4.5 +MULTIPOLE1: multipole, K1L = 1, T1 = 0.785398, K3L = 4.5, T3 = 0.973894 +OCTUPOLE1: octupole, l = 4.5, k3 = 1000, tilt = 0.392699 +DRIFT_PATCH1: drift, l = 4E-3 +QMULTIPOLE_8: multipole, K0L = 3E-3, T0 = -0.785398, K1L = 0.03, & + T1 = -3.06162E-17 +Q_KICKER_9: kicker, l = 0, vkick = -5E-5 +QUADRUPOLE1: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4, & + 4) = 1, rm(5,5) = 1, kick(5) = 7.47961E-5, rm(6,6) = 1 +QMULTIPOLE_10: multipole, K0L = -3E-3, T0 = -0.785398, K1L = -0.03 +Q_KICKER_11: kicker, l = 0, vkick = -5E-5 +QUADRUPOLE2: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4, & + 4) = 1, rm(5,5) = 1, kick(5) = 8.70229E-5, rm(6,6) = 1 +QMULTIPOLE_12: multipole, K0L = 3E-23, T0 = -0.785398, K1L = 3E-22, & + T1 = -3.06162E-17 +Q_KICKER_13: kicker, l = 0, vkick = -5E-5 +QUADRUPOLE3: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4, & + 4) = 1, rm(5,5) = 1, kick(5) = -9.57925E-6, rm(6,6) = 1 +QMULTIPOLE_14: multipole, K0L = 3E-3, T0 = -0.785398, K1L = 0.03, & + T1 = -3.06162E-17 +Q_KICKER_15: kicker, l = 0, vkick = -5E-5 +QUADRUPOLE4: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4, & + 4) = 1, rm(5,5) = 1, kick(5) = 7.53958E-5, rm(6,6) = 1 +QMULTIPOLE_16: multipole, K0L = -3E-3, T0 = -0.785398, K1L = -0.03 +Q_KICKER_17: kicker, l = 0, vkick = -5E-5 +QUADRUPOLE5: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4, & + 4) = 1, rm(5,5) = 1, kick(5) = 8.76901E-5, rm(6,6) = 1 +RCOLLIMATOR1: RCollimator, l = 4.5, xsize = 0.2, ysize = 0.1 +RFCAVITY1: rfcavity, l = 4.5, volt = 0.1, lag = 0.6, harmon = 184 +RFCAVITY2: rfcavity, l = 4.5, volt = 0.1, lag = 0.6, harmon = 184 +RFCAVITY3: rfcavity, l = 0, volt = 0.1, lag = 0.6, harmon = 184 +S_KICKER_18: kicker, l = 0, vkick = -5E-5 +SBEND1: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4,4) = 1, & + rm(5,5) = 1, kick(5) = -1.50601E-5, rm(6,6) = 1 +S_KICKER_19: kicker, l = 0, vkick = -5E-5 +RBEND2: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4,4) = 1, & + rm(5,5) = 1, kick(5) = -1.94059E-5, rm(6,6) = 1 +S_KICKER_20: kicker, l = 0, vkick = -5E-5 +SBEND3: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4,4) = 1, & + rm(5,5) = 1, kick(5) = -1.79032E-5, rm(6,6) = 1 +SMULTIPOLE_21: multipole, K0L = 3E-7, T0 = -1.4708, K1L = 1.5E-6, & + T1 = -0.685398 +S_KICKER_22: kicker, l = 0, hkick = 2.95517E-3, vkick = 2.46506E-4 +RBEND4: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4,4) = 1, & + rm(5,5) = 1, kick(5) = -2.30659E-5, rm(6,6) = 1 +SMULTIPOLE_23: multipole, K0L = 3E-5, T0 = -1.4708, K1L = 1.5E-4, & + T1 = -0.685398 +S_KICKER_24: kicker, l = 0, vkick = -5E-5 +SBEND5: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4,4) = 1, & + rm(5,5) = 1, kick(5) = -2.15574E-5, rm(6,6) = 1 +SMULTIPOLE_25: multipole, K0L = 3E-10, T0 = -1.4708, K1L = 1.5E-9, & + T1 = -0.685398 +S_KICKER_26: kicker, l = 0, hkick = 2.98499E-3, vkick = 2.49498E-4 +RBEND6: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4,4) = 1, & + rm(5,5) = 1, kick(5) = -2.3072E-5, rm(6,6) = 1 +SMULTIPOLE_27: multipole, K0L = 3E-5, T0 = -1.4708, K1L = 1.5E-4, & + T1 = -0.685398 +S_KICKER_28: kicker, l = 0, vkick = -5E-5 +SBEND7: matrix, rm(1,1) = 1, rm(2,2) = 1, rm(3,3) = 1, rm(4,4) = 1, & + rm(5,5) = 1, kick(5) = -2.15645E-5, rm(6,6) = 1 +SEXTUPOLE1: sextupole, l = 0.6, k2 = 1, tilt = 0.523599 +SOLENOID1: solenoid, l = 2.6, ks = 1 +SOLENOID2: solenoid, l = 2.6, ks = 1E-12 +DRIFT_Z29: drift, l = 1.3 +SOL_QUAD1: matrix +DRIFT_Z30: drift, l = 1.3 +SOL_QUAD2: matrix +TMULTIPOLE_31: multipole, K2L = 1, T2 = -0.423599, K3L = 60, T3 = 0.1 +THICK_MULTIPOLE1: drift, l = 4.5 +TAYLOR1: matrix, l = 0.5, rm(1,1) = 1.00445, kick(1) = -9.54885E-3, & + rm(1,2) = 8.81211, rm(1,3) = 3.15887E-6, rm(1,4) = 6.24736E-7, & + rm(1,5) = -7.9443E-4, rm(1,6) = -1.59897E-3, tm(1,1,1) = -0.186887, & + tm(1,1,4) = -4.49986E-8, tm(1,2,4) = 2.26515E-6, tm(1,3, & + 4) = 0.0737887, tm(1,4,4) = 7.48496E-3, tm(1,5,5) = 8.26014E-4, & + tm(1,1,6) = -2.8822E-3, tm(1,2,6) = -5.81233, tm(1,3,6) = -2.26589E-6, & + tm(1,4,6) = -1.07353E-6, tm(1,5,6) = -2.59775E-5, tm(1,6, & + 6) = 1.59915E-3, rm(2,2) = 1.0001, kick(2) = 2.75022E-4, rm(2, & + 1) = 5.17076E-4, rm(2,3) = 3.66717E-7, rm(2,4) = 7.25623E-8, & + tm(2,2,2) = -8.24667E-4, tm(2,3,3) = 0.0216962, tm(2,1,4) = -1.66887E-8, & + tm(2,2,4) = -1.00551E-7, tm(2,3,4) = 8.56569E-3, tm(2,4, & + 4) = 8.76072E-4, tm(2,1,5) = 1.53868E-6, tm(2,2,5) = 2.97087E-3, & + tm(2,4,6) = -7.74636E-8, tm(2,5,6) = -8.16983E-7, tm(2,6, & + 6) = 2.88699E-8, rm(3,3) = 1, kick(3) = 3.26106E-5, rm(3, & + 5) = -8.48787E-6, rm(3,6) = -1.62965E-5, tm(3,1,2) = 5.23063E-8, & + tm(3,2,2) = 9.9263E-7, tm(3,1,3) = 0.373775, tm(3,2,3) = 0.0737792, & + tm(3,1,4) = 0.0737176, tm(3,2,4) = 0.0145516, tm(3,3,5) = -1.40995E-3, & + tm(3,4,5) = -3.0176, tm(3,5,5) = 8.41554E-6, tm(3,1,6) = -2.26546E-6, & + tm(3,2,6) = -1.07041E-6, tm(3,3,6) = 2.88268E-3, tm(3,4, & + 6) = -5.80943, tm(3,5,6) = 1.19481E-7, rm(4,4) = 0.999897, & + rm(4,3) = -5.17211E-4, rm(4,5) = 8.33163E-9, tm(4,2,2) = -7.37549E-8, & + tm(4,3,4) = -1.64887E-8, tm(4,4,4) = -1.74264E-7, tm(4,3, & + 5) = -1.53357E-6, tm(4,4,5) = 2.97026E-3, tm(4,1,6) = -2.40618E-8, & + tm(4,2,6) = -7.70389E-8, tm(4,3,6) = -2.31499E-6, tm(4,4, & + 6) = 1.02381E-4, rm(5,5) = 1, kick(5) = -8.6214E-5, rm(5, & + 1) = -7.97679E-7, rm(5,2) = -1.59888E-3, rm(5,3) = 7.57432E-9, & + tm(5,3,3) = -3.42794E-5, tm(5,1,4) = -2.19303E-6, tm(5,2, & + 4) = -8.12886E-7, tm(5,3,4) = 2.88908E-3, tm(5,4,4) = -2.90487, & + tm(5,1,5) = 8.04598E-7, tm(5,2,5) = -2.36194E-5, tm(5,4, & + 5) = 1.45261E-7, tm(5,5,6) = 1.45043E-8, tm(5,6,6) = -7.41367E-7, & + rm(6,6) = 1, kick(6) = -7.57023E-6, rm(6,1) = 1.22662E-6, & + rm(6,2) = 7.92211E-4, rm(6,3) = 4.24341E-9, rm(6,4) = 8.46364E-6, & + rm(6,5) = 5.94094E-3, tm(6,1,3) = 3.69542E-7, tm(6,2,3) = 1.17658E-6, & + tm(6,3,3) = 1.60572E-5, tm(6,1,4) = 1.1766E-6, tm(6,2,4) = 4.78291E-7, & + tm(6,3,4) = 1.42032E-3, tm(6,4,4) = 1.50447, tm(6,1,5) = -5.30024E-7, & + tm(6,2,6) = 3.29521E-5, tm(6,4,6) = -4.68311E-8 +VKICKER1: vkicker, l = 4.5, kick = 5E-3, tilt = 0.1 +LCAVITY1: lcavity, l = 4.5, deltae = 5E-3, freq = 500, phi0 = 0.15, swave +LCAVITY2: lcavity, l = 4.5, deltae = 5E-6, freq = 500, phi0 = 0.15, swave +LCAVITY3: lcavity, l = 4.5, deltae = 5E-3, freq = 500, phi0 = 0.15 +END: marker + +! --------------------------------- + +line_1: line = (AB_MULTIPOLE1, A_KICKER_1, AC_KICKER1, A_KICKER_1, A_KICKER_2, & + AC_KICKER2, A_KICKER_2, A_KICKER_3, AC_KICKER3, A_KICKER_3, BEAMBEAM1, & + CRAB_CAVITY1, E_KICKER_4, ECOLLIMATOR1, E_KICKER_4, E_KICKER_5, & + ELSEPARATOR1, E_KICKER_5, E_KICKER_6, ELSEPARATOR2, E_KICKER_6, EM_FIELD1, & + EM_FIELD2, FIDUCIAL1, FLOOR_SHIFT1, GKICKER1, HKICKER1, INSTRUMENT1, & + KMULTIPOLE_7, KICKER1, KMULTIPOLE_7, MATCH1, MONITOR1, MULTIPOLE1, & + OCTUPOLE1, DRIFT_PATCH1, PATCH1, QMULTIPOLE_8, Q_KICKER_9, QUADRUPOLE1, & + Q_KICKER_9, QMULTIPOLE_8, QMULTIPOLE_10, Q_KICKER_11, QUADRUPOLE2, & + Q_KICKER_11, QMULTIPOLE_10, QMULTIPOLE_12, Q_KICKER_13, QUADRUPOLE3, & + Q_KICKER_13, QMULTIPOLE_12, QMULTIPOLE_14, Q_KICKER_15, QUADRUPOLE4, & + Q_KICKER_15, QMULTIPOLE_14, QMULTIPOLE_16, Q_KICKER_17, QUADRUPOLE5, & + Q_KICKER_17, QMULTIPOLE_16, RCOLLIMATOR1, RFCAVITY1, RFCAVITY2, RFCAVITY3, & + SAD_MULT1, SAD_MULT2, S_KICKER_18, SBEND1, S_KICKER_18, S_KICKER_19, & + RBEND2, S_KICKER_19, S_KICKER_20, SBEND3, S_KICKER_20, SMULTIPOLE_21, & + S_KICKER_22, RBEND4, S_KICKER_22, SMULTIPOLE_21, SMULTIPOLE_23, & + S_KICKER_24, SBEND5, S_KICKER_24, SMULTIPOLE_23, SMULTIPOLE_25, & + S_KICKER_26, RBEND6, S_KICKER_26, SMULTIPOLE_25, SMULTIPOLE_27, & + S_KICKER_28, SBEND7, S_KICKER_28, SMULTIPOLE_27, SEXTUPOLE1, SOLENOID1, & + SOLENOID2, DRIFT_Z29, SOL_QUAD1, DRIFT_Z29, DRIFT_Z30, SOL_QUAD2, & + DRIFT_Z30, TMULTIPOLE_31, THICK_MULTIPOLE1, TMULTIPOLE_31, TAYLOR1, & + VKICKER1, LCAVITY1, LCAVITY2, LCAVITY3, END) + +! --------------------------------- + +lat: line = (line_1) + +! --------------------------------- + +select, flag = error, clear +select, flag = error, range = AB_MULTIPOLE1[1] +ealign, dx = 0.02 +select, flag = error, clear +select, flag = error, range = BEAMBEAM1[1] +ealign, dphi = -0.05, dx = 3E-3, dy = 3E-3 +select, flag = error, clear +select, flag = error, range = ECOLLIMATOR1[1] +ealign, dphi = -1E-3, dx = 0.02, dy = -2.25E-3 +select, flag = error, clear +select, flag = error, range = ELSEPARATOR1[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3 +select, flag = error, clear +select, flag = error, range = ELSEPARATOR2[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3 +select, flag = error, clear +select, flag = error, range = FLOOR_SHIFT1[1] +ealign, dtheta = 0.01, dphi = -0.02, dx = 0.1, dy = 0.2, ds = 0.3 +select, flag = error, clear +select, flag = error, range = GKICKER1[1] +ealign, dtheta = 0.02, dphi = -0.03, dx = 0.04, dy = 0.05, ds = 0.06 +select, flag = error, clear +select, flag = error, range = HKICKER1[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3 +select, flag = error, clear +select, flag = error, range = KICKER1[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3 +select, flag = error, clear +select, flag = error, range = MULTIPOLE1[1] +ealign, dx = 0.05 +select, flag = error, clear +select, flag = error, range = OCTUPOLE1[1] +ealign, dphi = -1E-3, dx = 0.01, dy = -2.25E-3 +select, flag = error, clear +select, flag = error, range = DRIFT_PATCH1[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -2E-6 +select, flag = error, clear +select, flag = error, range = QUADRUPOLE1[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4 +select, flag = error, clear +select, flag = error, range = QUADRUPOLE2[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4 +select, flag = error, clear +select, flag = error, range = QUADRUPOLE3[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4 +select, flag = error, clear +select, flag = error, range = QUADRUPOLE4[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4 +select, flag = error, clear +select, flag = error, range = QUADRUPOLE5[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4 +select, flag = error, clear +select, flag = error, range = RCOLLIMATOR1[1] +ealign, dphi = -1E-3, dx = 0.02, dy = -2.25E-3 +select, flag = error, clear +select, flag = error, range = RFCAVITY1[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3 +select, flag = error, clear +select, flag = error, range = RFCAVITY2[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3 +select, flag = error, clear +select, flag = error, range = RFCAVITY3[1] +ealign, dphi = -1E-3, dx = 0.05 +select, flag = error, clear +select, flag = error, range = SBEND1[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4 +select, flag = error, clear +select, flag = error, range = RBEND2[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4 +select, flag = error, clear +select, flag = error, range = SBEND3[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4 +select, flag = error, clear +select, flag = error, range = RBEND4[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4 +select, flag = error, clear +select, flag = error, range = SBEND5[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4 +select, flag = error, clear +select, flag = error, range = RBEND6[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4 +select, flag = error, clear +select, flag = error, range = SBEND7[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4 +select, flag = error, clear +select, flag = error, range = SEXTUPOLE1[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4 +select, flag = error, clear +select, flag = error, range = SOLENOID1[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -1.3E-3 +select, flag = error, clear +select, flag = error, range = SOLENOID2[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -1.3E-3 +select, flag = error, clear +select, flag = error, range = SOL_QUAD1[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -1.3E-3 +select, flag = error, clear +select, flag = error, range = DRIFT_Z29[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -6.5E-4 +select, flag = error, clear +select, flag = error, range = DRIFT_Z29[2] +ealign, dphi = -1E-3, dx = 0.05, dy = -6.5E-4 +select, flag = error, clear +select, flag = error, range = SOL_QUAD2[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -1.3E-3 +select, flag = error, clear +select, flag = error, range = DRIFT_Z30[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -6.5E-4 +select, flag = error, clear +select, flag = error, range = DRIFT_Z30[2] +ealign, dphi = -1E-3, dx = 0.05, dy = -6.5E-4 +select, flag = error, clear +select, flag = error, range = THICK_MULTIPOLE1[1] +ealign, dx = 0.02 +select, flag = error, clear +select, flag = error, range = VKICKER1[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3 +select, flag = error, clear +select, flag = error, range = LCAVITY1[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3 +select, flag = error, clear +select, flag = error, range = LCAVITY2[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3 +select, flag = error, clear +select, flag = error, range = LCAVITY3[1] +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3 + +! --------------------------------- + +initial: beta0, betx = 10, bety = 10, alfx = 0, alfy = 0, & + dx = 0, dpx = 0, dy = 0, dpy = 0, & + x = 1E-3, px = 2E-3, y = 3E-3, py = 4E-3, t = 4.29791E-3, pt = 6.98014E-3 + +twiss, beta0 = initial; diff --git a/regression_tests/write_foreign_test/write_foreign_test.madx.correct b/regression_tests/write_foreign_test/write_foreign_test.madx.correct new file mode 100644 index 0000000000..a8cf75a5ad --- /dev/null +++ b/regression_tests/write_foreign_test/write_foreign_test.madx.correct @@ -0,0 +1,280 @@ +// File generated by: write_lattice_in_mad_format; +// Bmad Lattice File: /nfs/acc/user/dcs16/bmad-ecosystem/regression_tests/write_foreign_test/write_foreign_test.bmad; + +beam_def: Beam, Particle = Positron, Energy = 1E-3, Npart = 1E10;; + +AB_MULTIPOLE1: multipole, knl = {0, 0, 250.171}, ksl = {0, 0, -131.963}; +A_KICKER_1: kicker, l = 0, hkick = 5E-3; +AC_KICKER1: matrix, rm11 = 1, rm22 = 1, rm33 = 1, rm44 = 1, rm55 = 1, kick5 = 3.0375E-8, rm66 = 1; +A_KICKER_2: kicker, l = 0, vkick = 5E-3; +AC_KICKER2: matrix, rm11 = 1, rm22 = 1, rm33 = 1, rm44 = 1, rm55 = 1, kick5 = 1.9869E-5, rm66 = 1; +A_KICKER_3: kicker, l = 0, vkick = 5E-3; +AC_KICKER3: matrix, rm11 = 1, rm22 = 1, rm33 = 1, rm44 = 1, rm55 = 1, kick5 = 7.04361E-7, rm66 = 1; +BEAMBEAM1: beambeam, sigx = 3E-3, sigy = 3E-4, xma = 3E-3, yma = 3E-3, charge = -1; +CRAB_CAVITY1: drift, l = 0.2; +E_KICKER_4: kicker, l = 0, hkick = 5E-3, vkick = 1E-3; +ECOLLIMATOR1: matrix, rm11 = 1, rm22 = 1, rm33 = 1, rm44 = 1, rm55 = 1, kick5 = 1.93052E-5, + rm66 = 1; +E_KICKER_5: kicker, l = 0, hkick = 2.5E-3; +ELSEPARATOR1: matrix, rm11 = 1, rm22 = 1, rm33 = 1, rm44 = 1, rm55 = 1, kick5 = 1.40626E-5, + rm66 = 1; +E_KICKER_6: kicker, l = 0, vkick = 2.5E-3; +ELSEPARATOR2: matrix, rm11 = 1, rm22 = 1, rm33 = 1, rm44 = 1, rm55 = 1, kick5 = 1.40626E-5, + rm66 = 1; +EM_FIELD1: drift, l = 1.4; +EM_FIELD2: drift, l = 1.4; +FIDUCIAL1: drift, l = 0; +FLOOR_SHIFT1: drift, l = 0; +GKICKER1: drift, l = 0; +HKICKER1: hkicker, l = 4.5, kick = 5E-3, tilt = 0.1; +INSTRUMENT1: drift, l = 4.5; +KMULTIPOLE_7: multipole, knl = {2.98501E-6}, ksl = {2.995E-7}; +KICKER1: kicker, l = 4.5, vkick = 3E-3, tilt = 0.1; +MATCH1: matrix; +MONITOR1: drift, l = 4.5; +MULTIPOLE1: multipole, knl = {0, 0, 0, -3.28036}, ksl = {0, 1, 0, -3.08046}; +OCTUPOLE1: octupole, l = 4.5, k3 = 1000, tilt = 0.392699; +DRIFT_PATCH1: drift, l = 4E-3; +PATCH1__t: translation, dx = 1E-3, dy = 2E-3; +PATCH1__y: yrotation, angle = -1E-3; +PATCH1__x: xrotation, angle = -2E-3; +PATCH1__s: srotation, angle = 2; +QMULTIPOLE_8: multipole, knl = {2.12132E-3, 0.03}, ksl = {-2.12132E-3, 0}; +Q_KICKER_9: kicker, l = 0, vkick = -5E-5; +QUADRUPOLE1: matrix, rm11 = 1, rm22 = 1, rm33 = 1, rm44 = 1, rm55 = 1, kick5 = 7.47961E-5, rm66 = 1; +QMULTIPOLE_10: multipole, knl = {-2.12132E-3, -0.03}, ksl = {2.12132E-3, 0}; +Q_KICKER_11: kicker, l = 0, vkick = -5E-5; +QUADRUPOLE2: matrix, rm11 = 1, rm22 = 1, rm33 = 1, rm44 = 1, rm55 = 1, kick5 = 8.70229E-5, rm66 = 1; +QMULTIPOLE_12: multipole, knl = {2.12132E-23, 3E-22}, ksl = {-2.12132E-23, 0}; +Q_KICKER_13: kicker, l = 0, vkick = -5E-5; +QUADRUPOLE3: matrix, rm11 = 1, rm22 = 1, rm33 = 1, rm44 = 1, rm55 = 1, kick5 = -9.57925E-6, + rm66 = 1; +QMULTIPOLE_14: multipole, knl = {2.12132E-3, 0.03}, ksl = {-2.12132E-3, 0}; +Q_KICKER_15: kicker, l = 0, vkick = -5E-5; +QUADRUPOLE4: matrix, rm11 = 1, rm22 = 1, rm33 = 1, rm44 = 1, rm55 = 1, kick5 = 7.53958E-5, rm66 = 1; +QMULTIPOLE_16: multipole, knl = {-2.12132E-3, -0.03}, ksl = {2.12132E-3, 0}; +Q_KICKER_17: kicker, l = 0, vkick = -5E-5; +QUADRUPOLE5: matrix, rm11 = 1, rm22 = 1, rm33 = 1, rm44 = 1, rm55 = 1, kick5 = 8.76901E-5, rm66 = 1; +RCOLLIMATOR1: collimator, l = 4.5, apertype = rectangle, aperture = {0.2, 0.1}; +RFCAVITY1: rfcavity, l = 4.5, volt = 0.1, lag = 0.6, harmon = 184; +RFCAVITY2: rfcavity, l = 4.5, volt = 0.1, lag = 0.6, harmon = 184; +RFCAVITY3: rfcavity, l = 0, volt = 0.1, lag = 0.6, harmon = 184; +SBEND1: sbend, l = 0.6, k1 = 0.3, tilt = 0.1, k0 = 1.66389E-5, k0s = -1.65834E-4; +RBEND2: sbend, l = 0.6, tilt = 0.1, k0 = 1.66389E-5, k0s = -1.65834E-4; +SBEND3: sbend, l = 0.6, k1 = 0.3, tilt = 0.1, k0 = 1.66389E-5, k0s = -1.65834E-4; +SMULTIPOLE_18: multipole, knl = {2.99501E-8, 2.98004E-7}, ksl = {-2.98502E-7, -1.4701E-6}; +RBEND4: sbend, l = 0.600001, angle = 6.00001E-3, e1 = 0.103, e2 = 0.203, tilt = 0.1, + k0 = -0.0197834, k0s = -1.65834E-4; +SMULTIPOLE_19: multipole, knl = {2.995E-6, 2.98004E-5}, ksl = {-2.98501E-5, -1.4701E-4}; +SBEND5: sbend, l = 0.6, angle = 6E-3, e1 = 0.1, e2 = 0.2, tilt = 0.1, fint = 0.7, + fintx = 0.7, hgap = 2, k0 = 1.66389E-5, k0s = -1.65834E-4; +SMULTIPOLE_20: multipole, knl = {2.99501E-11, 2.98004E-10}, ksl = {-2.98502E-10, -1.4701E-9}; +RBEND6: sbend, l = 0.600001, angle = 6.00001E-3, e1 = 0.103, e2 = 0.203, tilt = 0.1, + k0 = -0.0199832, k0s = -1.65834E-4; +SMULTIPOLE_21: multipole, knl = {2.995E-6, 2.98004E-5}, ksl = {-2.98501E-5, -1.4701E-4}; +SBEND7: sbend, l = 0.6, angle = 6E-3, e1 = 0.1, e2 = 0.2, tilt = 0.1, k0 = 1.66389E-5, + k0s = -1.65834E-4; +SEXTUPOLE1: sextupole, l = 0.6, k2 = 1, tilt = 0.523599; +SOLENOID1: solenoid, l = 2.6, ks = 1; +SOLENOID2: solenoid, l = 2.6, ks = 1E-12; +DRIFT_Z22: drift, l = 1.3; +SOL_QUAD1: matrix; +DRIFT_Z23: drift, l = 1.3; +SOL_QUAD2: matrix; +TMULTIPOLE_24: multipole, knl = {0, 0, 0.29552, 55.2637}, ksl = {0, 0, -0.955336, 23.3651}; +THICK_MULTIPOLE1: drift, l = 4.5; +TAYLOR1: matrix, l = 0.5, rm11 = 1.00445, kick1 = -9.54885E-3, rm12 = 8.81211, rm13 = 3.15887E-6, + rm14 = 6.24736E-7, rm15 = -7.9443E-4, rm16 = -1.59897E-3, tm111 = -0.186887, + tm114 = -4.49986E-8, tm124 = 2.26515E-6, tm134 = 0.0737887, tm144 = 7.48496E-3, + tm155 = 8.26014E-4, tm116 = -2.8822E-3, tm126 = -5.81233, tm136 = -2.26589E-6, + tm146 = -1.07353E-6, tm156 = -2.59775E-5, tm166 = 1.59915E-3, rm22 = 1.0001, + kick2 = 2.75022E-4, rm21 = 5.17076E-4, rm23 = 3.66717E-7, rm24 = 7.25623E-8, + tm222 = -8.24667E-4, tm233 = 0.0216962, tm214 = -1.66887E-8, tm224 = -1.00551E-7, + tm234 = 8.56569E-3, tm244 = 8.76072E-4, tm215 = 1.53868E-6, tm225 = 2.97087E-3, + tm246 = -7.74636E-8, tm256 = -8.16983E-7, tm266 = 2.88699E-8, rm33 = 1, kick3 = 3.26106E-5, + rm35 = -8.48787E-6, rm36 = -1.62965E-5, tm312 = 5.23063E-8, tm322 = 9.9263E-7, + tm313 = 0.373775, tm323 = 0.0737792, tm314 = 0.0737176, tm324 = 0.0145516, tm335 = + -1.40995E-3, tm345 = -3.0176, tm355 = 8.41554E-6, tm316 = -2.26546E-6, tm326 = -1.07041E-6, + tm336 = 2.88268E-3, tm346 = -5.80943, tm356 = 1.19481E-7, rm44 = 0.999897, rm43 = -5.17211E-4, + rm45 = 8.33163E-9, tm422 = -7.37549E-8, tm434 = -1.64887E-8, tm444 = -1.74264E-7, + tm435 = -1.53357E-6, tm445 = 2.97026E-3, tm416 = -2.40618E-8, tm426 = -7.70389E-8, + tm436 = -2.31499E-6, tm446 = 1.02381E-4, rm55 = 1, kick5 = -8.6214E-5, rm51 = -7.97679E-7, + rm52 = -1.59888E-3, rm53 = 7.57432E-9, tm533 = -3.42794E-5, tm514 = -2.19303E-6, + tm524 = -8.12886E-7, tm534 = 2.88908E-3, tm544 = -2.90487, tm515 = 8.04598E-7, + tm525 = -2.36194E-5, tm545 = 1.45261E-7, tm556 = 1.45043E-8, tm566 = -7.41367E-7, + rm66 = 1, kick6 = -7.57023E-6, rm61 = 1.22662E-6, rm62 = 7.92211E-4, rm63 = 4.24341E-9, + rm64 = 8.46364E-6, rm65 = 5.94094E-3, tm613 = 3.69542E-7, tm623 = 1.17658E-6, + tm633 = 1.60572E-5, tm614 = 1.1766E-6, tm624 = 4.78291E-7, tm634 = 1.42032E-3, + tm644 = 1.50447, tm615 = -5.30024E-7, tm626 = 3.29521E-5, tm646 = -4.68311E-8; +VKICKER1: vkicker, l = 4.5, kick = 5E-3, tilt = 0.1; +LCAVITY1: lcavity, l = 4.5, deltae = 5E-3, freq = 500, phi0 = 0.15; +LCAVITY2: lcavity, l = 4.5, deltae = 5E-6, freq = 500, phi0 = 0.15; +LCAVITY3: lcavity, l = 4.5, deltae = 5E-3, freq = 500, phi0 = 0.15; +END: marker; + +//---------------------------------; + +line_1: line = (AB_MULTIPOLE1, A_KICKER_1, AC_KICKER1, A_KICKER_1, A_KICKER_2, + AC_KICKER2, A_KICKER_2, A_KICKER_3, AC_KICKER3, A_KICKER_3, BEAMBEAM1, + CRAB_CAVITY1, E_KICKER_4, ECOLLIMATOR1, E_KICKER_4, E_KICKER_5, + ELSEPARATOR1, E_KICKER_5, E_KICKER_6, ELSEPARATOR2, E_KICKER_6, EM_FIELD1, + EM_FIELD2, FIDUCIAL1, FLOOR_SHIFT1, GKICKER1, HKICKER1, INSTRUMENT1, + KMULTIPOLE_7, KICKER1, KMULTIPOLE_7, MATCH1, MONITOR1, MULTIPOLE1, + OCTUPOLE1, DRIFT_PATCH1, PATCH1__T, PATCH1__Y, PATCH1__X, PATCH1__S, + QMULTIPOLE_8, Q_KICKER_9, QUADRUPOLE1, Q_KICKER_9, QMULTIPOLE_8, + QMULTIPOLE_10, Q_KICKER_11, QUADRUPOLE2, Q_KICKER_11, QMULTIPOLE_10, + QMULTIPOLE_12, Q_KICKER_13, QUADRUPOLE3, Q_KICKER_13, QMULTIPOLE_12, + QMULTIPOLE_14, Q_KICKER_15, QUADRUPOLE4, Q_KICKER_15, QMULTIPOLE_14, + QMULTIPOLE_16, Q_KICKER_17, QUADRUPOLE5, Q_KICKER_17, QMULTIPOLE_16, + RCOLLIMATOR1, RFCAVITY1, RFCAVITY2, RFCAVITY3, SAD_MULT1, SAD_MULT2, + SBEND1, RBEND2, SBEND3, SMULTIPOLE_18, RBEND4, SMULTIPOLE_18, + SMULTIPOLE_19, SBEND5, SMULTIPOLE_19, SMULTIPOLE_20, RBEND6, SMULTIPOLE_20, + SMULTIPOLE_21, SBEND7, SMULTIPOLE_21, SEXTUPOLE1, SOLENOID1, SOLENOID2, + DRIFT_Z22, SOL_QUAD1, DRIFT_Z22, DRIFT_Z23, SOL_QUAD2, DRIFT_Z23, + TMULTIPOLE_24, THICK_MULTIPOLE1, TMULTIPOLE_24, TAYLOR1, VKICKER1, + LCAVITY1, LCAVITY2, LCAVITY3, END); + +//---------------------------------; + +lat: line = (line_1); +use, period = lat; + +//---------------------------------; + +select, flag = error, clear; +select, flag = error, range = AB_MULTIPOLE1[1]; +ealign, dx = 0.02; +select, flag = error, clear; +select, flag = error, range = BEAMBEAM1[1]; +ealign, dphi = -0.05, dx = 3E-3, dy = 3E-3; +select, flag = error, clear; +select, flag = error, range = ECOLLIMATOR1[1]; +ealign, dphi = -1E-3, dx = 0.02, dy = -2.25E-3; +select, flag = error, clear; +select, flag = error, range = ELSEPARATOR1[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3; +select, flag = error, clear; +select, flag = error, range = ELSEPARATOR2[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3; +select, flag = error, clear; +select, flag = error, range = FLOOR_SHIFT1[1]; +ealign, dtheta = 0.01, dphi = -0.02, dx = 0.1, dy = 0.2, ds = 0.3; +select, flag = error, clear; +select, flag = error, range = GKICKER1[1]; +ealign, dtheta = 0.02, dphi = -0.03, dx = 0.04, dy = 0.05, ds = 0.06; +select, flag = error, clear; +select, flag = error, range = HKICKER1[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3; +select, flag = error, clear; +select, flag = error, range = KICKER1[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3; +select, flag = error, clear; +select, flag = error, range = MULTIPOLE1[1]; +ealign, dx = 0.05; +select, flag = error, clear; +select, flag = error, range = OCTUPOLE1[1]; +ealign, dphi = -1E-3, dx = 0.01, dy = -2.25E-3; +select, flag = error, clear; +select, flag = error, range = DRIFT_PATCH1[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -2E-6; +select, flag = error, clear; +select, flag = error, range = PATCH1[1]; +ealign, dtheta = 1E-3, dphi = -2E-3, dx = 9.97998E-4, dy = 1.996E-3; +select, flag = error, clear; +select, flag = error, range = QUADRUPOLE1[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4; +select, flag = error, clear; +select, flag = error, range = QUADRUPOLE2[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4; +select, flag = error, clear; +select, flag = error, range = QUADRUPOLE3[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4; +select, flag = error, clear; +select, flag = error, range = QUADRUPOLE4[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4; +select, flag = error, clear; +select, flag = error, range = QUADRUPOLE5[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4; +select, flag = error, clear; +select, flag = error, range = RCOLLIMATOR1[1]; +ealign, dphi = -1E-3, dx = 0.02, dy = -2.25E-3; +select, flag = error, clear; +select, flag = error, range = RFCAVITY1[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3; +select, flag = error, clear; +select, flag = error, range = RFCAVITY2[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3; +select, flag = error, clear; +select, flag = error, range = RFCAVITY3[1]; +ealign, dphi = -1E-3, dx = 0.05; +select, flag = error, clear; +select, flag = error, range = SBEND1[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4; +select, flag = error, clear; +select, flag = error, range = RBEND2[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4; +select, flag = error, clear; +select, flag = error, range = SBEND3[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4; +select, flag = error, clear; +select, flag = error, range = RBEND4[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4; +select, flag = error, clear; +select, flag = error, range = SBEND5[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4; +select, flag = error, clear; +select, flag = error, range = RBEND6[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4; +select, flag = error, clear; +select, flag = error, range = SBEND7[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4; +select, flag = error, clear; +select, flag = error, range = SEXTUPOLE1[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -3E-4; +select, flag = error, clear; +select, flag = error, range = SOLENOID1[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -1.3E-3; +select, flag = error, clear; +select, flag = error, range = SOLENOID2[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -1.3E-3; +select, flag = error, clear; +select, flag = error, range = SOL_QUAD1[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -1.3E-3; +select, flag = error, clear; +select, flag = error, range = DRIFT_Z22[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -6.5E-4; +select, flag = error, clear; +select, flag = error, range = DRIFT_Z22[2]; +ealign, dphi = -1E-3, dx = 0.05, dy = -6.5E-4; +select, flag = error, clear; +select, flag = error, range = SOL_QUAD2[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -1.3E-3; +select, flag = error, clear; +select, flag = error, range = DRIFT_Z23[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -6.5E-4; +select, flag = error, clear; +select, flag = error, range = DRIFT_Z23[2]; +ealign, dphi = -1E-3, dx = 0.05, dy = -6.5E-4; +select, flag = error, clear; +select, flag = error, range = THICK_MULTIPOLE1[1]; +ealign, dx = 0.02; +select, flag = error, clear; +select, flag = error, range = VKICKER1[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3; +select, flag = error, clear; +select, flag = error, range = LCAVITY1[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3; +select, flag = error, clear; +select, flag = error, range = LCAVITY2[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3; +select, flag = error, clear; +select, flag = error, range = LCAVITY3[1]; +ealign, dphi = -1E-3, dx = 0.05, dy = -2.25E-3; + +//---------------------------------; + +initial: beta0, betx = 10, bety = 10, alfx = 0, alfy = 0, + dx = 0, dpx = 0, dy = 0, dpy = 0, + x = 1E-3, px = 2E-3, y = 3E-3, py = 4E-3, t = 4.29791E-3, pt = 6.98014E-3 + ; +twiss, beta0 = initial; diff --git a/regression_tests/write_foreign_test/write_foreign_test.opal.correct b/regression_tests/write_foreign_test/write_foreign_test.opal.correct new file mode 100644 index 0000000000..127494d94a --- /dev/null +++ b/regression_tests/write_foreign_test/write_foreign_test.opal.correct @@ -0,0 +1,41 @@ +// Generated by: write_opal_lattice_file +// Bmad Lattice File: /nfs/acc/user/dcs16/bmad-ecosystem/regression_tests/write_foreign_test/write_foreign_test.bmad +// Bmad Lattice Name: + +AB_MULTIPOLE1: drift, l = 0.00000E+00, elemedge = 0, dx = 0.02; +AC_KICKER1: drift, l = 3.00000E-01, elemedge = 0; +AC_KICKER2: drift, l = 4.00000E-01, elemedge = 0.3; +AC_KICKER3: drift, l = 4.00000E-01, elemedge = 0.7; +BEAMBEAM1: drift, l = 0.00000E+00, elemedge = 1.1, dphi = -0.05, dx = 3E-3, dy = 3E-3; +CRAB_CAVITY1: drift, l = 2.00000E-01, elemedge = 1.1; +DRIFT1: drift, l = 4.50000E+00, elemedge = 1.3, dphi = -1E-3, dx = 0.05, dy = -2.25E-3; +ECOLLIMATOR1: drift, l = 4.50000E+00, elemedge = 5.8, dphi = -1E-3, dx = 0.02, dy = -2.25E-3; +ELSEPARATOR1: drift, l = 4.50000E+00, elemedge = 10.3, dphi = -1E-3, dx = 0.05, dy = -2.25E-3; +ELSEPARATOR2: drift, l = 4.50000E+00, elemedge = 14.8, dphi = -1E-3, dx = 0.05, dy = -2.25E-3; +EM_FIELD1: drift, l = 1.40000E+00, elemedge = 19.3; +EM_FIELD2: drift, l = 1.40000E+00, elemedge = 20.7; +FIDUCIAL1: drift, l = 0.00000E+00, elemedge = 22.1; +FLOOR_SHIFT1: drift, l = 0.00000E+00, elemedge = 22.1, dtheta = 0.01, dphi = -0.02, dx = 0.1, dy = 0.2, + dz = 0.3; +GKICKER1: drift, l = 0.00000E+00, elemedge = 22.1, dtheta = 0.02, dphi = -0.03, dx = 0.04, dy = 0.05, + dz = 0.06; +HKICKER1: drift, l = 4.50000E+00, elemedge = 22.1, dphi = -1E-3, dx = 0.05, dy = -2.25E-3; +INSTRUMENT1: drift, l = 4.50000E+00, elemedge = 26.6; +KICKER1: drift, l = 4.50000E+00, elemedge = 31.1, dphi = -1E-3, dx = 0.05, dy = -2.25E-3; +MATCH1: drift, l = 0.00000E+00, elemedge = 35.6; +MONITOR1: drift, l = 4.50000E+00, elemedge = 35.6; +MULTIPOLE1: drift, l = 0.00000E+00, elemedge = 40.1, dx = 0.05; +OCTUPOLE1: drift, l = 4.50000E+00, elemedge = 40.1, dphi = -1E-3, dx = 0.01, dy = -2.25E-3; +PATCH1: drift, l = 4.00499E-03, elemedge = 44.6, dtheta = 1E-3, dphi = -2E-3, dx = 9.97998E-4, + dy = 1.996E-3, dz = 4E-3; +QUADRUPOLE1: quadrupole, l = 6.00000E-01, k1 = 2.86725E-3, elemedge = 44.604, dphi = -1E-3, dx = 0.05, + dy = -3E-4; +QUADRUPOLE2: quadrupole, l = 6.00000E-01, k1 = -2.86725E-3, elemedge = 45.204, dphi = -1E-3, dx = 0.05, + dy = -3E-4; +QUADRUPOLE3: quadrupole, l = 6.00000E-01, k1 = 2.86725E-23, elemedge = 45.804, dphi = -1E-3, dx = 0.05, + dy = -3E-4; +QUADRUPOLE4: quadrupole, l = 6.00000E-01, k1 = 2.86725E-3, elemedge = 46.404, dphi = -1E-3, dx = 0.05, + dy = -3E-4; +QUADRUPOLE5: quadrupole, l = 6.00000E-01, k1 = -2.86725E-3, elemedge = 47.004, dphi = -1E-3, dx = 0.05, + dy = -3E-4; +RCOLLIMATOR1: drift, l = 4.50000E+00, elemedge = 47.604, dphi = -1E-3, dx = 0.02, dy = -2.25E-3; diff --git a/regression_tests/write_foreign_test/write_foreign_test.sad.correct b/regression_tests/write_foreign_test/write_foreign_test.sad.correct new file mode 100644 index 0000000000..ae6f57ac16 --- /dev/null +++ b/regression_tests/write_foreign_test/write_foreign_test.sad.correct @@ -0,0 +1,14 @@ +! File generated by Bmad from Bmad lattice file: + /nfs/acc/user/dcs16/bmad-ecosystem/regression_tests/write_foreign_test/write_foreign_test.bmad; + +MOMENTUM = 1E9; +BEND B = (L = 0.1); +MARK END = (); + +!---------------------------------; + +LINE ASC = ( B END); + +!---------------------------------; + +FFS USE ASC; diff --git a/sim_utils/searchf.namelist b/sim_utils/searchf.namelist index 537dcb3627..9e5146ff58 100644 --- a/sim_utils/searchf.namelist +++ b/sim_utils/searchf.namelist @@ -107,42 +107,6 @@ user_signal File: interfaces/parallel_mod.f90 parallel_mod -File: interfaces/physical_constants.f90 -physical_constants -pi -twopi -fourpi -sqrt_2 -sqrt_3 -m_electron -m_proton -m_neutron -m_muon -m_helion -e_mass -p_mass -m_pion_0 -m_pion_charged -m_deuteron -atomic_mass_unit -c_light -r_e -r_p -e_charge -h_planck -h_bar_planck -mu_0_vac -eps_0_vac -classical_radius_factor -n_avogadro -fine_structure_constant -anomalous_mag_moment_electron -anomalous_mag_moment_proton -anomalous_mag_moment_muon -anomalous_mag_moment_deuteron -anomalous_mag_moment_neutron -anomalous_mag_moment_he3 - File: interfaces/sim_utils.f90 sim_utils @@ -197,60 +161,50 @@ x0_radiation_length atomic_number is_subatomic_species -File: interfaces/sim_utils_struct.f90 -sim_utils_struct -var_length_string_struct -str_index_struct -nametable_struct -all_pointer_struct -i_imaginary -i_imag -int_garbage$ -real_garbage$ -null_name$ -str_garbage$ -lf$ -invalid$ -not_set$ -invalid_name -molecular_component_struct -x_axis$ -y_axis$ -z_axis$ -xy_axis$ -true$ -false$ -true_int$ -false_int$ -yes$ -no$ -maybe$ -provisional$ -rl_prompt_start_ignore -rl_prompt_end_ignore -black_color -red_color -green_color -yellow_color -blue_color -magenta_color -cyan_color -gray_color -dark_gray_color -peach_color -light_green_color -light_yellow_color -light_blue_color -pink_color -aqua_color -white_color -blink_color -bold_color -reset_color -int_logic -is_true -is_false -value_of_all_ptr +File: interfaces/physical_constants.f90 +physical_constants +pi +twopi +fourpi +sqrt_2 +sqrt_3 +m_electron +m_proton +m_neutron +m_muon +m_helion +e_mass +p_mass +m_pion_0 +m_pion_charged +m_deuteron +atomic_mass_unit +c_light +r_e +r_p +e_charge +h_planck +h_bar_planck +mu_0_vac +eps_0_vac +classical_radius_factor +n_avogadro +fine_structure_constant +anomalous_mag_moment_electron +anomalous_mag_moment_proton +anomalous_mag_moment_muon +anomalous_mag_moment_deuteron +anomalous_mag_moment_neutron +anomalous_mag_moment_he3 + +File: interfaces/precision_def.f90 +precision_def +rp +sp +dp +i4_b +global_common_struct +named_number_struct File: interfaces/sim_utils_interface.f90 sim_utils_interface @@ -353,14 +307,60 @@ find_location_int find_location_logic find_location_str -File: interfaces/precision_def.f90 -precision_def -rp -sp -dp -i4_b -global_common_struct -named_number_struct +File: interfaces/sim_utils_struct.f90 +sim_utils_struct +var_length_string_struct +str_index_struct +nametable_struct +all_pointer_struct +i_imaginary +i_imag +int_garbage$ +real_garbage$ +null_name$ +str_garbage$ +lf$ +invalid$ +not_set$ +invalid_name +molecular_component_struct +x_axis$ +y_axis$ +z_axis$ +xy_axis$ +true$ +false$ +true_int$ +false_int$ +yes$ +no$ +maybe$ +provisional$ +rl_prompt_start_ignore +rl_prompt_end_ignore +black_color +red_color +green_color +yellow_color +blue_color +magenta_color +cyan_color +gray_color +dark_gray_color +peach_color +light_green_color +light_yellow_color +light_blue_color +pink_color +aqua_color +white_color +blink_color +bold_color +reset_color +int_logic +is_true +is_false +value_of_all_ptr File: io/command_line_mod.f90 command_line_mod @@ -511,16 +511,6 @@ tricubic_compute_cmplx_field_at_3d_box tricubic_interpolation_cmplx_coefs tricubic_cmplx_eval -File: math/da2_mod.f90 -da2_mod -da2_mult -da2_div -da2_inverse -da2_evaluate - -File: math/fft_1d.f90 -fft_1d - File: math/fourier_mod.f90 fourier_mod coarse_frequency_estimate @@ -572,70 +562,6 @@ rms_value File: math/rot_2d.f90 rot_2d -File: math/rotation_3d_mod.f90 -rotation_3d_mod -quat_conj -procedure -procedure -quat_mul -procedure -procedure -quat_rotate -procedure -procedure -w_mat_to_axis_angle -w_mat_to_quat -quat_to_w_mat -axis_angle_to_w_mat -quat_to_omega -omega_to_quat -quat_to_axis_angle -axis_angle_to_quat -quat_conj_real -quat_conj_complex -quat_inverse -quat_mul_real -quat_mul_complex -quat_rotate_real -quat_rotate_complex -rotate_vec_given_axis_angle -rotate_vec -rotate_mat - -File: math/sign_of_mod.f90 -sign_of_mod -sign_of -procedure -procedure -sign_of_real -sign_of_int - -File: math/super_recipes_mod.f90 -super_recipes_mod -super_mrqmin_storage_struct -super_bicubic_interpolation -super_bicubic_coef -super_sort -super_rtsafe -super_mnbrak -shft -super_brent -shft -super_dbrent -mov3 -super_zbrent -super_mrqmin -super_mrqcof -super_gaussj -super_ludcmp -super_qromb -super_polint -super_trapzd -super_qromb_2d -trapzd_2d -super_poly -covar_expand - File: math/windowLS.f90 windowls_mod max_wls @@ -651,8 +577,15 @@ find_location_int find_location_str find_location_logic -File: math/quadratic_roots.f90 -quadratic_roots +File: math/da2_mod.f90 +da2_mod +da2_mult +da2_div +da2_inverse +da2_evaluate + +File: math/fft_1d.f90 +fft_1d File: math/random_mod.f90 random_mod @@ -700,6 +633,65 @@ end_akima_spline_calc akima_spline_slope_calc akima_spline_coef23_calc +File: math/super_recipes_mod.f90 +super_recipes_mod +super_mrqmin_storage_struct +super_bicubic_interpolation +super_bicubic_coef +super_sort +super_rtsafe +super_mnbrak +shft +super_brent +shft +super_dbrent +mov3 +super_zbrent +super_mrqmin +super_mrqcof +super_gaussj +super_ludcmp +super_qromb +super_polint +super_trapzd +super_qromb_2d +trapzd_2d +super_poly +covar_expand + +File: math/rotation_3d_mod.f90 +rotation_3d_mod +quat_conj +procedure +procedure +quat_mul +procedure +procedure +quat_rotate +procedure +procedure +w_mat_to_axis_angle +w_mat_to_quat +quat_to_w_mat +axis_angle_to_w_mat +quat_to_omega +omega_to_quat +quat_to_axis_angle +axis_angle_to_quat +quat_conj_real +quat_conj_complex +quat_inverse +quat_mul_real +quat_mul_complex +quat_rotate_real +quat_rotate_complex +rotate_vec_given_axis_angle +rotate_vec +rotate_mat + +File: math/quadratic_roots.f90 +quadratic_roots + File: matrix/cplx_mat_inverse.f90 cplx_mat_inverse @@ -724,12 +716,6 @@ mat_rotation File: matrix/mat_scale_p0.f90 mat_scale_p0 -File: matrix/mat_symp_conj.f90 -mat_symp_conj - -File: matrix/mat_symp_conj_i.f90 -mat_symp_conj_i - File: matrix/mat_symp_error.f90 mat_symp_error @@ -754,6 +740,12 @@ svd_fit File: matrix/mat_eigen.f90 mat_eigen +File: matrix/mat_symp_conj.f90 +mat_symp_conj + +File: matrix/mat_symp_conj_i.f90 +mat_symp_conj_i + File: misc/assert_equal.f90 assert_equal @@ -1074,6 +1066,75 @@ qp_select_page_basic qp_close_page_basic qp_end_basic +File: plot/quick_plot_struct.f90 +quick_plot_struct +white$ +black$ +red$ +green$ +blue$ +cyan$ +magenta$ +yellow$ +orange$ +yellow_green$ +light_green$ +navy_blue$ +purple$ +reddish_purple$ +dark_grey$ +light_grey$ +transparent$ +qp_color_name +solid$ +dashed$ +dash_dot$ +dotted$ +dash_dot3$ +qp_line_pattern_name +solid_fill$ +no_fill$ +hatched$ +cross_hatched$ +qp_symbol_fill_pattern_name +square_sym$ +dot_sym$ +plus_sym$ +times_sym$ +circle_sym$ +x_symbol_sym$ +triangle_sym$ +circle_plus_sym$ +circle_dot_sym$ +square_concave_sym$ +diamond_sym$ +star5_sym$ +triangle_filled_sym$ +red_cross_sym$ +star_of_david_sym$ +square_filled_sym$ +circle_filled_sym$ +star5_filled_sym$ +qp_symbol_type_name +dflt_draw$ +dflt_set$ +print_page_long_len +print_page_short_len +filled_arrow_head$ +outline_arrow_head$ +qp_arrow_head_type_name +qp_axis_struct +qp_plot_struct +qp_point_struct +qp_rect_struct +qp_text_struct +qp_line_struct +qp_symbol_struct +qp_arrow_struct +qp_state_struct +qp_string_to_enum +qp_enum_to_string + File: plot/quick_plot.f90 quick_plot qp_base_library @@ -1167,75 +1228,6 @@ qp_continuous_color qp_continuous_color_inverse qp_end -File: plot/quick_plot_struct.f90 -quick_plot_struct -white$ -black$ -red$ -green$ -blue$ -cyan$ -magenta$ -yellow$ -orange$ -yellow_green$ -light_green$ -navy_blue$ -purple$ -reddish_purple$ -dark_grey$ -light_grey$ -transparent$ -qp_color_name -solid$ -dashed$ -dash_dot$ -dotted$ -dash_dot3$ -qp_line_pattern_name -solid_fill$ -no_fill$ -hatched$ -cross_hatched$ -qp_symbol_fill_pattern_name -square_sym$ -dot_sym$ -plus_sym$ -times_sym$ -circle_sym$ -x_symbol_sym$ -triangle_sym$ -circle_plus_sym$ -circle_dot_sym$ -square_concave_sym$ -diamond_sym$ -star5_sym$ -triangle_filled_sym$ -red_cross_sym$ -star_of_david_sym$ -square_filled_sym$ -circle_filled_sym$ -star5_filled_sym$ -qp_symbol_type_name -dflt_draw$ -dflt_set$ -print_page_long_len -print_page_short_len -filled_arrow_head$ -outline_arrow_head$ -qp_arrow_head_type_name -qp_axis_struct -qp_plot_struct -qp_point_struct -qp_rect_struct -qp_text_struct -qp_line_struct -qp_symbol_struct -qp_arrow_struct -qp_state_struct -qp_string_to_enum -qp_enum_to_string - File: special_functions/asinc.f90 asinc @@ -1311,6 +1303,14 @@ sqrt_one File: special_functions/faddeeva_function.f90 faddeeva_function +File: special_functions/sign_of_mod.f90 +sign_of_mod +sign_of +procedure +procedure +sign_of_real +sign_of_int + File: string/all_pointer_to_string.f90 all_pointer_to_string @@ -1431,9 +1431,6 @@ quoten File: string/real_num_fortran_format.f90 real_num_fortran_format -File: string/real_str.f90 -real_str - File: string/real_to_string.f90 real_to_string @@ -1512,3 +1509,9 @@ upcase File: string/word_read.f90 word_read + +File: string/detab.f90 +detab + +File: string/real_str.f90 +real_str diff --git a/tao/searchf.namelist b/tao/searchf.namelist index 23c5c12dd8..970dc7a3ed 100644 --- a/tao/searchf.namelist +++ b/tao/searchf.namelist @@ -54,8 +54,8 @@ tao_close_command_file File: code/tao_cmd_end_calc.f90 tao_cmd_end_calc -File: code/tao_command.f90 -tao_command +File: code/tao_help.f90 +tao_help File: code/tao_command_mod.f90 tao_command_mod @@ -212,9 +212,6 @@ tao_set_curve_invalid tao_curve_check_universe tao_graph_s_min_max_calc -File: code/tao_help.f90 -tao_help - File: code/tao_init.f90 tao_init @@ -463,8 +460,8 @@ tao_ptc_cmd File: code/tao_ptc_normal_form.f90 tao_ptc_normal_form -File: code/tao_python_cmd.f90 -tao_python_cmd +File: code/tao_command.f90 +tao_command File: code/tao_quiet_set.f90 tao_quiet_set @@ -499,9 +496,6 @@ tao_scale_ping_data File: code/tao_set_data_useit_opt.f90 tao_set_data_useit_opt -File: code/tao_set_flags_for_changed_attribute.f90 -tao_set_flags_for_changed_attribute - File: code/tao_set_opt_vars.f90 tao_set_opt_vars @@ -523,9 +517,6 @@ tao_show_cmd File: code/tao_spin_matrix_calc.f90 tao_spin_matrix_calc -File: code/tao_spin_polarization_calc.f90 -tao_spin_polarization_calc - File: code/tao_spin_tracking_turn_on.f90 tao_spin_tracking_turn_on @@ -563,9 +554,6 @@ tao_var_write tao_print_vars tao_write_lines -File: code/tao_top_level.f90 -tao_top_level - File: code/tao_turn_on_special_calcs_if_needed_for_plotting.f90 tao_turn_on_special_calcs_if_needed_for_plotting @@ -630,6 +618,61 @@ tao_single_mode File: code/tao_spin_matrices_calc_needed.f90 tao_spin_matrices_calc_needed +File: code/tao_pipe_cmd.f90 +tao_pipe_cmd + +File: code/tao_python_cmd.f90 +tao_python_cmd + +File: code/tao_set_flags_for_changed_attribute.f90 +tao_set_flags_for_changed_attribute + +File: code/tao_set_mod.f90 +tao_set_mod +tao_set_tune_cmd +tao_set_z_tune_cmd +tao_set_calculate_cmd +tao_set_key_cmd +tao_set_ran_state_cmd +tao_set_lattice_cmd +tao_set_global_cmd +tao_set_space_charge_com_cmd +tao_set_bmad_com_cmd +tao_set_ptc_com_cmd +tao_set_geodesic_lm_cmd +tao_set_opti_de_param_cmd +tao_set_wave_cmd +tao_set_beam_cmd +tao_set_beam_init_cmd +tao_set_particle_start_cmd +tao_set_plot_page_cmd +tao_set_curve_cmd +tao_set_plot_cmd +tao_set_region_cmd +tao_set_graph_cmd +tao_set_var_cmd +tao_set_branch_cmd +tao_set_data_cmd +tao_set_default_cmd +tao_set_dynamic_aperture_cmd +tao_set_universe_cmd +tao_set_elements_cmd +tao_set_logical_value +tao_set_integer_value +tao_set_switch_value +tao_set_real_value +tao_set_drawing_cmd +tao_set_symbolic_number_cmd +tao_set_qp_rect_struct +tao_set_qp_axis_struct +tao_set_qp_point_struct + +File: code/tao_show_this.f90 +tao_show_this + +File: code/tao_spin_polarization_calc.f90 +tao_spin_polarization_calc + File: code/tao_struct.f90 tao_struct model$ @@ -677,6 +720,7 @@ tao_floor_plan_struct tao_graph_struct tao_plot_struct tao_plot_region_struct +n_curve_pts_init$ tao_plot_page_struct tao_region_array_struct tao_plot_array_struct @@ -732,48 +776,8 @@ tao_deallocate_plot_cache tao_lattice_branches_equal_tao_lattice_branches tao_lattice_equal_tao_lattice -File: code/tao_set_mod.f90 -tao_set_mod -tao_set_tune_cmd -tao_set_z_tune_cmd -tao_set_calculate_cmd -tao_set_key_cmd -tao_set_ran_state_cmd -tao_set_lattice_cmd -tao_set_global_cmd -tao_set_space_charge_com_cmd -tao_set_bmad_com_cmd -tao_set_ptc_com_cmd -tao_set_geodesic_lm_cmd -tao_set_opti_de_param_cmd -tao_set_wave_cmd -tao_set_beam_cmd -tao_set_beam_init_cmd -tao_set_particle_start_cmd -tao_set_plot_page_cmd -tao_set_curve_cmd -tao_set_plot_cmd -tao_set_region_cmd -tao_set_graph_cmd -tao_set_var_cmd -tao_set_branch_cmd -tao_set_data_cmd -tao_set_default_cmd -tao_set_dynamic_aperture_cmd -tao_set_universe_cmd -tao_set_elements_cmd -tao_set_logical_value -tao_set_integer_value -tao_set_switch_value -tao_set_real_value -tao_set_drawing_cmd -tao_set_symbolic_number_cmd -tao_set_qp_rect_struct -tao_set_qp_axis_struct -tao_set_qp_point_struct - -File: code/tao_show_this.f90 -tao_show_this +File: code/tao_top_level.f90 +tao_top_level File: hook/tao_hook_branch_calc.f90 tao_hook_branch_calc diff --git a/tao/version/tao_version_mod.f90 b/tao/version/tao_version_mod.f90 index d347cfdcd1..fe26f907a6 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/09/06 22:33:11" +character(*), parameter :: tao_version_date = "2024/09/14 13:34:21" end module diff --git a/util_programs/bmad_to_julia/bmad_to_julia.f90 b/util_programs/bmad_to_julia/bmad_to_julia.f90 index 58bfccde5c..c8fe683a1a 100644 --- a/util_programs/bmad_to_julia/bmad_to_julia.f90 +++ b/util_programs/bmad_to_julia/bmad_to_julia.f90 @@ -6,15 +6,20 @@ program bmad_to_julia type (lat_struct) lat character(200) bmad_name, julia_name +logical err_flag ! call get_command_argument (1, bmad_name) call get_command_argument (2, julia_name) + call bmad_parser(bmad_name, lat) -if (julia_name == '') julia_name = bmad_name -call write_lattice_in_julia(julia_name, lat, julia_name) +if (julia_name == '') then + call file_suffixer(bmad_name, julia_name, '.jl', .true.) +endif + +call write_lattice_in_julia(julia_name, lat, err_flag) print *, 'Julia file: ' // trim(julia_name) end program