module cesrv_struct use group_struct use cesr_mod use cesr_group_mod use quick_plot_struct use mpm_utils_interface use synrad_struct use tbt_struct !----------------------------------------------------------------------- ! The cesrv_version is for checking that the digested dmerit file is up-to-date. integer, parameter :: cesrv_version$ = 2 !----------------------------------------------------------------------- ! a non-negative %y_limit constrains plotted y-values so that the maximum ! distance a point can be outside the plot boundary is ! %y_limit * height_of_plot type p1_plot_struct character(80) title, title_suffix real(rp) conversion_factor ! conversion from internal to plotting units real(rp) y_rms ! RMS of data real(rp) y_average ! Average of the data real(rp) y_limit ! amount to limit displayed points past y%max, y%min logical limited ! True if at least one data point past limit type (qp_axis_struct) y_axis ! , x type (d1_data_struct), pointer :: d1 => null() type (p2_plot_struct), pointer :: p2 => null() real(rp), allocatable :: y(:) integer n_use character(8) normalize ! 'ZERO_AVE', 'MOD_PI', 'DESIGN' (eg used for beta data) end type type p2_plot_struct character(20) where ! 'TOP_PLOT', 'BOTTOM2_PLOT' type (d2_data_struct), pointer :: d2 => null() type (p1_plot_struct) plot1, plot2, plot3 type (qp_axis_struct) x_axis character(16) :: x_axis_type ! 'INDEX', 'PHI', 'S', 'TUNE', real(rp), allocatable :: x(:) integer, allocatable :: ix(:) integer :: plot_data ! plot_meas$, plot_model$, plot_design$, plot_ref$ integer :: base ! plot_ref$, plot_design$, plot_model$, ! plot_ref_and_model$, plot_none$ logical gang_scale ! Can autoscale all plots simultaneously? logical plot_symbols ! Plot symbols end type type graph_struct type (p2_plot_struct) :: top1, bottom1, top2, bottom2 end type !----------------------------------------------------------------------- ! Data ! EXISTS -- The datum can exist. Eg phase(34)%exists = .false. since ! detector 34 does not exist. ! GOOD_DAT -- The read-in datum seems to be good (but you cannot always ! tell so eg orbit(34)%good may be .true.) ! GOOD_REF -- The read-in reference datum is good. ! GOOD_USER -- What the user has selected using the use, veto, and restore ! commands. ! GOOD_OPT -- Set .true. if the class of the datum is valid for optimization. ! Eg all orbit(i)%good_opt = .true. when optimizing on orbits. ! USEIT_PLOT -- Datum is valid for plotting. This is computed for a particular ! plot using the state of the EXISTS/GOOD logicals and what is ! being plotted for the particular plot. ! USEIT_OPT -- Datum is valid for optimizing. This is computed using the ! state of the EXISTS/GOOD logicals. type data_struct character(16) name character(40) ele_name character(16) alias integer ix_index integer ix_ele integer ix_dmeas, ix_jacobian integer :: ix_db = 0 ! Index to the data base array. real(rp) model, meas, ref, delta, design, design_nonlin, old real(rp) base_model, fit, val_temp real(rp) merit, weight real(rp) s, ix_plot_index real(rp) meas_golden logical exists, good_dat, good_ref, good_user, good_opt, good_temp logical useit_plot, useit_opt type (d1_data_struct), pointer :: d1 => null() end type data_struct !---------------------------------------------- ! eq phase%a%, cbar%m11% type d1_data_struct character(16) name integer plane ! x_plane$, y_plane$, z_plane$, m11$, m12$, m21$, m22$, null_plane$, amp_plane, phase_plane$ integer ix_data type (d2_data_struct), pointer :: d2 => null() type (data_struct), pointer :: d(:) => null() end type !---------------------------------------------- ! eg phase%, cbar% type d2_data_struct character(16) name character(140) file_name, ref_file_name integer ix_meas, ix_ref ! index in name. E.g. the nnnnn in BUTNS.nnnnn integer type ! phase_data$, cbar_data$ integer csr_set ! CSR save set when measurement was done integer condx_set ! CONDX save set when measurement was done character(20) date ! measurement date character(20) ref_date ! ref measurement date character(40) route_name ! logical measured ! A measurement has been made? logical ref_measured logical ew_encode type (d1_data_struct) :: x, y, z, m11, m12, m21, m22, d1, a_in, a_out, amp, phase, a, b, yxcos, yxsin type (p2_plot_struct) :: p2 type (universe_struct), pointer :: u => null() logical veto_above_100 ! veto plotting with index above 100 (eg for beta) type (cesr_data_params_struct) data_params, ref_params end type !----------------------------------------------------------------------- !----------------------------------------------------------------------- ! Variables type v1_var_struct character(16) name character(16) short_name integer type ! quad_k1$, hsteer_kick$, vsteer_kick$ integer ix_var integer units ! cu_units$, bmad_units$ type (var_struct), pointer :: v(:) => null() type (p1_plot_struct) plot end type type v1_var_array_struct type (v1_var_struct), pointer :: v1 => null() end type !---------------------------------------------- ! Variables: ! %EXISTS -- The variable exists. Eg sex_k1(1)%exists = .false. since ! there is no sextupole there. ! %GOOD_VAR -- The variable can be varied. Eg quad_k1(0)%good_var = .false. ! Since the REQ0W has a fixed strength ! %GOOD_USER -- What the user has selected using the use, veto, and restore ! commands. ! %GOOD_OPT -- Set .true. if the variable exists and the class of variable ! is valid for optimization. Eg quad_k1(0)%good_opt = .true. ! when optimizing the quadrupoles. ! %GOOD_TEMP -- To be used by a local routine to store the state of, say, good_user ! if this state is to be temporarily changed. ! %USEIT -- Variable is to be used for optimizing. This is computed ! using the state of the EXISTS/GOOD logicals. type var_struct character(16) name character(40) ele_name character(16) alias character(12) db_node_name character(16) db_ele_name character(16) attrib_name integer ix_var ! Index in u%var(:) array integer ix_index ! E.g. index in quad_k1() array integer ix_db integer ix_dvar, ix_jacobian integer ix_ele, ix_attrib real(rp), pointer :: model => null() real(rp) design, old, base_cu0, saved, saved_ref, target, base_model real(rp) high_target_lim, low_target_lim, val_temp real(rp) merit, dmerit, weight, step real(rp) H, G real(rp) dvar_dcu, delta integer cu_saved, cu_saved_ref, cu_target, cu_design, cu_lim_diff integer cu_high_lim, cu_low_lim, cu_zero_lim, cu_golden integer makeup_method real(rp) x_plot, y_plot real(rp) s logical exists, good_var, good_user, good_opt, good_temp, hit_limit logical useit logical do_limit_calc logical dm_dv_computed type (v1_var_struct), pointer :: v1 => null() end type var_struct type var_ptr_struct type (var_struct), pointer :: v => null() end type !---------------------------------------------- type wave_struct character(16) wave_what ! 'ORBIT', 'PHASE', 'CBAR', 'ETA' integer :: plane ! x_plane$, y_plane$ real(rp) phi_s(50), phi_r(50), phi_kick(50) real(rp) kick(50), chi_a type (p2_plot_struct) :: p2 real(rp) rms_a, rms_b real(rp) rms_sa, rms_sb, rms_ra, rms_rb real(rp) rms_k, rms_ks, rms_kr, rms_phi real(rp) rms_sphi, rms_rphi real(rp) amp_sba, amp_rba integer ix_a1, ix_a2, ix_b1, ix_b2 integer n_cross, ix_cross(50) logical :: write_raw = .false. end type !------------------------------------------------------------------------- type top10s character(16) name real(rp) value integer index logical valid end type type raw_struct character(80) title type (qp_axis_struct) y_axis type (raw_det_struct) det(0:120) type (raw_det_struct) det_ref(0:120) real(rp) :: y_scale = 1 end type type normal_mode_button_convert_struct real(rp) mat(2,4) end type type eta_params_struct real(rp) rf_freq1, rf_freq2 real(rp) del_e_e integer orbit_num, orbit_num1, orbit_num2 end type !-------------- ! Synrad stuff integer, parameter :: forward$ = 1 integer, parameter :: reverse$ = -1 integer, parameter :: w_east$ = -1 integer, parameter :: w_west$ = 1 type ray_hit_struct type (ray_struct) ray type (coord_struct) hit_coord, target_coord real(rp) sig_y, sig_yp ! Source point real(rp) sig_y_eff ! Effective sigma at the target distance. real(rp) window_sig_y ! Effective sigma at the crotch window. real(rp) dist ! Projection distance past window end type type crotch_window_struct ! struct for input points character*16 name ! name of element (sliding_joint, etc.) integer ix_pt ! index to wall pt() array integer n_ray_hit ! Number of rays hitting this window real(rp) length ! Length of window horizontally integer side ! East or West side of cesr integer layout ! The crotch is forward or reverse in ! terms of s (positron) direction real(rp) angle ! Angle of window found by: ! atan(ds_window/dx_window) type (ray_hit_struct), allocatable :: ray_hits(:) ! Array of rays hitting the window end type !---------------------------------------------- integer, parameter :: n_data_maxx = 5000, n_var_maxx = 2500 integer, parameter :: n_custom_maxx = 300, n_db_group_maxx = 25 !---------------------------------------------- ! the known universe type universe_struct character(80) :: main_title1 character(80) :: main_title2 type (lat_struct) :: ring, design type (coord_struct), allocatable :: orb(:) type (d2_data_struct) :: beta, phase, tune, orbit, cbar, spline_beta type (d2_data_struct) :: eta, energy_data, chrom, ac_eta, ac_eta_c12, ac_eta_yx, mode_eta, cmat_a, cmat_b type (d2_data_struct) :: q2x, q2y, qx_plus_qy, qx_minus_qy, x_fft, y_fft, e_xray, p_xray type (data_struct) :: data(n_data_maxx) type (v1_var_struct) :: quad_k1, sex_k2, hsteer_kick type (v1_var_struct) :: vsteer_kick, hsep_kick, custom_var type (v1_var_struct) :: skew_quad_k1, energy_var, skew_sex_k2 type (v1_var_struct) :: oct_k3, init_orb, bpm_tilt, x_amp_shake, y_amp_shake type (v1_var_struct) :: x_kick_quad, y_kick_quad, nir_shuntcur type (var_struct) :: var(n_var_maxx) type (wave_struct) :: wave type (raw_struct) :: raw_orbit, raw_phase_x, raw_phase_y type (shaking_modes_struct) raw_shake(0:120) type (v1_var_array_struct) :: db_group(n_db_group_maxx) type (v1_var_struct) :: group1, group2, group3, group4, group5 type (v1_var_struct) :: group6, group7, group8, group9, group10 type (v1_var_struct) :: group11, group12, group13, group14, group15 type (v1_var_struct) :: group16, group17, group18, group19, group20 type (v1_var_struct) :: group21, group22, group23, group24, group25 type (normal_modes_struct) :: global_design type (rad_int_all_ele_struct) :: rad_int_by_ele_design type (tbt_all_data_struct) :: tbt_meas, tbt_ref real(rp), dimension(:, :), pointer :: dm_dv => null() type (db_struct) db type (walls_struct) walls type (crotch_window_struct), allocatable :: window(:) logical ok_status logical data_is_from_model ! is "data" not from measurement? type (normal_mode_button_convert_struct) but_to_mode(0:120) type (eta_params_struct) eta_params type (cesr_xy_data_struct) bpm_offset(0:120), new_bpm_offset end type !---------------------------------------------- integer, parameter :: plot_meas$ = 1, plot_model$ = 2, plot_design$ = 3 integer, parameter :: plot_ref$ = 4, plot_none$ = 6 integer, parameter :: plot_fit$ = 7, plot_model_and_base$ = 8 integer, parameter :: plot_ref_and_fit$ = 9 integer, parameter :: plot_ref_and_model$ = 10 integer, parameter :: plot_ref_and_model_and_base$ = 11 integer, parameter :: plot_base$ = 12 integer, parameter :: opt_steering$ = 1, opt_sex$ = 2, opt_quad$ = 3 integer, parameter :: opt_custom$ = 4, opt_skew_quad$ = 5, opt_all_vars$ = 6 integer, parameter :: opt_skew_sex$ = 7 integer, parameter :: opt_orbit$ = 11, opt_twiss$ = 12, opt_all_data$ = 13, opt_sex_res$ = 14 integer, parameter :: pretzel_design$ = 1, pretzel_off$ = 2 integer, parameter :: pretzel_saved$ = 3 character(8) :: pretzel_names(3) = ['DESIGN', 'OFF ', 'SAVED '] ! integer, parameter :: on$ = 1, off$ = 2 integer, parameter :: make_mat6$ = 1, normal_makeup$ = 2, no_makeup$ = 3 integer, parameter :: m11$ = 4, m12$ = 5, m21$ = 6, m22$ = 7 integer, parameter :: in_plane$ = 8, out_plane$= 9, a_plane$=10, b_plane$=11, cos$=12, sin$=13, null_plane$ = 14 integer, parameter :: amp_plane$ = 15, phase_plane$ = 16 integer, parameter :: quad_k1$ = 1, sex_k2$ = 3 integer, parameter :: custom_var$ = 4, hsteer_kick$ = 5, vsteer_kick$ = 6 integer, parameter :: hsep_kick$ = 7 integer, parameter :: skew_quad_k1$ = 10, bpm_tilt$ = 11 integer, parameter :: skew_sex_k2$ = 12, oct_k3$ = 13, db_group$ = 14 integer, parameter :: init_orb$ = 15, energy_var$ = 16 integer, parameter :: x_amp_shake$ = 17, y_amp_shake$ = 18 integer, parameter :: x_kick_quad$ = 19, y_kick_quad$ = 19 integer, parameter :: bmad_units$ = 1, cu_units$ = 2 integer, parameter :: ref_file$ = 0, data_file$ = 1 integer, parameter :: make_groups$ = 1, no_make_groups$ = 3, reestablish_groups$ = 4 integer, parameter :: orbit_data$ = 1, phase_data$ = 2, cbar_data$ = 3 integer, parameter :: beta_data$ = 4, eta_data$ = 5, spline_data$ = 6 integer, parameter :: wave_data$ = 7, none_data$ = 8, cbar_and_eta_data$ = 9 integer, parameter :: tune_data$ = 10, energy_data$ = 11, ac_eta_data$ = 12 integer, parameter :: ac_eta_c12$ = 31, ac_eta_yx_sincos$=32 integer, parameter :: cbar_all_data$ = 13 integer, parameter :: q2x_data$ = 14, q2y_data$ = 15, qx_plus_qy_data$ = 16, qx_minus_qy_data$ = 17 integer, parameter :: chrom_data$ = 18, x_fft_data$ = 19, y_fft_data$ = 20, fft_data$ = 21 integer, parameter :: e_xray_data$ = 25, cmat_a_data$ = 26, cmat_b_data$ = 27 integer, parameter :: cmat_data$ = 28, mode_eta_data$ = 29, p_xray_data$ = 30 integer, parameter :: add$ = 1, subtract$ = 2, set_to$ = 3 integer, parameter :: x_only$ = 1, y_only$ = 2 integer, parameter :: xy$ = 1, c12$ = 2, sincos$ = 3 character(*),parameter :: ac_eta_type_name(3) = ['XY ','C12 ','SINCOS'] character(16) :: var_units_name(2) = ['BMAD UNITS', 'CU UNITS '] type name_struct ! Uses plot_*$ parameters character(16) :: plot_data_name(13) = & [ 'DATA ', 'MODEL ', 'DESIGN ', 'REFERENCE ', & '----------', '----------', 'FIT ', '----------', & '----------', '----------', '----------', 'BASE_MODEL', & ' ' ] character(16) :: opt_data(11:14) = ['ORBIT ', 'TWISS ', & 'ALL DATA ', 'SEXTUPOLE RES'] ! Uses *_data$ parameters character(16) :: data_type_name(32) = [ & 'ORBIT ', 'PHASE ', 'CBAR ', 'BETA ', & 'ETA ', 'SPLINE_BETA ', 'WAVE ', 'NONE ', & '_CBAR_AND_ETA', 'TUNE ', 'ENERGY ', 'AC_ETA ', & 'CBAR_ALL ', '2QX ', '2QY ', 'QX+QY ', & 'QX-QY ', 'CHROMATICITY ', 'X_FFT ', 'Y_FFT ', & 'FFT ', '2Q ', 'QX ', 'Q_RES ', & 'E_XRAY ', 'CMAT_A ', 'CMAT_B ', 'CMAT ', & 'MODE_ETA ', 'P_XRAY ', 'AC_ETA_C12 ', 'AC_ETA_SINCOS' ] character(20) :: change(49) = [ & 'ORBIT ', 'PHASE ', 'CBAR ', 'BETA ', & 'ETA ', 'SPLINE_BETA ', 'SEXTUPOLE ', 'QUADRUPOLE ', & 'DATA ', 'REFERENCE ', 'TILT ', 'MODEL ', & 'HORIZONTAL ', 'VERTICAL ', 'CUSTOM_VAR ', 'SKEW_QUAD ', & 'GROUP ', 'H_SEPARATOR ', '2Q ', '_SKEW_SEX ', & 'OCTUPOLE ', 'AC_ETA ', 'ALL_DATA ', 'INIT_ORB ', & 'BASE_MODEL ', 'CMAT_A ', 'CMAT_B ', 'CMAT ', & 'MODE_ETA ', 'ENERGY ', 'ALL_VARS ', 'QX ', & 'CHROMATICITY ', 'SLAVE ', 'BPM_TILT ', '2QX ', & '2QY ', 'QX+QY ', 'QX-QY ', 'X_KICK_QUAD ', & 'Y_KICK_QUAD ', 'X_AMP_SHAKE ', 'Y_AMP_SHAKE ', 'Q_RES ', & 'TUNE ', 'DE_E ', 'XQUNEING ', 'P_XRAY ', & 'E_XRAY '] ! Uses *plane$ parameters character(16) :: plane(13) = [ 'X ', 'Y ', 'Z ', '11 ', '12 ', & '21 ', '22 ', 'IN ', 'OUT ','A ','B ','COS ','SIN ' ] character(16) :: opt_vars(7) = [ & 'STEERING ', 'SEXTUPOLE ', 'QUADRUPOLE', 'CUSTOM ', & 'SKEW_QUAD ', 'ALL_VARS ', '_SKEW_SEX '] character(16) :: makeup_method(3) = ['Make_Mat6 ', 'Normal_Makeup', 'No_Makeup '] endtype type (name_struct), save :: name$ !----------------------------------------------------------------------- type logic_struct type (synrad_param_struct) synrad_params character(160) :: btns_gain_correction_file = & '$CESR_ONLINE/machine_data/mach_meas/orbit/button_gain.dat' character(40) :: cmd_file_arg(0:9) character(60) :: doc_directory = '/nfs/cesr/online/ms/software/cesrv/doc/' character(32) :: engine = 'LEVENBERG-MARQUARDT' ! FLETCHER-REEVES, LEVENBERG-MARQUARDT character(40) :: lattice = 'INIT' character(20) :: plot_what = 'PLOT_DATA' ! 'PLOT_DATA', 'PLOT_STEERING', 'PLOT_K_QUAD', ! 'PLOT_K2_SEX', 'PLOT_WAVE', 'PLOT_RAW' character(16) :: prompt_str = 'CesrV' character(8) :: queue = 'AWPLO' character(140) :: remember_file_name character(200) :: tilt_correction_file = & '$CESR_ONLINE/machine_data/mach_meas/orbit/bpm_tilt_correction.dat' integer :: ac_eta_freq_range = 2 integer :: beam_species = 0 ! e+ (+1) or e- (-1)? 0 => choose beam with current in it. integer :: beam_bunch = 1 ! bunch to use. 0 => choose bunch with current in it. integer :: biggrp_set = 0 ! big group set integer :: bpm_calib_max_cycles = 5 integer :: condx_set = 0 integer :: csr_set = 0 integer :: iu_command_file ! command file unit number integer :: iu_remember ! remember file unit number integer :: ix_bpm_fft = 1 ! BPM to use for turn-by-turn FFT. integer :: ix_bunch_fft = 1 ! Bunch to use for turn-by-turn FFT. integer :: ix_cut_ring = -1 ! starting point for non-circular ring tracking integer :: last_read integer :: n_1dim_calls integer :: n_db_group_max ! maximum number of groups used integer :: opt_base = plot_design$ integer :: opt_data = opt_orbit$ ! opt_twiss$, opt_orbit$ integer :: opt_loops = 5, opt_cycles = 10 integer :: opt_vars = 0 ! has not been set, opt_steering$, opt_sex$, opt_quad$, opt_custom$ integer :: phase_units = radians$ ! units for phase output integer :: pretzel = pretzel_off$ ! pretzel_off$, pretzel_saved$, pretzel_design$ integer :: ref_particle integer :: sex_calib_delta_cu = 500 ! Change in sextupole strength used in calibrate_sextupole integer :: sex_calib_n_bump_set = 5 ! Number of bump settings used in calibrate_sextupole. integer :: tune_units = khz$ ! units for tune output integer :: u_num ! number of universes integer :: u_view ! which one are we looking at integer :: ac_eta_type = xy$ logical :: auto_measurement = .false. ! for the calibrate command. logical :: bpm_calib_load_golden = .false. logical :: calc_twiss_with_cut_ring = .false. ! Twiss parameter calc uses cut? logical :: command_file_open = .false. ! input from a command file? logical :: debug = .false. logical :: digital_shaker_on = .true. logical :: dmerit_calc_on = .false. logical :: filter_beta_res = .false. logical :: gain_correction = .false. ! for read_butns_file logical :: gui logical :: limit_on = .true. logical :: lrbbi_inserted = .false. logical :: new_cbar_tilt_calc = .false. ! use JSh new cbar rotation algorithm logical :: nonlinear_calc = .true. ! for read_butns_file logical :: offset_correction = .false. ! for read_butns_file logical :: ok_to_read_dmerit_file = .false. ! veto reading file logical :: opt_base_locked = .false. logical :: opt_cbar11 = .false. logical :: opt_cbar22 = .false. logical :: opt_running = .false. logical :: opt_vars_locked = .false. logical :: orbit_monitoring = .false. ! If true then non-interactive orbit monitoring mode logical :: plot_ip_at_center = .false. ! ip at center of plot? logical :: plot_locked = .false. logical :: plot_single_bottom = .false. logical :: plot_single_top = .false. logical :: plot_special = .false. logical :: plotit = .true. logical :: radiation_on = .false. logical :: read_twiss_with_tbt = .false. logical :: remembering ! record commands in a file logical :: restricted_cbar_plot = .false. ! T => plot cbar12 only logical :: reverse_tracking = .false. logical :: rf_on = .false. logical :: ring_initialized = .false. logical :: sex_calib_use_custom_bump = .false. logical :: tilt_correction = .false. ! use BPM tilts when reading in data? logical :: use_old_in_loading = .false. logical :: use_bpm_quad_offsets = .true. logical :: wide_plot_window = .false. ! For four plot viewing logical :: wolski_normal_mode_calc_on real(rp) :: bpm_calib_max_dorbit = 0.8e-3 ! relative to the new phase meas system real(rp) :: change_min real(rp) :: dQ_max_quad_calib = 0.02 ! ~8 kHz ! For the quad calibration calc real(rp) :: dQ_max_sex_calib = 0.02 ! ~8 kHz ! For the sextupole calibration calc real(rp) :: h_scale real(rp) :: l_times_alpha real(rp) :: opt_tolerance real(rp) :: phase_conversion_factor = 1 ! phase conversion factor for output real(rp) :: pretzel_factor = 1 real(rp) :: tune_conversion_factor = 390.1 / twopi ! tune conversion factor for output end type logic_struct type (logic_struct), target, save :: logic type (universe_struct), pointer, save :: u_common => null() end module cesrv_struct !-------------------------------------------------------------------------- !-------------------------------------------------------------------------- !-------------------------------------------------------------------------- module super_universe_com use cesrv_struct type super_universe_struct type (universe_struct), pointer :: u_(:) => null() ! array of universes endtype type (super_universe_struct), target, save :: super !------------------------------------------------------------------------- ! common variables type cesrv_common_struct logical :: at_limit_flag logical :: var_useit(n_var_maxx) end type type (cesrv_common_struct), save :: cesrv_common end module super_universe_com