diff --git a/bmad/code/pointer_to_attribute.f90 b/bmad/code/pointer_to_attribute.f90 index d4e7a7f204..7dfe8b5df4 100644 --- a/bmad/code/pointer_to_attribute.f90 +++ b/bmad/code/pointer_to_attribute.f90 @@ -219,7 +219,7 @@ subroutine pointer_to_attribute (ele, attrib_name, do_allocation, a_ptr, err_fla if (a_name(1:3) == 'LR(' .or. a_name(1:13) == 'LR_WAKE%MODE(') then if (.not. associated (ele%wake)) then if (.not. do_allocation) goto 9100 - call init_wake (ele%wake, 0, 0, n) + call init_wake (ele%wake, 0, 0, 0, n) endif if (a_name(1:3) == 'LR(') then @@ -517,7 +517,7 @@ subroutine pointer_to_attribute (ele, attrib_name, do_allocation, a_ptr, err_fla 'SR_WAKE%SCALE_WITH_LENGTH', 'SR_WAKE%AMP_SCALE', 'SR_WAKE%Z_SCALE') if (.not. associated(ele%wake)) then if (.not. do_allocation) goto 9100 - call init_wake (ele%wake, 0, 0, 0, .true.) + call init_wake (ele%wake, 0, 0, 0, 0, .true.) endif select case (a_name) case ('LR_SELF_WAKE_ON', 'LR_WAKE%SELF_WAKE_ON') diff --git a/bmad/modules/bmad_routine_interface.f90 b/bmad/modules/bmad_routine_interface.f90 index 4f47997393..fa28361f99 100644 --- a/bmad/modules/bmad_routine_interface.f90 +++ b/bmad/modules/bmad_routine_interface.f90 @@ -1181,11 +1181,11 @@ subroutine init_multipole_cache(ele) type (ele_struct) ele end subroutine -subroutine init_wake (wake, n_sr_long, n_sr_trans, n_sr_time, n_lr_mode, always_allocate) +subroutine init_wake (wake, n_sr_long, n_sr_trans, n_sr_z, n_lr_mode, always_allocate) import implicit none type (wake_struct), pointer :: wake - integer n_sr_long, n_sr_trans, n_sr_time, n_lr_mode + integer n_sr_long, n_sr_trans, n_sr_z, n_lr_mode logical, optional :: always_allocate end subroutine diff --git a/bmad/modules/bmad_struct.f90 b/bmad/modules/bmad_struct.f90 index ed5c2c716d..b2f8705fd5 100644 --- a/bmad/modules/bmad_struct.f90 +++ b/bmad/modules/bmad_struct.f90 @@ -584,7 +584,7 @@ module bmad_struct character(8), parameter :: sr_transverse_position_dep_name(3) = [character(8):: 'none', 'leading', 'trailing'] character(12), parameter :: sr_longitudinal_position_dep_name(5) = & [character(12):: 'none', 'x_leading', 'y_leading', 'x_trailing', 'y_trailing'] -character(8), parameter :: sr_time_plane_name(5) = [character(8):: 'X', 'XY', 'Y', null_name$, 'Z'] +character(8), parameter :: sr_z_plane_name(5) = [character(8):: 'X', 'XY', 'Y', null_name$, 'Z'] type wake_sr_mode_struct ! Psudo-mode Short-range wake struct real(rp) :: amp = 0 ! Amplitude @@ -600,8 +600,8 @@ module bmad_struct ! Longitudinal: x_leading$, ..., y_trailing$, none$ end type -type wake_sr_time_struct - type(spline_struct), allocatable :: wake(:) ! Wake vs time. +type wake_sr_z_struct + type(spline_struct), allocatable :: w(:) ! Wake vs time. type(spline_struct), allocatable :: w1(:), w2(:) ! Running sums used when tracking. integer :: plane = not_set$ ! x$, y$, xy$, z$. integer :: position_dependence = not_set$ ! Transverse: leading$, trailing$, none$ @@ -610,7 +610,7 @@ module bmad_struct type wake_sr_struct ! Psudo-mode short-Range Wake struct character(200) :: file = '' - type (wake_sr_time_struct), allocatable :: time(:) + type (wake_sr_z_struct), allocatable :: z(:) type (wake_sr_mode_struct), allocatable :: long(:) type (wake_sr_mode_struct), allocatable :: trans(:) real(rp) :: z_ref_long = 0 ! z reference value for computing the wake amplitude. diff --git a/bmad/modules/equality_mod.f90 b/bmad/modules/equality_mod.f90 index 80f55618a8..9ef3c37159 100644 --- a/bmad/modules/equality_mod.f90 +++ b/bmad/modules/equality_mod.f90 @@ -16,7 +16,7 @@ module equality_mod interface operator (==) module procedure eq_spline, eq_spin_polar, eq_surface_orientation, eq_ac_kicker_time, eq_ac_kicker_freq module procedure eq_ac_kicker, eq_interval1_coef, eq_photon_reflect_table, eq_photon_reflect_surface, eq_coord - module procedure eq_coord_array, eq_bpm_phase_coupling, eq_expression_atom, eq_wake_sr_time, eq_wake_sr_mode + module procedure eq_coord_array, eq_bpm_phase_coupling, eq_expression_atom, eq_wake_sr_z, eq_wake_sr_mode module procedure eq_wake_sr, eq_wake_lr_mode, eq_wake_lr, eq_lat_ele_loc, eq_wake module procedure eq_taylor_term, eq_taylor, eq_em_taylor_term, eq_em_taylor, eq_cartesian_map_term1 module procedure eq_cartesian_map_term, eq_cartesian_map, eq_cylindrical_map_term1, eq_cylindrical_map_term, eq_cylindrical_map @@ -435,28 +435,40 @@ end function eq_expression_atom !-------------------------------------------------------------------------------- !-------------------------------------------------------------------------------- -elemental function eq_wake_sr_time (f1, f2) result (is_eq) +elemental function eq_wake_sr_z (f1, f2) result (is_eq) implicit none -type(wake_sr_time_struct), intent(in) :: f1, f2 +type(wake_sr_z_struct), intent(in) :: f1, f2 logical is_eq ! is_eq = .true. !! f_side.equality_test[type, 1, ALLOC] -is_eq = is_eq .and. (allocated(f1%wake) .eqv. allocated(f2%wake)) +is_eq = is_eq .and. (allocated(f1%w) .eqv. allocated(f2%w)) if (.not. is_eq) return -if (allocated(f1%wake)) is_eq = all(shape(f1%wake) == shape(f2%wake)) +if (allocated(f1%w)) is_eq = all(shape(f1%w) == shape(f2%w)) if (.not. is_eq) return -if (allocated(f1%wake)) is_eq = all(f1%wake == f2%wake) +if (allocated(f1%w)) is_eq = all(f1%w == f2%w) +!! f_side.equality_test[type, 1, ALLOC] +is_eq = is_eq .and. (allocated(f1%w1) .eqv. allocated(f2%w1)) +if (.not. is_eq) return +if (allocated(f1%w1)) is_eq = all(shape(f1%w1) == shape(f2%w1)) +if (.not. is_eq) return +if (allocated(f1%w1)) is_eq = all(f1%w1 == f2%w1) +!! f_side.equality_test[type, 1, ALLOC] +is_eq = is_eq .and. (allocated(f1%w2) .eqv. allocated(f2%w2)) +if (.not. is_eq) return +if (allocated(f1%w2)) is_eq = all(shape(f1%w2) == shape(f2%w2)) +if (.not. is_eq) return +if (allocated(f1%w2)) is_eq = all(f1%w2 == f2%w2) !! f_side.equality_test[integer, 0, NOT] is_eq = is_eq .and. (f1%plane == f2%plane) !! f_side.equality_test[integer, 0, NOT] is_eq = is_eq .and. (f1%position_dependence == f2%position_dependence) -end function eq_wake_sr_time +end function eq_wake_sr_z !-------------------------------------------------------------------------------- !-------------------------------------------------------------------------------- @@ -510,11 +522,11 @@ elemental function eq_wake_sr (f1, f2) result (is_eq) !! f_side.equality_test[character, 0, NOT] is_eq = is_eq .and. (f1%file == f2%file) !! f_side.equality_test[type, 1, ALLOC] -is_eq = is_eq .and. (allocated(f1%time) .eqv. allocated(f2%time)) +is_eq = is_eq .and. (allocated(f1%z) .eqv. allocated(f2%z)) if (.not. is_eq) return -if (allocated(f1%time)) is_eq = all(shape(f1%time) == shape(f2%time)) +if (allocated(f1%z)) is_eq = all(shape(f1%z) == shape(f2%z)) if (.not. is_eq) return -if (allocated(f1%time)) is_eq = all(f1%time == f2%time) +if (allocated(f1%z)) is_eq = all(f1%z == f2%z) !! f_side.equality_test[type, 1, ALLOC] is_eq = is_eq .and. (allocated(f1%long) .eqv. allocated(f2%long)) if (.not. is_eq) return diff --git a/bmad/multiparticle/init_wake.f90 b/bmad/multiparticle/init_wake.f90 index f8321ec86e..88cb77f232 100644 --- a/bmad/multiparticle/init_wake.f90 +++ b/bmad/multiparticle/init_wake.f90 @@ -1,5 +1,5 @@ !+ -! Subroutine init_wake (wake, n_sr_long, n_sr_trans, n_sr_time, n_lr_mode, always_allocate) +! Subroutine init_wake (wake, n_sr_long, n_sr_trans, n_sr_z, n_lr_mode, always_allocate) ! ! Subroutine to initialize a wake struct. ! If the wake is allocated, All components are always allocated even when the size is zero. @@ -7,7 +7,7 @@ ! Input: ! n_sr_long -- Integer: Number of terms: wake%sr%long. ! n_sr_trans -- Integer: Number of terms: wake%sr%trans. -! n_sr_time -- Integer: Number of terms: wake%sr%time. +! n_sr_z -- Integer: Number of terms: wake%sr%z. ! n_lr_mode -- Integer: Number of terms: wake%lr%mode. ! always_allocate -- logical, optional: If present and True then allways allocate wake ! even if n_lr_mode, etc. are all 0. Default is False. @@ -16,20 +16,20 @@ ! wake -- Wake_struct, pointer: Initialized structure. !- -subroutine init_wake (wake, n_sr_long, n_sr_trans, n_sr_time, n_lr_mode, always_allocate) +subroutine init_wake (wake, n_sr_long, n_sr_trans, n_sr_z, n_lr_mode, always_allocate) use bmad_struct implicit none type (wake_struct), pointer :: wake -integer n_sr_long, n_sr_trans, n_sr_time, n_lr_mode +integer n_sr_long, n_sr_trans, n_sr_z, n_lr_mode integer i logical, optional :: always_allocate ! Deallocate wake if all inputs are zero. -if (n_sr_long == 0 .and. n_sr_trans == 0 .and. n_sr_time == 0 .and. n_lr_mode == 0 .and. .not. logic_option(.false., always_allocate)) then +if (n_sr_long == 0 .and. n_sr_trans == 0 .and. n_sr_z == 0 .and. n_lr_mode == 0 .and. .not. logic_option(.false., always_allocate)) then if (associated(wake)) deallocate (wake) return endif @@ -47,9 +47,9 @@ subroutine init_wake (wake, n_sr_long, n_sr_trans, n_sr_time, n_lr_mode, always_ allocate (wake%sr%trans(n_sr_trans)) endif - if (size(wake%sr%time) /= n_sr_time) then - deallocate (wake%sr%time) - allocate (wake%sr%time(n_sr_time)) + if (size(wake%sr%z) /= n_sr_z) then + deallocate (wake%sr%z) + allocate (wake%sr%z(n_sr_z)) endif if (size(wake%lr%mode) /= n_lr_mode) then @@ -61,7 +61,7 @@ subroutine init_wake (wake, n_sr_long, n_sr_trans, n_sr_time, n_lr_mode, always_ allocate (wake) allocate (wake%sr%long(n_sr_long)) allocate (wake%sr%trans(n_sr_trans)) - allocate (wake%sr%time(n_sr_time)) + allocate (wake%sr%z(n_sr_z)) allocate (wake%lr%mode(n_lr_mode)) endif diff --git a/bmad/multiparticle/transfer_wake.f90 b/bmad/multiparticle/transfer_wake.f90 index 821a83343a..bc0c5b591f 100644 --- a/bmad/multiparticle/transfer_wake.f90 +++ b/bmad/multiparticle/transfer_wake.f90 @@ -17,17 +17,17 @@ subroutine transfer_wake (wake_in, wake_out) implicit none type (wake_struct), pointer :: wake_in, wake_out -integer n_sr_long, n_sr_trans, n_sr_time, n_lr_mode, i +integer n_sr_long, n_sr_trans, n_sr_z, n_lr_mode, i ! if (associated (wake_in)) then n_sr_long = size(wake_in%sr%long) n_sr_trans = size(wake_in%sr%trans) - n_sr_time = size(wake_in%sr_time) + n_sr_z = size(wake_in%sr%z) n_lr_mode = size(wake_in%lr%mode) - call init_wake (wake_out, n_sr_long, n_sr_trans, n_sr_time, n_lr_mode, .true.) + call init_wake (wake_out, n_sr_long, n_sr_trans, n_sr_z, n_lr_mode, .true.) wake_out = wake_in else diff --git a/bmad/multiparticle/wake_mod.f90 b/bmad/multiparticle/wake_mod.f90 index ad20d6aedb..6252a368ca 100644 --- a/bmad/multiparticle/wake_mod.f90 +++ b/bmad/multiparticle/wake_mod.f90 @@ -179,7 +179,6 @@ subroutine track1_lr_wake (bunch, ele) omega = twopi * mode%freq f_exp = mode%damp - ff0 = ele%wake%lr%amp_scale * abs(particle%charge) * mode%r_over_q if (mode%polarized) then c_a = cos(twopi*mode%angle) @@ -193,6 +192,7 @@ subroutine track1_lr_wake (bunch, ele) do k = 1, size(bunch%particle) particle => bunch%particle(bunch%ix_z(k)) if (particle%state /= alive$) cycle + ff0 = ele%wake%lr%amp_scale * abs(particle%charge) * mode%r_over_q dt = ele%wake%lr%time_scale * (particle%t - ele%wake%lr%t_ref) dt_phase = dt @@ -219,7 +219,7 @@ subroutine track1_lr_wake (bunch, ele) w_skew = -ky endif - particle%vec(6) = particle%vec(6) + (w_norm * kx0 + w_skew * ky0) * cos(twopi * mode%phi) * ff0 * particle%charge + particle%vec(6) = particle%vec(6) + (w_norm * kx0 + w_skew * ky0) * cos(twopi * mode%phi) endif ! Longitudinal non-self-wake kick @@ -270,6 +270,7 @@ subroutine track1_lr_wake (bunch, ele) mode%b_cos = mode%b_cos + db_cos mode%a_sin = mode%a_sin + da_sin mode%a_cos = mode%a_cos + da_cos + enddo ! Wake modes end subroutine track1_lr_wake @@ -481,7 +482,7 @@ end subroutine sr_transverse_wake_particle !-------------------------------------------------------------------------- !-------------------------------------------------------------------------- !+ -! Subroutine sr_time_wake_particle (ele, orbit, ix_particle) +! Subroutine sr_z_wake_particle (ele, orbit, ix_particle) ! ! Subroutine to apply the short-range time wake kick to a particle and then add ! to the existing time wake the contribution from the particle. @@ -496,15 +497,17 @@ end subroutine sr_transverse_wake_particle ! orbit -- Coord_struct: Ending particle coords. !+ -subroutine sr_time_wake_particle (ele, orbit, ix_particle) +subroutine sr_z_wake_particle (ele, orbit, ix_particle) + +use spline_mod type (ele_struct), target :: ele -type (wake_sr_time_struct), pointer :: srt +type (wake_sr_z_struct), pointer :: srt type (coord_struct) orbit -real(rp) x, f0, ff, w_norm, w_skew -real(rp), parameter :: one_sixth = 1.0_rp / 6.0_rp -integer ix_particle, i, j +real(rp) x, f0, ff, f_add, w_norm, w_skew, dz +integer ix_particle, i, j, ix +logical ok ! @@ -516,11 +519,12 @@ subroutine sr_time_wake_particle (ele, orbit, ix_particle) ! Loop over wakes -do i = 1, size(ele%wake%sr%time) - srt => ele%wake%sr%time(i) +do i = 1, size(ele%wake%sr%z) + srt => ele%wake%sr%z(i) !-------------------------------------------- - select case (srt%plane == z$) ! Longitudinal + select case (srt%plane) + case (z$) ! Longitudinal ! Kick particle from existing wake. call spline_evaluate(srt%w1, orbit%vec(5), ok, w_norm) @@ -548,7 +552,7 @@ subroutine sr_time_wake_particle (ele, orbit, ix_particle) ! Add to wake - select case (mode%position_dependence) + select case (srt%position_dependence) case (none$, x_trailing$, y_trailing$) f_add = f0 case (x_leading$) @@ -576,54 +580,50 @@ subroutine sr_time_wake_particle (ele, orbit, ix_particle) if (srt%plane /= x$) then if (srt%position_dependence == trailing$) then orbit%vec(4) = orbit%vec(4) - w_norm * orbit%vec(3) - else leading + else ! leading orbit%vec(4) = orbit%vec(4) - w_norm endif endif ! Add to wake - if (mode%position_dependence == leading$) then + if (srt%position_dependence == leading$) then + endif end select -And polarizaiton.. - if (ix_particle == 1) then - srt%w_sum%x0 = srt%w%x0 + orbit%vec(5) - srt%w_sum%x1 = srt%w%x1 + orbit%vec(5) - srt%w_sum%y0 = srt%w%y0 - srt%w_sum%coef = srt%w%coef + srt%w1 = srt%w + srt%w1%x0 = srt%w%x0 + orbit%vec(5) + srt%w1%x1 = srt%w%x1 + orbit%vec(5) else - do j = 1, size(srt%w_sum) + do j = 1, size(srt%w1) ! First shift existing wake x = srt%w(j)%x0 + orbit%vec(5) - ok = bracket_index_for_spline(srt%w_sum%x0, x, ix) + ok = bracket_index_for_spline(srt%w1%x0, x, ix) if (ok) then - srt%w_sum(j)%y0 = spline1(srt%w_sum(ix), x) - srt%w_sum(j)%coef(0) = srt%w_sum(j)%y0 - srt%w_sum(j)%coef(1) = spline1(srt%w_sum(j), x, 1) - srt%w_sum(j)%coef(2) = 0.5_rp * spline1(srt%w_sum(j), x, 2) - srt%w_sum(j)%coef(3) = srt%w_sum%coef(3) + srt%w1(j)%y0 = spline1(srt%w1(ix), x) + srt%w1(j)%coef(0) = srt%w1(j)%y0 + srt%w1(j)%coef(1) = spline1(srt%w1(j), x, 1) + srt%w1(j)%coef(2) = 0.5_rp * spline1(srt%w1(j), x, 2) + srt%w1(j)%coef(3) = srt%w1(j)%coef(3) else - srt%w_sum(j)%y0 = 0 - srt%w_sum(j)%coef = 0 + srt%w1(j)%y0 = 0 + srt%w1(j)%coef = 0 endif ! Now add new wake - srt%w_sum(j)%x0 = srt%w%x0 + orbit%vec(5) - srt%w_sum(j)%x1 = srt%w%x1 + orbit%vec(5) - srt%w_sum(j)%y0 = srt%w_sum(j)%y0 + srt%w%y0 - srt%w_sum(j)%coef = srt%w_sum(j)%coef + srt%w%coef + srt%w1(j)%x0 = srt%w(j)%x0 + orbit%vec(5) + srt%w1(j)%x1 = srt%w(j)%x1 + orbit%vec(5) + srt%w1(j)%y0 = srt%w1(j)%y0 + srt%w(j)%y0 + srt%w1(j)%coef = srt%w1(j)%coef + srt%w(j)%coef enddo endif - endif - enddo -end subroutine sr_time_wake_particle +end subroutine sr_z_wake_particle !-------------------------------------------------------------------------- !-------------------------------------------------------------------------- @@ -734,7 +734,7 @@ subroutine track1_sr_wake (bunch, ele) type (ele_struct) ele type (coord_struct), pointer :: particle type (coord_struct), pointer :: p(:) -type (wake_sr_time_struct), pointer :: srt +type (wake_sr_z_struct), pointer :: srt real(rp) sr02 integer i, j, k, i1, i2, n_sr_long, n_sr_trans, k_start, n_live @@ -782,7 +782,7 @@ subroutine track1_sr_wake (bunch, ele) particle => p(bunch%ix_z(j)) ! Particle to kick call sr_longitudinal_wake_particle (ele, particle) call sr_transverse_wake_particle (ele, particle) - call sr_time_wake_particle(ele, particle, j) + call sr_z_wake_particle(ele, particle, j) enddo end subroutine track1_sr_wake diff --git a/bmad/parsing/bmad_parser_mod.f90 b/bmad/parsing/bmad_parser_mod.f90 index cab7639da4..1951101874 100644 --- a/bmad/parsing/bmad_parser_mod.f90 +++ b/bmad/parsing/bmad_parser_mod.f90 @@ -3781,12 +3781,12 @@ subroutine parser_read_sr_wake (ele, delim, delim_found, err_flag) type (lat_struct), pointer :: lat type (wake_sr_mode_struct), target :: trans(100), long(100) type (wake_sr_mode_struct), pointer :: srm -type (wake_sr_time_struct), target :: time(100) -type (wake_sr_time_struct), pointer :: srt +type (wake_sr_z_struct), target :: time(100) +type (wake_sr_z_struct), pointer :: srt type (wake_sr_struct), pointer :: wake_sr real(rp), allocatable :: table(:,:) -integer itrans, ilong, itime, ipt, ix_word +integer i, itrans, ilong, itime, ipt, ix_word logical delim_found, err_flag, err @@ -3798,13 +3798,13 @@ subroutine parser_read_sr_wake (ele, delim, delim_found, err_flag) if (.not. associated(ele%wake)) allocate (ele%wake) if (.not. allocated(ele%wake%lr%mode)) allocate (ele%wake%lr%mode(0)) if (allocated(ele%wake%sr%long)) deallocate (ele%wake%sr%long) -if (allocated(ele%wake%sr%time)) deallocate (ele%wake%sr%time) +if (allocated(ele%wake%sr%z)) deallocate (ele%wake%sr%z) lat => ele%branch%lat wake_sr => ele%wake%sr trans = wake_sr_mode_struct() long = wake_sr_mode_struct() -time = wake_sr_time_struct() +time = wake_sr_z_struct() err_flag = .true. ! get data @@ -3860,16 +3860,17 @@ subroutine parser_read_sr_wake (ele, delim, delim_found, err_flag) select case (attrib_name) case ('W') if (.not. expect_this ('{', .false., .false., 'AFTER "' // trim(attrib_name) // ' =" IN SR_WAKE TIME W DEFINITION', ele, delim, delim_found)) return - if (.not. parse_real_matrix(lat, ele, traim(ele%name) // 'SR_WAKE TIME W LIST', table, 3, delim, delim_found)) return + if (.not. parse_real_matrix(lat, ele, trim(ele%name) // 'SR_WAKE TIME W LIST', table, 3, delim, delim_found)) return ipt = size(table, 1) call reallocate_spline(srt%w, ipt) - call reallocate_spline(srt%w_sum, ipt) + call reallocate_spline(srt%w1, ipt) + call reallocate_spline(srt%w2, ipt) do i = 1, ipt-1 srt%w(i) = create_a_spline(table(i,1:2), table(i+1,1:2), table(i,3), table(i+1,3)) enddo case ('PLANE') - call get_switch ('SR_WAKE TIME PLANE', sr_time_plane_name, srt%plane, err, ele, delim, delim_found); if (err) return + call get_switch ('SR_WAKE TIME PLANE', sr_z_plane_name, srt%plane, err, ele, delim, delim_found); if (err) return case ('POSITION_DEPENDENCE') call get_switch ('SR_WAKE TIME POSITION_DEPENDENCE', sr_longitudinal_position_dep_name, srt%position_dependence, err_flag, ele, delim, delim_found) if (err_flag) return @@ -3906,8 +3907,8 @@ subroutine parser_read_sr_wake (ele, delim, delim_found, err_flag) if (.not. expect_one_of (', ', .false., ele%name, delim, delim_found)) return -allocate (ele%wake%sr%time(itime)) -ele%wake%sr%time = time(1:itime) +allocate (ele%wake%sr%z(itime)) +ele%wake%sr%z = time(1:itime) allocate (ele%wake%sr%long(ilong)) ele%wake%sr%long = long(1:ilong) @@ -3956,7 +3957,7 @@ subroutine parser_read_lr_wake (ele, delim, delim_found, err_flag) ! Init if (.not. associated(ele%wake)) allocate (ele%wake) -if (.not. allocated(ele%wake%sr%time)) allocate (ele%wake%sr%time(0)) +if (.not. allocated(ele%wake%sr%z)) allocate (ele%wake%sr%z(0)) if (.not. allocated(ele%wake%sr%long)) allocate (ele%wake%sr%long(0)) if (.not. allocated(ele%wake%sr%trans)) allocate (ele%wake%sr%trans(0)) if (allocated(ele%wake%lr%mode)) deallocate (ele%wake%lr%mode) diff --git a/bmad/parsing/read_digested_bmad_file.f90 b/bmad/parsing/read_digested_bmad_file.f90 index 64cc8e6dee..cfc6f62e98 100644 --- a/bmad/parsing/read_digested_bmad_file.f90 +++ b/bmad/parsing/read_digested_bmad_file.f90 @@ -500,7 +500,7 @@ subroutine read_this_ele (ele, ix_ele_in, error) integer i, j, lb1, lb2, lb3, ub1, ub2, ub3, n_cyl, n_cart, n_gen, n_grid, ix_ele, ix_branch, ix_wall3d integer i_min(3), i_max(3), ix_ele_in, ix_t(6), ios, k_max, ix_e, n_angle, n_energy integer ix_r, ix_s, n_var, ix_d, ix_m, idum, n_cus, ix_convert, ix_c, nix -integer ix_sr_long, ix_sr_trans, ix_sr_time, ix_lr_mode, ix_wall3d_branch, ix_st(0:3) +integer ix_sr_long, ix_sr_trans, ix_sr_z, ix_lr_mode, ix_wall3d_branch, ix_st(0:3) integer i0, i1, j0, j1, j2, ix_ptr, lb(3), ub(3), nt, n0, n1, n2, nn(7), ne, nr, ns, nc, n_foil logical error, is_alloc_grid, is_alloc_pix, is_alloc_ref_sigma, is_alloc_ref_pi, is_alloc_eprob @@ -512,7 +512,7 @@ subroutine read_this_ele (ele, ix_ele_in, error) read (d_unit, err = 9100, end = 9100) & mode3, ix_r, ix_s, ix_wall3d_branch, ac_kicker_alloc, rad_map_alloc, & - ix_convert, ix_d, ix_m, ix_t, ix_st, ix_e, ix_sr_long, ix_sr_trans, ix_sr_time, & + ix_convert, ix_d, ix_m, ix_t, ix_st, ix_e, ix_sr_long, ix_sr_trans, ix_sr_z, & ix_lr_mode, ix_wall3d, ix_c, n_cart, n_cyl, n_gen, n_grid, n_foil, n_cus, ix_convert read (d_unit, err = 9100, end = 9100) & @@ -873,12 +873,12 @@ subroutine read_this_ele (ele, ix_ele_in, error) ! If ix_lr_mode is negative then it is a pointer to a previously read wake. ! See write_digested_bmad_file. -if (ix_sr_long /= 0 .or. ix_sr_trans /= 0 .or. ix_sr_time /= 0 .or. ix_lr_mode /= 0) then +if (ix_sr_long /= 0 .or. ix_sr_trans /= 0 .or. ix_sr_z /= 0 .or. ix_lr_mode /= 0) then if (ix_lr_mode < 0) then call transfer_wake (ele%branch%ele(abs(ix_lr_mode))%wake, ele%wake) else - call init_wake (ele%wake, ix_sr_long, ix_sr_trans, ix_sr_time, ix_lr_mode) + call init_wake (ele%wake, ix_sr_long, ix_sr_trans, ix_sr_z, ix_lr_mode) wake => ele%wake read (d_unit, err = 9800, end = 9800) wake%sr%z_ref_long, wake%sr%z_ref_trans, wake%sr%z_max, wake%sr%scale_with_length, wake%sr%amp_scale, wake%sr%z_scale do i = 1, size(wake%sr%long) @@ -887,8 +887,8 @@ subroutine read_this_ele (ele, ix_ele_in, error) do i = 1, size(wake%sr%trans) read (d_unit, err = 9800, end = 9800) wake%sr%trans(i) enddo - do i = 1, size(wake%sr%time) - read (d_unit, err = 9800, end = 9800) wake%sr%time(i) + do i = 1, size(wake%sr%z) + read (d_unit, err = 9800, end = 9800) wake%sr%z(i) enddo read (d_unit, err = 9800, end = 9800) wake%lr%t_ref, wake%lr%freq_spread, wake%lr%self_wake_on, wake%lr%amp_scale, wake%lr%time_scale diff --git a/bmad/parsing/write_digested_bmad_file.f90 b/bmad/parsing/write_digested_bmad_file.f90 index 8e92355a5d..8cb4e16cea 100644 --- a/bmad/parsing/write_digested_bmad_file.f90 +++ b/bmad/parsing/write_digested_bmad_file.f90 @@ -231,7 +231,7 @@ subroutine write_this_ele (ele) type (control_ramp1_struct), pointer ::rmp integer ix_wall3d, ix_r, ix_d, ix_m, ix_e, ix_t(6), ix_st(0:3), ie, ib, ix_wall3d_branch -integer ix_sr_long, ix_sr_trans, ix_sr_time, ix_lr_mode, ie_max, ix_s, n_var, ix_ptr, im, n1, n2 +integer ix_sr_long, ix_sr_trans, ix_sr_z, ix_lr_mode, ie_max, ix_s, n_var, ix_ptr, im, n1, n2 integer i, j, k, n, nr, n_gen, n_grid, n_cart, n_cyl, ix_ele, ix_c, ix_branch integer n_cus, ix_convert, n_energy, n_angle, n_foil @@ -240,7 +240,7 @@ subroutine write_this_ele (ele) ! ix_d = 0; ix_m = 0; ix_e = 0; ix_t = -1; ix_r = 0; ix_s = 0 -ix_sr_long = 0; ix_sr_trans = 0; ix_sr_time, ix_lr_mode = 0; ix_st = -1 +ix_sr_long = 0; ix_sr_trans = 0; ix_sr_z = 0; ix_lr_mode = 0; ix_st = -1 mode3 = .false.; ix_wall3d = 0; ix_convert = 0; ix_c = 0 n_cart = 0; n_gen = 0; n_grid = 0; n_cyl = 0; n_cus = 0; n_foil = 0 @@ -281,7 +281,7 @@ subroutine write_this_ele (ele) if (write_wake) then if (allocated(wake%sr%long)) ix_sr_long = size(wake%sr%long) if (allocated(wake%sr%trans)) ix_sr_trans = size(wake%sr%trans) - if (allocated(wake%sr%time)) ix_sr_time = size(wake%sr%time) + if (allocated(wake%sr%z)) ix_sr_z = size(wake%sr%z) if (allocated(wake%lr%mode)) ix_lr_mode = size(wake%lr%mode) n_wake = n_wake + 1 if (n_wake > size(ix_ele_wake)) call re_allocate(ix_ele_wake, 2*size(ix_ele_wake)) @@ -319,7 +319,7 @@ subroutine write_this_ele (ele) ! The last zero is for future use. write (d_unit) mode3, ix_r, ix_s, ix_wall3d_branch, associated(ele%ac_kick), associated(ele%rad_map), & - ix_convert, ix_d, ix_m, ix_t, ix_st, ix_e, ix_sr_long, ix_sr_trans, & + ix_convert, ix_d, ix_m, ix_t, ix_st, ix_e, ix_sr_long, ix_sr_trans, ix_sr_z, & ix_lr_mode, ix_wall3d, ix_c, n_cart, n_cyl, n_gen, n_grid, n_foil, n_cus, ix_convert write (d_unit) & diff --git a/cpp_bmad_interface/code/bmad_cpp_convert_mod.f90 b/cpp_bmad_interface/code/bmad_cpp_convert_mod.f90 index 4879579333..12689f40e4 100644 --- a/cpp_bmad_interface/code/bmad_cpp_convert_mod.f90 +++ b/cpp_bmad_interface/code/bmad_cpp_convert_mod.f90 @@ -134,7 +134,7 @@ subroutine expression_atom_to_f (C, Fp) bind(c) !-------------------------------------------------------------------------- interface - subroutine wake_sr_time_to_f (C, Fp) bind(c) + subroutine wake_sr_z_to_f (C, Fp) bind(c) import c_ptr type(c_ptr), value :: C, Fp end subroutine @@ -2243,102 +2243,154 @@ end subroutine expression_atom_to_f2 !-------------------------------------------------------------------------- !-------------------------------------------------------------------------- !+ -! Subroutine wake_sr_time_to_c (Fp, C) bind(c) +! Subroutine wake_sr_z_to_c (Fp, C) bind(c) ! -! Routine to convert a Bmad wake_sr_time_struct to a C++ CPP_wake_sr_time structure +! Routine to convert a Bmad wake_sr_z_struct to a C++ CPP_wake_sr_z structure ! ! Input: -! Fp -- type(c_ptr), value :: Input Bmad wake_sr_time_struct structure. +! Fp -- type(c_ptr), value :: Input Bmad wake_sr_z_struct structure. ! ! Output: -! C -- type(c_ptr), value :: Output C++ CPP_wake_sr_time struct. +! C -- type(c_ptr), value :: Output C++ CPP_wake_sr_z struct. !- -subroutine wake_sr_time_to_c (Fp, C) bind(c) +subroutine wake_sr_z_to_c (Fp, C) bind(c) implicit none interface !! f_side.to_c2_f2_sub_arg - subroutine wake_sr_time_to_c2 (C, z_wake, n1_wake, z_plane, z_position_dependence) bind(c) + subroutine wake_sr_z_to_c2 (C, z_w, n1_w, z_w1, n1_w1, z_w2, n1_w2, z_plane, & + z_position_dependence) bind(c) import c_bool, c_double, c_ptr, c_char, c_int, c_long, c_double_complex !! f_side.to_c2_type :: f_side.to_c2_name type(c_ptr), value :: C - type(c_ptr) :: z_wake(*) - integer(c_int), value :: n1_wake + type(c_ptr) :: z_w(*), z_w1(*), z_w2(*) + integer(c_int), value :: n1_w, n1_w1, n1_w2 integer(c_int) :: z_plane, z_position_dependence end subroutine end interface type(c_ptr), value :: Fp type(c_ptr), value :: C -type(wake_sr_time_struct), pointer :: F +type(wake_sr_z_struct), pointer :: F integer jd, jd1, jd2, jd3, lb1, lb2, lb3 !! f_side.to_c_var -type(c_ptr), allocatable :: z_wake(:) -integer(c_int) :: n1_wake +type(c_ptr), allocatable :: z_w(:) +integer(c_int) :: n1_w +type(c_ptr), allocatable :: z_w1(:) +integer(c_int) :: n1_w1 +type(c_ptr), allocatable :: z_w2(:) +integer(c_int) :: n1_w2 ! call c_f_pointer (Fp, F) !! f_side.to_c_trans[type, 1, ALLOC] - n1_wake = 0 -if (allocated(F%wake)) then - n1_wake = size(F%wake); lb1 = lbound(F%wake, 1) - 1 - allocate (z_wake(n1_wake)) - do jd1 = 1, n1_wake - z_wake(jd1) = c_loc(F%wake(jd1+lb1)) + n1_w = 0 +if (allocated(F%w)) then + n1_w = size(F%w); lb1 = lbound(F%w, 1) - 1 + allocate (z_w(n1_w)) + do jd1 = 1, n1_w + z_w(jd1) = c_loc(F%w(jd1+lb1)) + enddo +endif +!! f_side.to_c_trans[type, 1, ALLOC] + n1_w1 = 0 +if (allocated(F%w1)) then + n1_w1 = size(F%w1); lb1 = lbound(F%w1, 1) - 1 + allocate (z_w1(n1_w1)) + do jd1 = 1, n1_w1 + z_w1(jd1) = c_loc(F%w1(jd1+lb1)) + enddo +endif +!! f_side.to_c_trans[type, 1, ALLOC] + n1_w2 = 0 +if (allocated(F%w2)) then + n1_w2 = size(F%w2); lb1 = lbound(F%w2, 1) - 1 + allocate (z_w2(n1_w2)) + do jd1 = 1, n1_w2 + z_w2(jd1) = c_loc(F%w2(jd1+lb1)) enddo endif !! f_side.to_c2_call -call wake_sr_time_to_c2 (C, z_wake, n1_wake, F%plane, F%position_dependence) +call wake_sr_z_to_c2 (C, z_w, n1_w, z_w1, n1_w1, z_w2, n1_w2, F%plane, F%position_dependence) -end subroutine wake_sr_time_to_c +end subroutine wake_sr_z_to_c !-------------------------------------------------------------------------- !-------------------------------------------------------------------------- !+ -! Subroutine wake_sr_time_to_f2 (Fp, ...etc...) bind(c) +! Subroutine wake_sr_z_to_f2 (Fp, ...etc...) bind(c) ! -! Routine used in converting a C++ CPP_wake_sr_time structure to a Bmad wake_sr_time_struct structure. -! This routine is called by wake_sr_time_to_c and is not meant to be called directly. +! Routine used in converting a C++ CPP_wake_sr_z structure to a Bmad wake_sr_z_struct structure. +! This routine is called by wake_sr_z_to_c and is not meant to be called directly. ! ! Input: -! ...etc... -- Components of the structure. See the wake_sr_time_to_f2 code for more details. +! ...etc... -- Components of the structure. See the wake_sr_z_to_f2 code for more details. ! ! Output: -! Fp -- type(c_ptr), value :: Bmad wake_sr_time_struct structure. +! Fp -- type(c_ptr), value :: Bmad wake_sr_z_struct structure. !- !! f_side.to_c2_f2_sub_arg -subroutine wake_sr_time_to_f2 (Fp, z_wake, n1_wake, z_plane, z_position_dependence) bind(c) +subroutine wake_sr_z_to_f2 (Fp, z_w, n1_w, z_w1, n1_w1, z_w2, n1_w2, z_plane, & + z_position_dependence) bind(c) implicit none type(c_ptr), value :: Fp -type(wake_sr_time_struct), pointer :: F +type(wake_sr_z_struct), pointer :: F integer jd, jd1, jd2, jd3, lb1, lb2, lb3 !! f_side.to_f2_var && f_side.to_f2_type :: f_side.to_f2_name -type(c_ptr) :: z_wake(*) -integer(c_int), value :: n1_wake +type(c_ptr) :: z_w(*), z_w1(*), z_w2(*) +integer(c_int), value :: n1_w, n1_w1, n1_w2 integer(c_int) :: z_plane, z_position_dependence call c_f_pointer (Fp, F) !! f_side.to_f2_trans[type, 1, ALLOC] -if (n1_wake == 0) then - if (allocated(F%wake)) deallocate(F%wake) +if (n1_w == 0) then + if (allocated(F%w)) deallocate(F%w) +else + if (allocated(F%w)) then + if (n1_w == 0 .or. any(shape(F%w) /= [n1_w])) deallocate(F%w) + if (any(lbound(F%w) /= 1)) deallocate(F%w) + endif + if (.not. allocated(F%w)) allocate(F%w(1:n1_w+1-1)) + do jd1 = 1, n1_w + call spline_to_f (z_w(jd1), c_loc(F%w(jd1+1-1))) + enddo +endif + +!! f_side.to_f2_trans[type, 1, ALLOC] +if (n1_w1 == 0) then + if (allocated(F%w1)) deallocate(F%w1) +else + if (allocated(F%w1)) then + if (n1_w1 == 0 .or. any(shape(F%w1) /= [n1_w1])) deallocate(F%w1) + if (any(lbound(F%w1) /= 1)) deallocate(F%w1) + endif + if (.not. allocated(F%w1)) allocate(F%w1(1:n1_w1+1-1)) + do jd1 = 1, n1_w1 + call spline_to_f (z_w1(jd1), c_loc(F%w1(jd1+1-1))) + enddo +endif + +!! f_side.to_f2_trans[type, 1, ALLOC] +if (n1_w2 == 0) then + if (allocated(F%w2)) deallocate(F%w2) else - if (allocated(F%wake)) then - if (n1_wake == 0 .or. any(shape(F%wake) /= [n1_wake])) deallocate(F%wake) - if (any(lbound(F%wake) /= 1)) deallocate(F%wake) + if (allocated(F%w2)) then + if (n1_w2 == 0 .or. any(shape(F%w2) /= [n1_w2])) deallocate(F%w2) + if (any(lbound(F%w2) /= 1)) deallocate(F%w2) endif - if (.not. allocated(F%wake)) allocate(F%wake(1:n1_wake+1-1)) - do jd1 = 1, n1_wake - call spline_to_f (z_wake(jd1), c_loc(F%wake(jd1+1-1))) + if (.not. allocated(F%w2)) allocate(F%w2(1:n1_w2+1-1)) + do jd1 = 1, n1_w2 + call spline_to_f (z_w2(jd1), c_loc(F%w2(jd1+1-1))) enddo endif @@ -2347,7 +2399,7 @@ subroutine wake_sr_time_to_f2 (Fp, z_wake, n1_wake, z_plane, z_position_dependen !! f_side.to_f2_trans[integer, 0, NOT] F%position_dependence = z_position_dependence -end subroutine wake_sr_time_to_f2 +end subroutine wake_sr_z_to_f2 !-------------------------------------------------------------------------- !-------------------------------------------------------------------------- @@ -2474,15 +2526,15 @@ subroutine wake_sr_to_c (Fp, C) bind(c) interface !! f_side.to_c2_f2_sub_arg - subroutine wake_sr_to_c2 (C, z_file, z_time, n1_time, z_long, n1_long, z_trans, n1_trans, & + subroutine wake_sr_to_c2 (C, z_file, z_z, n1_z, z_long, n1_long, z_trans, n1_trans, & z_z_ref_long, z_z_ref_trans, z_z_max, z_amp_scale, z_z_scale, z_scale_with_length) & bind(c) import c_bool, c_double, c_ptr, c_char, c_int, c_long, c_double_complex !! f_side.to_c2_type :: f_side.to_c2_name type(c_ptr), value :: C character(c_char) :: z_file(*) - type(c_ptr) :: z_time(*), z_long(*), z_trans(*) - integer(c_int), value :: n1_time, n1_long, n1_trans + type(c_ptr) :: z_z(*), z_long(*), z_trans(*) + integer(c_int), value :: n1_z, n1_long, n1_trans real(c_double) :: z_z_ref_long, z_z_ref_trans, z_z_max, z_amp_scale, z_z_scale logical(c_bool) :: z_scale_with_length end subroutine @@ -2493,8 +2545,8 @@ subroutine wake_sr_to_c2 (C, z_file, z_time, n1_time, z_long, n1_long, z_trans, type(wake_sr_struct), pointer :: F integer jd, jd1, jd2, jd3, lb1, lb2, lb3 !! f_side.to_c_var -type(c_ptr), allocatable :: z_time(:) -integer(c_int) :: n1_time +type(c_ptr), allocatable :: z_z(:) +integer(c_int) :: n1_z type(c_ptr), allocatable :: z_long(:) integer(c_int) :: n1_long type(c_ptr), allocatable :: z_trans(:) @@ -2505,12 +2557,12 @@ subroutine wake_sr_to_c2 (C, z_file, z_time, n1_time, z_long, n1_long, z_trans, call c_f_pointer (Fp, F) !! f_side.to_c_trans[type, 1, ALLOC] - n1_time = 0 -if (allocated(F%time)) then - n1_time = size(F%time); lb1 = lbound(F%time, 1) - 1 - allocate (z_time(n1_time)) - do jd1 = 1, n1_time - z_time(jd1) = c_loc(F%time(jd1+lb1)) + n1_z = 0 +if (allocated(F%z)) then + n1_z = size(F%z); lb1 = lbound(F%z, 1) - 1 + allocate (z_z(n1_z)) + do jd1 = 1, n1_z + z_z(jd1) = c_loc(F%z(jd1+lb1)) enddo endif !! f_side.to_c_trans[type, 1, ALLOC] @@ -2533,7 +2585,7 @@ subroutine wake_sr_to_c2 (C, z_file, z_time, n1_time, z_long, n1_long, z_trans, endif !! f_side.to_c2_call -call wake_sr_to_c2 (C, trim(F%file) // c_null_char, z_time, n1_time, z_long, n1_long, z_trans, & +call wake_sr_to_c2 (C, trim(F%file) // c_null_char, z_z, n1_z, z_long, n1_long, z_trans, & n1_trans, F%z_ref_long, F%z_ref_trans, F%z_max, F%amp_scale, F%z_scale, & c_logic(F%scale_with_length)) @@ -2555,7 +2607,7 @@ end subroutine wake_sr_to_c !- !! f_side.to_c2_f2_sub_arg -subroutine wake_sr_to_f2 (Fp, z_file, z_time, n1_time, z_long, n1_long, z_trans, n1_trans, & +subroutine wake_sr_to_f2 (Fp, z_file, z_z, n1_z, z_long, n1_long, z_trans, n1_trans, & z_z_ref_long, z_z_ref_trans, z_z_max, z_amp_scale, z_z_scale, z_scale_with_length) bind(c) @@ -2566,8 +2618,8 @@ subroutine wake_sr_to_f2 (Fp, z_file, z_time, n1_time, z_long, n1_long, z_trans, integer jd, jd1, jd2, jd3, lb1, lb2, lb3 !! f_side.to_f2_var && f_side.to_f2_type :: f_side.to_f2_name character(c_char) :: z_file(*) -type(c_ptr) :: z_time(*), z_long(*), z_trans(*) -integer(c_int), value :: n1_time, n1_long, n1_trans +type(c_ptr) :: z_z(*), z_long(*), z_trans(*) +integer(c_int), value :: n1_z, n1_long, n1_trans real(c_double) :: z_z_ref_long, z_z_ref_trans, z_z_max, z_amp_scale, z_z_scale logical(c_bool) :: z_scale_with_length @@ -2576,16 +2628,16 @@ subroutine wake_sr_to_f2 (Fp, z_file, z_time, n1_time, z_long, n1_long, z_trans, !! f_side.to_f2_trans[character, 0, NOT] call to_f_str(z_file, F%file) !! f_side.to_f2_trans[type, 1, ALLOC] -if (n1_time == 0) then - if (allocated(F%time)) deallocate(F%time) +if (n1_z == 0) then + if (allocated(F%z)) deallocate(F%z) else - if (allocated(F%time)) then - if (n1_time == 0 .or. any(shape(F%time) /= [n1_time])) deallocate(F%time) - if (any(lbound(F%time) /= 1)) deallocate(F%time) + if (allocated(F%z)) then + if (n1_z == 0 .or. any(shape(F%z) /= [n1_z])) deallocate(F%z) + if (any(lbound(F%z) /= 1)) deallocate(F%z) endif - if (.not. allocated(F%time)) allocate(F%time(1:n1_time+1-1)) - do jd1 = 1, n1_time - call wake_sr_time_to_f (z_time(jd1), c_loc(F%time(jd1+1-1))) + if (.not. allocated(F%z)) allocate(F%z(1:n1_z+1-1)) + do jd1 = 1, n1_z + call wake_sr_z_to_f (z_z(jd1), c_loc(F%z(jd1+1-1))) enddo endif diff --git a/cpp_bmad_interface/code/cpp_bmad_convert.cpp b/cpp_bmad_interface/code/cpp_bmad_convert.cpp index ea45389ba7..c12c2eea38 100644 --- a/cpp_bmad_interface/code/cpp_bmad_convert.cpp +++ b/cpp_bmad_interface/code/cpp_bmad_convert.cpp @@ -580,37 +580,64 @@ extern "C" void expression_atom_to_c2 (CPP_expression_atom& C, c_Char z_name, c_ //-------------------------------------------------------------------- //-------------------------------------------------------------------- -// CPP_wake_sr_time +// CPP_wake_sr_z -extern "C" void wake_sr_time_to_c (const Opaque_wake_sr_time_class*, CPP_wake_sr_time&); +extern "C" void wake_sr_z_to_c (const Opaque_wake_sr_z_class*, CPP_wake_sr_z&); // c_side.to_f2_arg -extern "C" void wake_sr_time_to_f2 (Opaque_wake_sr_time_class*, const CPP_spline**, Int, - c_Int&, c_Int&); +extern "C" void wake_sr_z_to_f2 (Opaque_wake_sr_z_class*, const CPP_spline**, Int, const + CPP_spline**, Int, const CPP_spline**, Int, c_Int&, c_Int&); -extern "C" void wake_sr_time_to_f (const CPP_wake_sr_time& C, Opaque_wake_sr_time_class* F) { +extern "C" void wake_sr_z_to_f (const CPP_wake_sr_z& C, Opaque_wake_sr_z_class* F) { + // c_side.to_f_setup[type, 1, ALLOC] + int n1_w = C.w.size(); + const CPP_spline** z_w = NULL; + if (n1_w != 0) { + z_w = new const CPP_spline*[n1_w]; + for (int i = 0; i < n1_w; i++) z_w[i] = &C.w[i]; + } // c_side.to_f_setup[type, 1, ALLOC] - int n1_wake = C.wake.size(); - const CPP_spline** z_wake = NULL; - if (n1_wake != 0) { - z_wake = new const CPP_spline*[n1_wake]; - for (int i = 0; i < n1_wake; i++) z_wake[i] = &C.wake[i]; + int n1_w1 = C.w1.size(); + const CPP_spline** z_w1 = NULL; + if (n1_w1 != 0) { + z_w1 = new const CPP_spline*[n1_w1]; + for (int i = 0; i < n1_w1; i++) z_w1[i] = &C.w1[i]; + } + // c_side.to_f_setup[type, 1, ALLOC] + int n1_w2 = C.w2.size(); + const CPP_spline** z_w2 = NULL; + if (n1_w2 != 0) { + z_w2 = new const CPP_spline*[n1_w2]; + for (int i = 0; i < n1_w2; i++) z_w2[i] = &C.w2[i]; } // c_side.to_f2_call - wake_sr_time_to_f2 (F, z_wake, n1_wake, C.plane, C.position_dependence); + wake_sr_z_to_f2 (F, z_w, n1_w, z_w1, n1_w1, z_w2, n1_w2, C.plane, C.position_dependence); // c_side.to_f_cleanup[type, 1, ALLOC] - delete[] z_wake; + delete[] z_w; + // c_side.to_f_cleanup[type, 1, ALLOC] + delete[] z_w1; + // c_side.to_f_cleanup[type, 1, ALLOC] + delete[] z_w2; } // c_side.to_c2_arg -extern "C" void wake_sr_time_to_c2 (CPP_wake_sr_time& C, Opaque_spline_class** z_wake, Int - n1_wake, c_Int& z_plane, c_Int& z_position_dependence) { +extern "C" void wake_sr_z_to_c2 (CPP_wake_sr_z& C, Opaque_spline_class** z_w, Int n1_w, + Opaque_spline_class** z_w1, Int n1_w1, Opaque_spline_class** z_w2, Int n1_w2, c_Int& + z_plane, c_Int& z_position_dependence) { + + // c_side.to_c2_set[type, 1, ALLOC] + C.w.resize(n1_w); + for (int i = 0; i < n1_w; i++) spline_to_c(z_w[i], C.w[i]); + + // c_side.to_c2_set[type, 1, ALLOC] + C.w1.resize(n1_w1); + for (int i = 0; i < n1_w1; i++) spline_to_c(z_w1[i], C.w1[i]); // c_side.to_c2_set[type, 1, ALLOC] - C.wake.resize(n1_wake); - for (int i = 0; i < n1_wake; i++) spline_to_c(z_wake[i], C.wake[i]); + C.w2.resize(n1_w2); + for (int i = 0; i < n1_w2; i++) spline_to_c(z_w2[i], C.w2[i]); // c_side.to_c2_set[integer, 0, NOT] C.plane = z_plane; @@ -670,17 +697,17 @@ extern "C" void wake_sr_mode_to_c2 (CPP_wake_sr_mode& C, c_Real& z_amp, c_Real& extern "C" void wake_sr_to_c (const Opaque_wake_sr_class*, CPP_wake_sr&); // c_side.to_f2_arg -extern "C" void wake_sr_to_f2 (Opaque_wake_sr_class*, c_Char, const CPP_wake_sr_time**, Int, - const CPP_wake_sr_mode**, Int, const CPP_wake_sr_mode**, Int, c_Real&, c_Real&, c_Real&, - c_Real&, c_Real&, c_Bool&); +extern "C" void wake_sr_to_f2 (Opaque_wake_sr_class*, c_Char, const CPP_wake_sr_z**, Int, const + CPP_wake_sr_mode**, Int, const CPP_wake_sr_mode**, Int, c_Real&, c_Real&, c_Real&, c_Real&, + c_Real&, c_Bool&); extern "C" void wake_sr_to_f (const CPP_wake_sr& C, Opaque_wake_sr_class* F) { // c_side.to_f_setup[type, 1, ALLOC] - int n1_time = C.time.size(); - const CPP_wake_sr_time** z_time = NULL; - if (n1_time != 0) { - z_time = new const CPP_wake_sr_time*[n1_time]; - for (int i = 0; i < n1_time; i++) z_time[i] = &C.time[i]; + int n1_z = C.z.size(); + const CPP_wake_sr_z** z_z = NULL; + if (n1_z != 0) { + z_z = new const CPP_wake_sr_z*[n1_z]; + for (int i = 0; i < n1_z; i++) z_z[i] = &C.z[i]; } // c_side.to_f_setup[type, 1, ALLOC] int n1_long_wake = C.long_wake.size(); @@ -698,12 +725,12 @@ extern "C" void wake_sr_to_f (const CPP_wake_sr& C, Opaque_wake_sr_class* F) { } // c_side.to_f2_call - wake_sr_to_f2 (F, C.file.c_str(), z_time, n1_time, z_long_wake, n1_long_wake, z_trans_wake, + wake_sr_to_f2 (F, C.file.c_str(), z_z, n1_z, z_long_wake, n1_long_wake, z_trans_wake, n1_trans_wake, C.z_ref_long, C.z_ref_trans, C.z_max, C.amp_scale, C.z_scale, C.scale_with_length); // c_side.to_f_cleanup[type, 1, ALLOC] - delete[] z_time; + delete[] z_z; // c_side.to_f_cleanup[type, 1, ALLOC] delete[] z_long_wake; // c_side.to_f_cleanup[type, 1, ALLOC] @@ -711,8 +738,8 @@ extern "C" void wake_sr_to_f (const CPP_wake_sr& C, Opaque_wake_sr_class* F) { } // c_side.to_c2_arg -extern "C" void wake_sr_to_c2 (CPP_wake_sr& C, c_Char z_file, Opaque_wake_sr_time_class** - z_time, Int n1_time, Opaque_wake_sr_mode_class** z_long_wake, Int n1_long_wake, +extern "C" void wake_sr_to_c2 (CPP_wake_sr& C, c_Char z_file, Opaque_wake_sr_z_class** z_z, Int + n1_z, Opaque_wake_sr_mode_class** z_long_wake, Int n1_long_wake, Opaque_wake_sr_mode_class** z_trans_wake, Int n1_trans_wake, c_Real& z_z_ref_long, c_Real& z_z_ref_trans, c_Real& z_z_max, c_Real& z_amp_scale, c_Real& z_z_scale, c_Bool& z_scale_with_length) { @@ -720,8 +747,8 @@ extern "C" void wake_sr_to_c2 (CPP_wake_sr& C, c_Char z_file, Opaque_wake_sr_tim // c_side.to_c2_set[character, 0, NOT] C.file = z_file; // c_side.to_c2_set[type, 1, ALLOC] - C.time.resize(n1_time); - for (int i = 0; i < n1_time; i++) wake_sr_time_to_c(z_time[i], C.time[i]); + C.z.resize(n1_z); + for (int i = 0; i < n1_z; i++) wake_sr_z_to_c(z_z[i], C.z[i]); // c_side.to_c2_set[type, 1, ALLOC] C.long_wake.resize(n1_long_wake); diff --git a/cpp_bmad_interface/code/cpp_equality.cpp b/cpp_bmad_interface/code/cpp_equality.cpp index a17e3b2e72..aa4ee38780 100644 --- a/cpp_bmad_interface/code/cpp_equality.cpp +++ b/cpp_bmad_interface/code/cpp_equality.cpp @@ -276,16 +276,18 @@ template bool is_all_equal (const CPP_expression_atom_MATRIX&, const CPP_express //-------------------------------------------------------------- -bool operator== (const CPP_wake_sr_time& x, const CPP_wake_sr_time& y) { +bool operator== (const CPP_wake_sr_z& x, const CPP_wake_sr_z& y) { bool is_eq = true; - is_eq = is_eq && is_all_equal(x.wake, y.wake); + is_eq = is_eq && is_all_equal(x.w, y.w); + is_eq = is_eq && is_all_equal(x.w1, y.w1); + is_eq = is_eq && is_all_equal(x.w2, y.w2); is_eq = is_eq && (x.plane == y.plane); is_eq = is_eq && (x.position_dependence == y.position_dependence); return is_eq; }; -template bool is_all_equal (const CPP_wake_sr_time_ARRAY&, const CPP_wake_sr_time_ARRAY&); -template bool is_all_equal (const CPP_wake_sr_time_MATRIX&, const CPP_wake_sr_time_MATRIX&); +template bool is_all_equal (const CPP_wake_sr_z_ARRAY&, const CPP_wake_sr_z_ARRAY&); +template bool is_all_equal (const CPP_wake_sr_z_MATRIX&, const CPP_wake_sr_z_MATRIX&); //-------------------------------------------------------------- @@ -312,7 +314,7 @@ template bool is_all_equal (const CPP_wake_sr_mode_MATRIX&, const CPP_wake_sr_mo bool operator== (const CPP_wake_sr& x, const CPP_wake_sr& y) { bool is_eq = true; is_eq = is_eq && (x.file == y.file); - is_eq = is_eq && is_all_equal(x.time, y.time); + is_eq = is_eq && is_all_equal(x.z, y.z); is_eq = is_eq && is_all_equal(x.long_wake, y.long_wake); is_eq = is_eq && is_all_equal(x.trans_wake, y.trans_wake); is_eq = is_eq && (x.z_ref_long == y.z_ref_long); diff --git a/cpp_bmad_interface/include/cpp_bmad_classes.h b/cpp_bmad_interface/include/cpp_bmad_classes.h index 41ad5da443..916e41d8b9 100644 --- a/cpp_bmad_interface/include/cpp_bmad_classes.h +++ b/cpp_bmad_interface/include/cpp_bmad_classes.h @@ -81,10 +81,10 @@ typedef valarray CPP_expression_atom_ARRAY; typedef valarray CPP_expression_atom_MATRIX; typedef valarray CPP_expression_atom_TENSOR; -class CPP_wake_sr_time; -typedef valarray CPP_wake_sr_time_ARRAY; -typedef valarray CPP_wake_sr_time_MATRIX; -typedef valarray CPP_wake_sr_time_TENSOR; +class CPP_wake_sr_z; +typedef valarray CPP_wake_sr_z_ARRAY; +typedef valarray CPP_wake_sr_z_MATRIX; +typedef valarray CPP_wake_sr_z_TENSOR; class CPP_wake_sr_mode; typedef valarray CPP_wake_sr_mode_ARRAY; @@ -901,31 +901,35 @@ bool operator== (const CPP_expression_atom&, const CPP_expression_atom&); //-------------------------------------------------------------------- -// CPP_wake_sr_time +// CPP_wake_sr_z -class Opaque_wake_sr_time_class {}; // Opaque class for pointers to corresponding fortran structs. +class Opaque_wake_sr_z_class {}; // Opaque class for pointers to corresponding fortran structs. -class CPP_wake_sr_time { +class CPP_wake_sr_z { public: - CPP_spline_ARRAY wake; + CPP_spline_ARRAY w; + CPP_spline_ARRAY w1; + CPP_spline_ARRAY w2; Int plane; Int position_dependence; - CPP_wake_sr_time() : - wake(CPP_spline_ARRAY(CPP_spline(), 0)), + CPP_wake_sr_z() : + w(CPP_spline_ARRAY(CPP_spline(), 0)), + w1(CPP_spline_ARRAY(CPP_spline(), 0)), + w2(CPP_spline_ARRAY(CPP_spline(), 0)), plane(Bmad::NOT_SET), position_dependence(Bmad::NOT_SET) {} - ~CPP_wake_sr_time() { + ~CPP_wake_sr_z() { } }; // End Class -extern "C" void wake_sr_time_to_c (const Opaque_wake_sr_time_class*, CPP_wake_sr_time&); -extern "C" void wake_sr_time_to_f (const CPP_wake_sr_time&, Opaque_wake_sr_time_class*); +extern "C" void wake_sr_z_to_c (const Opaque_wake_sr_z_class*, CPP_wake_sr_z&); +extern "C" void wake_sr_z_to_f (const CPP_wake_sr_z&, Opaque_wake_sr_z_class*); -bool operator== (const CPP_wake_sr_time&, const CPP_wake_sr_time&); +bool operator== (const CPP_wake_sr_z&, const CPP_wake_sr_z&); //-------------------------------------------------------------------- @@ -978,7 +982,7 @@ class Opaque_wake_sr_class {}; // Opaque class for pointers to corresponding fo class CPP_wake_sr { public: string file; - CPP_wake_sr_time_ARRAY time; + CPP_wake_sr_z_ARRAY z; CPP_wake_sr_mode_ARRAY long_wake; CPP_wake_sr_mode_ARRAY trans_wake; Real z_ref_long; @@ -990,7 +994,7 @@ class CPP_wake_sr { CPP_wake_sr() : file(), - time(CPP_wake_sr_time_ARRAY(CPP_wake_sr_time(), 0)), + z(CPP_wake_sr_z_ARRAY(CPP_wake_sr_z(), 0)), long_wake(CPP_wake_sr_mode_ARRAY(CPP_wake_sr_mode(), 0)), trans_wake(CPP_wake_sr_mode_ARRAY(CPP_wake_sr_mode(), 0)), z_ref_long(0.0), diff --git a/cpp_bmad_interface/interface_test/bmad_cpp_test_mod.f90 b/cpp_bmad_interface/interface_test/bmad_cpp_test_mod.f90 index 46b98f6f0e..0286ce583b 100644 --- a/cpp_bmad_interface/interface_test/bmad_cpp_test_mod.f90 +++ b/cpp_bmad_interface/interface_test/bmad_cpp_test_mod.f90 @@ -1361,18 +1361,18 @@ end subroutine set_expression_atom_test_pattern !--------------------------------------------------------------------------------- !--------------------------------------------------------------------------------- -subroutine test1_f_wake_sr_time (ok) +subroutine test1_f_wake_sr_z (ok) implicit none -type(wake_sr_time_struct), target :: f_wake_sr_time, f2_wake_sr_time +type(wake_sr_z_struct), target :: f_wake_sr_z, f2_wake_sr_z logical(c_bool) c_ok logical ok interface - subroutine test_c_wake_sr_time (c_wake_sr_time, c_ok) bind(c) + subroutine test_c_wake_sr_z (c_wake_sr_z, c_ok) bind(c) import c_ptr, c_bool - type(c_ptr), value :: c_wake_sr_time + type(c_ptr), value :: c_wake_sr_z logical(c_bool) c_ok end subroutine end interface @@ -1380,58 +1380,58 @@ subroutine test_c_wake_sr_time (c_wake_sr_time, c_ok) bind(c) ! ok = .true. -call set_wake_sr_time_test_pattern (f2_wake_sr_time, 1) +call set_wake_sr_z_test_pattern (f2_wake_sr_z, 1) -call test_c_wake_sr_time(c_loc(f2_wake_sr_time), c_ok) +call test_c_wake_sr_z(c_loc(f2_wake_sr_z), c_ok) if (.not. f_logic(c_ok)) ok = .false. -call set_wake_sr_time_test_pattern (f_wake_sr_time, 4) -if (f_wake_sr_time == f2_wake_sr_time) then - print *, 'wake_sr_time: C side convert C->F: Good' +call set_wake_sr_z_test_pattern (f_wake_sr_z, 4) +if (f_wake_sr_z == f2_wake_sr_z) then + print *, 'wake_sr_z: C side convert C->F: Good' else - print *, 'wake_sr_time: C SIDE CONVERT C->F: FAILED!' + print *, 'wake_sr_z: C SIDE CONVERT C->F: FAILED!' ok = .false. endif -end subroutine test1_f_wake_sr_time +end subroutine test1_f_wake_sr_z !--------------------------------------------------------------------------------- !--------------------------------------------------------------------------------- -subroutine test2_f_wake_sr_time (c_wake_sr_time, c_ok) bind(c) +subroutine test2_f_wake_sr_z (c_wake_sr_z, c_ok) bind(c) implicit none -type(c_ptr), value :: c_wake_sr_time -type(wake_sr_time_struct), target :: f_wake_sr_time, f2_wake_sr_time +type(c_ptr), value :: c_wake_sr_z +type(wake_sr_z_struct), target :: f_wake_sr_z, f2_wake_sr_z logical(c_bool) c_ok ! c_ok = c_logic(.true.) -call wake_sr_time_to_f (c_wake_sr_time, c_loc(f_wake_sr_time)) +call wake_sr_z_to_f (c_wake_sr_z, c_loc(f_wake_sr_z)) -call set_wake_sr_time_test_pattern (f2_wake_sr_time, 2) -if (f_wake_sr_time == f2_wake_sr_time) then - print *, 'wake_sr_time: F side convert C->F: Good' +call set_wake_sr_z_test_pattern (f2_wake_sr_z, 2) +if (f_wake_sr_z == f2_wake_sr_z) then + print *, 'wake_sr_z: F side convert C->F: Good' else - print *, 'wake_sr_time: F SIDE CONVERT C->F: FAILED!' + print *, 'wake_sr_z: F SIDE CONVERT C->F: FAILED!' c_ok = c_logic(.false.) endif -call set_wake_sr_time_test_pattern (f2_wake_sr_time, 3) -call wake_sr_time_to_c (c_loc(f2_wake_sr_time), c_wake_sr_time) +call set_wake_sr_z_test_pattern (f2_wake_sr_z, 3) +call wake_sr_z_to_c (c_loc(f2_wake_sr_z), c_wake_sr_z) -end subroutine test2_f_wake_sr_time +end subroutine test2_f_wake_sr_z !--------------------------------------------------------------------------------- !--------------------------------------------------------------------------------- -subroutine set_wake_sr_time_test_pattern (F, ix_patt) +subroutine set_wake_sr_z_test_pattern (F, ix_patt) implicit none -type(wake_sr_time_struct) F +type(wake_sr_z_struct) F integer ix_patt, offset, jd, jd1, jd2, jd3, lb1, lb2, lb3, rhs ! @@ -1441,19 +1441,39 @@ subroutine set_wake_sr_time_test_pattern (F, ix_patt) !! f_side.test_pat[type, 1, ALLOC] if (ix_patt < 3) then - if (allocated(F%wake)) deallocate (F%wake) + if (allocated(F%w)) deallocate (F%w) else - if (.not. allocated(F%wake)) allocate (F%wake(-1:1)) - do jd1 = 1, size(F%wake,1); lb1 = lbound(F%wake,1) - 1 - call set_spline_test_pattern (F%wake(jd1+lb1), ix_patt+jd1) + if (.not. allocated(F%w)) allocate (F%w(-1:1)) + do jd1 = 1, size(F%w,1); lb1 = lbound(F%w,1) - 1 + call set_spline_test_pattern (F%w(jd1+lb1), ix_patt+jd1) + enddo +endif +!! f_side.test_pat[type, 1, ALLOC] + +if (ix_patt < 3) then + if (allocated(F%w1)) deallocate (F%w1) +else + if (.not. allocated(F%w1)) allocate (F%w1(-1:1)) + do jd1 = 1, size(F%w1,1); lb1 = lbound(F%w1,1) - 1 + call set_spline_test_pattern (F%w1(jd1+lb1), ix_patt+jd1) + enddo +endif +!! f_side.test_pat[type, 1, ALLOC] + +if (ix_patt < 3) then + if (allocated(F%w2)) deallocate (F%w2) +else + if (.not. allocated(F%w2)) allocate (F%w2(-1:1)) + do jd1 = 1, size(F%w2,1); lb1 = lbound(F%w2,1) - 1 + call set_spline_test_pattern (F%w2(jd1+lb1), ix_patt+jd1) enddo endif !! f_side.test_pat[integer, 0, NOT] -rhs = 3 + offset; F%plane = rhs +rhs = 7 + offset; F%plane = rhs !! f_side.test_pat[integer, 0, NOT] -rhs = 4 + offset; F%position_dependence = rhs +rhs = 8 + offset; F%position_dependence = rhs -end subroutine set_wake_sr_time_test_pattern +end subroutine set_wake_sr_z_test_pattern !--------------------------------------------------------------------------------- !--------------------------------------------------------------------------------- @@ -1647,11 +1667,11 @@ subroutine set_wake_sr_test_pattern (F, ix_patt) !! f_side.test_pat[type, 1, ALLOC] if (ix_patt < 3) then - if (allocated(F%time)) deallocate (F%time) + if (allocated(F%z)) deallocate (F%z) else - if (.not. allocated(F%time)) allocate (F%time(-1:1)) - do jd1 = 1, size(F%time,1); lb1 = lbound(F%time,1) - 1 - call set_wake_sr_time_test_pattern (F%time(jd1+lb1), ix_patt+jd1) + if (.not. allocated(F%z)) allocate (F%z(-1:1)) + do jd1 = 1, size(F%z,1); lb1 = lbound(F%z,1) - 1 + call set_wake_sr_z_test_pattern (F%z(jd1+lb1), ix_patt+jd1) enddo endif !! f_side.test_pat[type, 1, ALLOC] diff --git a/cpp_bmad_interface/interface_test/cpp_bmad_test.cpp b/cpp_bmad_interface/interface_test/cpp_bmad_test.cpp index 677c7b4fd8..ed4de46ee3 100644 --- a/cpp_bmad_interface/interface_test/cpp_bmad_test.cpp +++ b/cpp_bmad_interface/interface_test/cpp_bmad_test.cpp @@ -919,62 +919,78 @@ extern "C" void test_c_expression_atom (Opaque_expression_atom_class* F, bool& c //-------------------------------------------------------------- //-------------------------------------------------------------- -extern "C" void test2_f_wake_sr_time (CPP_wake_sr_time&, bool&); +extern "C" void test2_f_wake_sr_z (CPP_wake_sr_z&, bool&); -void set_CPP_wake_sr_time_test_pattern (CPP_wake_sr_time& C, int ix_patt) { +void set_CPP_wake_sr_z_test_pattern (CPP_wake_sr_z& C, int ix_patt) { int rhs, offset = 100 * ix_patt; // c_side.test_pat[type, 1, ALLOC] if (ix_patt < 3) - C.wake.resize(0); + C.w.resize(0); else { - C.wake.resize(3); - for (unsigned int i = 0; i < C.wake.size(); i++) {set_CPP_spline_test_pattern(C.wake[i], ix_patt+i+1);} + C.w.resize(3); + for (unsigned int i = 0; i < C.w.size(); i++) {set_CPP_spline_test_pattern(C.w[i], ix_patt+i+1);} + } + + // c_side.test_pat[type, 1, ALLOC] + if (ix_patt < 3) + C.w1.resize(0); + else { + C.w1.resize(3); + for (unsigned int i = 0; i < C.w1.size(); i++) {set_CPP_spline_test_pattern(C.w1[i], ix_patt+i+1);} + } + + // c_side.test_pat[type, 1, ALLOC] + if (ix_patt < 3) + C.w2.resize(0); + else { + C.w2.resize(3); + for (unsigned int i = 0; i < C.w2.size(); i++) {set_CPP_spline_test_pattern(C.w2[i], ix_patt+i+1);} } // c_side.test_pat[integer, 0, NOT] - rhs = 3 + offset; C.plane = rhs; + rhs = 7 + offset; C.plane = rhs; // c_side.test_pat[integer, 0, NOT] - rhs = 4 + offset; C.position_dependence = rhs; + rhs = 8 + offset; C.position_dependence = rhs; } //-------------------------------------------------------------- -extern "C" void test_c_wake_sr_time (Opaque_wake_sr_time_class* F, bool& c_ok) { +extern "C" void test_c_wake_sr_z (Opaque_wake_sr_z_class* F, bool& c_ok) { - CPP_wake_sr_time C, C2; + CPP_wake_sr_z C, C2; c_ok = true; - wake_sr_time_to_c (F, C); - set_CPP_wake_sr_time_test_pattern (C2, 1); + wake_sr_z_to_c (F, C); + set_CPP_wake_sr_z_test_pattern (C2, 1); if (C == C2) { - cout << " wake_sr_time: C side convert F->C: Good" << endl; + cout << " wake_sr_z: C side convert F->C: Good" << endl; } else { - cout << " wake_sr_time: C SIDE CONVERT F->C: FAILED!" << endl; + cout << " wake_sr_z: C SIDE CONVERT F->C: FAILED!" << endl; c_ok = false; } - set_CPP_wake_sr_time_test_pattern (C2, 2); + set_CPP_wake_sr_z_test_pattern (C2, 2); bool c_ok2; - test2_f_wake_sr_time (C2, c_ok2); + test2_f_wake_sr_z (C2, c_ok2); if (!c_ok2) c_ok = false; - set_CPP_wake_sr_time_test_pattern (C, 3); + set_CPP_wake_sr_z_test_pattern (C, 3); if (C == C2) { - cout << " wake_sr_time: F side convert F->C: Good" << endl; + cout << " wake_sr_z: F side convert F->C: Good" << endl; } else { - cout << " wake_sr_time: F SIDE CONVERT F->C: FAILED!" << endl; + cout << " wake_sr_z: F SIDE CONVERT F->C: FAILED!" << endl; c_ok = false; } - set_CPP_wake_sr_time_test_pattern (C2, 4); - wake_sr_time_to_f (C2, F); + set_CPP_wake_sr_z_test_pattern (C2, 4); + wake_sr_z_to_f (C2, F); } @@ -1071,10 +1087,10 @@ void set_CPP_wake_sr_test_pattern (CPP_wake_sr& C, int ix_patt) { {int rhs = 101 + i + 1 + offset; C.file[i] = 'a' + rhs % 26;} // c_side.test_pat[type, 1, ALLOC] if (ix_patt < 3) - C.time.resize(0); + C.z.resize(0); else { - C.time.resize(3); - for (unsigned int i = 0; i < C.time.size(); i++) {set_CPP_wake_sr_time_test_pattern(C.time[i], ix_patt+i+1);} + C.z.resize(3); + for (unsigned int i = 0; i < C.z.size(); i++) {set_CPP_wake_sr_z_test_pattern(C.z[i], ix_patt+i+1);} } // c_side.test_pat[type, 1, ALLOC] diff --git a/cpp_bmad_interface/interface_test/main.f90 b/cpp_bmad_interface/interface_test/main.f90 index f1256eff6b..4498ec4674 100644 --- a/cpp_bmad_interface/interface_test/main.f90 +++ b/cpp_bmad_interface/interface_test/main.f90 @@ -21,7 +21,7 @@ program cpp_bmad_interface_test call test1_f_coord_array(ok); if (.not. ok) all_ok = .false. call test1_f_bpm_phase_coupling(ok); if (.not. ok) all_ok = .false. call test1_f_expression_atom(ok); if (.not. ok) all_ok = .false. -call test1_f_wake_sr_time(ok); if (.not. ok) all_ok = .false. +call test1_f_wake_sr_z(ok); if (.not. ok) all_ok = .false. call test1_f_wake_sr_mode(ok); if (.not. ok) all_ok = .false. call test1_f_wake_sr(ok); if (.not. ok) all_ok = .false. call test1_f_wake_lr_mode(ok); if (.not. ok) all_ok = .false. diff --git a/cpp_bmad_interface/scripts/interface_input_params.py b/cpp_bmad_interface/scripts/interface_input_params.py index 1654c5961f..326b57e895 100644 --- a/cpp_bmad_interface/scripts/interface_input_params.py +++ b/cpp_bmad_interface/scripts/interface_input_params.py @@ -32,7 +32,7 @@ 'coord_array_struct', 'bpm_phase_coupling_struct', 'expression_atom_struct', - 'wake_sr_time_struct', + 'wake_sr_z_struct', 'wake_sr_mode_struct', 'wake_sr_struct', 'wake_lr_mode_struct', diff --git a/regression_tests/wake_test/output.correct b/regression_tests/wake_test/output.correct index 7eab69af14..b19a23fe27 100644 --- a/regression_tests/wake_test/output.correct +++ b/regression_tests/wake_test/output.correct @@ -11,13 +11,13 @@ "SR2" REL 1E-8 -6.542425783E+03 1.308485157E+04 -1.737287555E-03 "BP-Charge" ABS 1E-8 1.00000000E+00 1.00000000E+00 "BP-ST" ABS 1E-8 0.00000000E+00 1.13595970E-28 -"BP-Centroid" ABS 1E-8 -6.61744490E-24 -4.96308368E-24 -3.22600439E-23 0.00000000E+00 1.01643954E-20 -3.15544362E-30 -"BP-Sig1" ABS 1E-8 1.53299706E-11 -1.53299706E-12 -1.30162049E-28 9.15078650E-29 9.04728795E-25 8.42594351E-35 -"BP-Sig2" ABS 1E-8 -1.53299706E-12 3.06599413E-13 -2.56379794E-30 -5.91645679E-30 -1.84176933E-25 3.31019209E-35 -"BP-Sig3" ABS 1E-8 -1.30162049E-28 -2.56379794E-30 5.10999002E-12 5.10999002E-13 -4.88715108E-25 -2.89641808E-35 -"BP-Sig4" ABS 1E-8 9.15078650E-29 -5.91645679E-30 5.10999002E-13 1.02199800E-13 1.13091099E-26 -9.02779661E-36 -"BP-Sig5" ABS 1E-8 9.04728795E-25 -1.84176933E-25 -4.88715108E-25 1.13091099E-26 3.59502182E-05 2.15704154E-31 -"BP-Sig6" ABS 1E-8 8.42594351E-35 3.31019209E-35 -2.89641808E-35 -9.02779661E-36 2.15704154E-31 9.99999992E-25 +"BP-Centroid" ABS 1E-8 -6.61744490E-24 -6.61744490E-24 -3.22600439E-23 -7.03103521E-24 1.01643954E-20 -3.15544362E-30 +"BP-Sig1" ABS 1E-8 1.53299706E-11 -1.53299706E-12 -1.30950910E-28 6.62643160E-29 9.04728795E-25 8.42594351E-35 +"BP-Sig2" ABS 1E-8 -1.53299706E-12 3.06599413E-13 2.83989926E-29 -3.54987407E-30 -7.10858339E-26 2.55787571E-35 +"BP-Sig3" ABS 1E-8 -1.30950910E-28 2.83989926E-29 5.10999002E-12 5.10999002E-13 -4.89522902E-25 -2.93403390E-35 +"BP-Sig4" ABS 1E-8 6.62643160E-29 -3.54987407E-30 5.10999002E-13 1.02199800E-13 -2.10026327E-26 -1.05324294E-35 +"BP-Sig5" ABS 1E-8 9.04728795E-25 -7.10858339E-26 -4.89522902E-25 -2.10026327E-26 3.59502182E-05 2.15704154E-31 +"BP-Sig6" ABS 1E-8 8.42594351E-35 2.55787571E-35 -2.93403390E-35 -1.05324294E-35 2.15704154E-31 9.99999992E-25 "BP-Amode" ABS 1E-8 1.00000005E+01 1.00000003E+00 1.53299704E-12 2.99999997E-09 "BP-Bmode" ABS 1E-8 1.00000005E+01 -1.00000003E+00 5.10999012E-13 9.99999991E-10 "BP-Xmode" ABS 1E-8 1.00000000E+01 1.00000000E+00 1.53299706E-12 3.00000003E-09 @@ -25,9 +25,9 @@ "BP-Zmode" ABS 1E-8 5.99585010E+09 -3.59755751E-17 5.99585005E-15 1.17335843E-11 "SR-P20" REL 1E-8 -3.669719477E-03 -6.964515720E-03 -1.658545047E-01 -3.147626904E-01 -2.680280888E-02 -2.208704581E-04 "SR-P40" REL 1E-8 -1.489442174E-01 -2.813689458E-01 -8.893362569E-02 -1.680035203E-01 -2.923870016E-02 -2.208182599E-04 -"LR-P20" REL 1E-8 -3.179852285E-09 -1.685197058E-12 5.366810426E-10 -1.386609493E-13 1.274950766E-09 2.484296844E-03 -"LR-P40" REL 1E-8 -1.221777195E-09 -1.686073397E-12 3.804170602E-09 -1.386790053E-13 1.274993062E-09 2.484413450E-03 -"dB-LR-Pipe-P20" ABS 1E-20 -8.089164646E-20 -4.235164736E-22 1.249373597E-20 -1.217609862E-21 0.000000000E+00 8.673617380E-23 -"dB-LR-Pipe-P40" ABS 1E-20 -3.303428494E-20 -4.235164736E-22 9.656175599E-20 -1.270549421E-21 0.000000000E+00 8.673617380E-23 -"dB-LR-RF-P20" ABS 1E-15 1.943347655E-12 -1.346001104E-15 -3.279623264E-13 -1.807885947E-20 3.640317214E-15 -6.872074038E-14 -"dB-LR-RF-P40" ABS 1E-15 7.470408222E-13 -1.347183033E-15 -2.324154778E-12 -1.598774688E-20 3.600418574E-15 -6.872007321E-14 +"LR-P20" ABS 1E-19 1.085895509E-09 -1.684898821E-12 -1.838480841E-10 -1.386709102E-13 -4.371006924E-10 -1.894387482E-03 +"LR-P40" ABS 1E-19 4.156949286E-10 -1.685775002E-12 -1.301972031E-09 -1.386889696E-13 -4.370594923E-10 -1.894270859E-03 +"dB-LR-Pipe-P20" ABS 1E-20 5.929230631E-20 -2.117582368E-22 -1.185846126E-20 -1.522012327E-21 0.000000000E+00 0.000000000E+00 +"dB-LR-Pipe-P40" ABS 1E-20 2.371692252E-20 -2.646977960E-22 -7.623296525E-20 -1.482307658E-21 -4.336808690E-19 0.000000000E+00 +"dB-LR-RF-P20" ABS 1E-15 1.947575508E-12 -1.346198886E-15 -3.286753660E-13 -1.810532925E-20 1.932481952E-15 -6.872056708E-14 +"dB-LR-RF-P40" ABS 1E-15 7.486677251E-13 -1.347381080E-15 -2.329207835E-12 -1.619950512E-20 1.902991653E-15 -6.871989748E-14 diff --git a/sim_utils/math/spline_mod.f90 b/sim_utils/math/spline_mod.f90 index 5cd5c49b0d..2de6876d38 100644 --- a/sim_utils/math/spline_mod.f90 +++ b/sim_utils/math/spline_mod.f90 @@ -21,7 +21,7 @@ module spline_mod real(rp) :: coef(0:3) = 0 ! coefficients for cubic spline end type -private akima_spline_coef23_calc, akima_spline_slope_calc, bracket_index_for_spline +private akima_spline_coef23_calc, akima_spline_slope_calc contains @@ -306,7 +306,15 @@ end subroutine spline_evaluate !+ ! Function bracket_index_for_spline (x_knot, x, ix0) result (ok) ! -! Routine for internal use only. +! Routine to find which interval to use for evaluating a spline. +! +! Input: +! x_knot(:) -- real(rp): Array of x values. +! x -- real(rp): Evaluation point. +! +! Output: +! ix0 -- integer: If ok = True, x is in the interval [x_knot(ix0), x_knot(ix0+1)] +! ok -- logical: True if x is in the range spanned by x_knot(:). False otherwise. !- function bracket_index_for_spline (x_knot, x, ix0) result (ok) diff --git a/tao/version/tao_version_mod.f90 b/tao/version/tao_version_mod.f90 index 98a4fc485f..fe02752143 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/05/04 12:47:15" +character(*), parameter :: tao_version_date = "2024/05/07 17:09:06" end module