subroutine init_plotting (open_page, graph, u) use cesrv_struct use cesrv_interface implicit none type (universe_struct), target :: u type (graph_struct), target :: graph logical open_page, exists integer i ! nullify (graph%top1%d2, graph%bottom1%d2) ! do we turn off generating a plot window? (needed with a dialup connection) if (open_page) then inquire (file = 'NO_PLOT_WINDOW.', exist = exists) if (exists) then print *, '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' print *, '!!!!! Found File: "NO_PLOT_WINDOW." !!!!!!!' print *, '!!!!! A Plot Window will NOT be Created! !!!!!!!' print *, '!!!!! [If you want a plot window delete this file.] !!!!!!!' print *, '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' logic%plotit = .false. endif else logic%plotit = .false. ! for GUI version endif ! call pset (u%q2x) call pset (u%q2y) call pset (u%e_xray) call pset (u%p_xray) call pset (u%qx_plus_qy) call pset (u%qx_minus_qy) call pset (u%beta) call pset (u%energy_data) call pset (u%phase) call pset (u%orbit) call pset (u%eta) call pset (u%ac_eta) call pset (u%ac_eta_c12) call pset (u%ac_eta_yx) call pset (u%mode_eta) call pset (u%spline_beta) call pset (u%cbar) call pset (u%cmat_a) call pset (u%cmat_b) call pset (u%x_fft) call pset (u%y_fft) ! Must be consistant with init_universe data_plot_init calls. call p1_plot_init (u%q2x%p2%plot1, '2Qx In-Phase Component', 1.0_rp, 'A_in', 4, 0, -400.0_rp, 400.0_rp) call p1_plot_init (u%q2x%p2%plot2, '2Qx Out-Phase Component', 1.0_rp, 'A_out', 4, 0, -400.0_rp, 400.0_rp) call p1_plot_init (u%q2y%p2%plot1, '2Qy In-Phase Component', 1.0_rp, 'A_in', 4, 1, -400.0_rp, 400.0_rp) call p1_plot_init (u%q2y%p2%plot2, '2Qy Out-Phase Component', 1.0_rp, 'A_out', 4, 1, -400.0_rp, 400.0_rp) call p1_plot_init (u%qx_plus_qy%p2%plot1, 'Qx+Qy In-Phase Component', 1.0_rp, 'A_in', 4, 1, -400.0_rp, 400.0_rp) call p1_plot_init (u%qx_plus_qy%p2%plot2, 'Qx+Qy Out-Phase Component', 1.0_rp, 'A_out', 4, 1, -400.0_rp, 400.0_rp) call p1_plot_init (u%qx_minus_qy%p2%plot1, 'Qx-Qy In-Phase Component', 1.0_rp, 'A_in', 4, 1, -400.0_rp, 400.0_rp) call p1_plot_init (u%qx_minus_qy%p2%plot2, 'Qx-Qy Out-Phase Component', 1.0_rp, 'A_out', 4, 1, -400.0_rp, 400.0_rp) call p1_plot_init (u%x_fft%p2%plot1, 'X FFT Amp', 1.0_rp, 'Amp', 4, 1, 1.0d-4, 1.0d-1, .true., .true.) call p1_plot_init (u%x_fft%p2%plot2, 'X FFT Phase (deg)', 180/pi, 'Phase', 4, 1, -200.0_rp, 200.0_rp) call p1_plot_init (u%y_fft%p2%plot1, 'Y FFT Amp', 1.0_rp, 'Amp', 4, 1, 1.0d-4, 1.0d-1, .true., .true.) call p1_plot_init (u%y_fft%p2%plot2, 'Y FFT Phase (deg)', 180/pi, 'Phase', 4, 1, -200.0_rp, 200.0_rp) call p1_plot_init (u%e_xray%p2%plot1, 'Horizontal E_xray Position (mm)', 1000.0_rp, 'X .', 4, 1, -4.0_rp, 4.0_rp) call p1_plot_init (u%e_xray%p2%plot2, 'Vertical E_xray Position (mm)', 1000.0_rp, 'Y .', 4, 1, -4.0_rp, 4.0_rp) call p1_plot_init (u%p_xray%p2%plot1, 'Horizontal P_XRay Position (mm)', 1000.0_rp, 'X .', 4, 1, -4.0_rp, 4.0_rp) call p1_plot_init (u%p_xray%p2%plot2, 'Vertical P_XRay Position (mm)', 1000.0_rp, 'Y .', 4, 1, -4.0_rp, 4.0_rp) call p1_plot_init (u%phase%p2%plot1, 'Horizontal Phase (deg)', 180.0_rp/pi, 'Phi_a', 4, 0, -20.0_rp, 20.0_rp) call p1_plot_init (u%phase%p2%plot2, 'Vertical Phase (deg)', 180.0_rp/pi, 'Phi_b', 4, 0, -20.0_rp, 20.0_rp) call p1_plot_init (u%orbit%p2%plot1, 'Horizontal Orbit (mm)', 1000.0_rp, 'X .', 4, 1, -4.0_rp, 4.0_rp) call p1_plot_init (u%orbit%p2%plot2, 'Vertical Orbit (mm)', 1000.0_rp, 'Y .', 4, 1, -4.0_rp, 4.0_rp) call p1_plot_init (u%eta%p2%plot1, 'Horizontal Dispersion (m)', 1.0_rp, 'Eta_x', 4, 1, -4.0_rp, 4.0_rp) call p1_plot_init (u%eta%p2%plot2, 'Vertical Dispersion (m)', 1.0_rp, 'Eta_y', 4, 1, -4.0_rp, 4.0_rp) call p1_plot_init (u%ac_eta%p2%plot1, 'Horizontal AC_Eta (m)', 1.0_rp, 'AC_Eta_x', 4, 1, -4.0_rp, 4.0_rp) call p1_plot_init (u%ac_eta%p2%plot2, 'Vertical AC_Eta (m)', 1.0_rp, 'AC_Eta_y', 4, 1, -4.0_rp, 4.0_rp) call p1_plot_init (u%ac_eta_c12%p2%plot1, 'AC_Eta_C12 A', 1.0_rp, 'AC_Eta_A', 4, 1, -4.0_rp, 4.0_rp) call p1_plot_init (u%ac_eta_c12%p2%plot2, 'AC_Eta_C12 B', 1.0_rp, 'AC_Eta_B', 4, 1, -4.0_rp, 4.0_rp) call p1_plot_init (u%ac_eta_yx%p2%plot1, 'AC_Eta Y/X SIN', 1.0_rp, 'AC_Eta_SIN', 4, 1, -4.0_rp, 4.0_rp) call p1_plot_init (u%ac_eta_yx%p2%plot2, 'AC ETA Y/X COS', 1.0_rp, 'AC_Eta_COS', 4, 1, -4.0_rp, 4.0_rp) call p1_plot_init (u%mode_eta%p2%plot1, 'Horizontal Mode_Eta (m)', 1.0_rp, 'Mode_Eta_x', 4, 1, -4.0_rp, 4.0_rp) call p1_plot_init (u%mode_eta%p2%plot2, 'Vertical Mode_Eta (m)', 1.0_rp, 'Mode_Eta_y', 4, 1, -4.0_rp, 4.0_rp) call p1_plot_init (u%cmat_a%p2%plot1, 'Cmat_A22 (m)', 1.0_rp, 'Cmat_A22', 4, 1, -0.1_rp, 0.1_rp) call p1_plot_init (u%cmat_a%p2%plot2, 'Cmat_A12 (m)', 1.0_rp, 'Cmat_A12', 4, 1, -0.1_rp, 0.1_rp) call p1_plot_init (u%cmat_b%p2%plot1, 'Cmat_B11 (m)', 1.0_rp, 'Cmat_B11', 4, 1, -0.1_rp, 0.1_rp) call p1_plot_init (u%cmat_b%p2%plot2, 'Cmat_B12 (m)', 1.0_rp, 'Cmat_B12', 4, 1, -0.1_rp, 0.1_rp) call p1_plot_init (u%cbar%p2%plot1, 'Cbar', 1.0_rp, 'Cbar11', 4, 2, -0.1_rp, 0.1_rp) call p1_plot_init (u%cbar%p2%plot2, 'Cbar', 1.0_rp, 'Cbar12', 4, 2, -0.1_rp, 0.1_rp) call p1_plot_init (u%cbar%p2%plot3, 'Cbar', 1.0_rp, 'Cbar22', 4, 2, -0.1_rp, 0.1_rp) call p1_plot_init (u%energy_data%p2%plot1, 'Beam Energy dE/E (*10^3)', 1.0d3, 'dE/E', 4, 2, -0.1_rp, 0.1_rp) call p1_plot_init (u%beta%p2%plot1, 'Horizontal Beta_a', 1.0_rp, 'Beta_a', 4, 0, -40.0_rp, 40.0_rp) call p1_plot_init (u%beta%p2%plot2, 'Vertical Beta_b', 1.0_rp, 'Beta_b', 4, 0, -40.0_rp, 40.0_rp) call p1_plot_init (u%spline_beta%p2%plot1, 'Horizontal Spline Fit: Beta_a', 1.0_rp, 'Beta_a', 4, 0, -40.0_rp, 40.0_rp) call p1_plot_init (u%spline_beta%p2%plot2, 'Vertical Spline Fit: Beta_b', 1.0_rp, 'Beta_b', 4, 0, -40.0_rp, 40.0_rp) call p1_plot_init (u%quad_k1%plot, 'Quadrupole K1', 1.0_rp, 'K1', 4, 1, -1.0_rp, 1.0_rp) call p1_plot_init (u%skew_quad_k1%plot, 'Skew Quadrupole K1', 1.0_rp, 'K1', 4, 1, -1.0_rp, 1.0_rp) call p1_plot_init (u%sex_k2%plot, 'Sextupole K2', 1.0_rp, 'K2', 4, 1, -2.0_rp, 2.0_rp) call p1_plot_init (u%hsteer_kick%plot, 'Horizontal Steerings (mrad)', 1.0_rp, 'Kick', 4, 1, -1.0_rp, 1.0_rp) call p1_plot_init (u%vsteer_kick%plot, 'Vertical Steerings (mrad)', 1.0_rp, 'Kick', 4, 1, -1.0_rp, 1.0_rp) u%phase%p2%plot1%normalize = 'ZERO_AVE' u%phase%p2%plot2%normalize = 'ZERO_AVE' u%raw_orbit%y_axis%major_div = 5 u%raw_orbit%y_axis%places = 0 u%raw_orbit%y_axis%max = 1e6 u%raw_orbit%y_axis%bounds = 'ZERO_AT_END' u%x_fft%p2%x_axis%max = 1.0 u%x_fft%p2%x_axis%places = 1 u%x_fft%p2%plot_symbols = .false. u%y_fft%p2%x_axis%max = 1.0 u%y_fft%p2%x_axis%places = 1 u%y_fft%p2%plot_symbols = .false. ! graph inits call set_graph_p2_pointers (graph%top1, 'TOP_PLOT') call set_graph_p2_pointers (graph%bottom1, 'BOTTOM_PLOT') call set_graph_p2_pointers (graph%top2, 'TOP2_PLOT') call set_graph_p2_pointers (graph%bottom2, 'BOTTOM2_PLOT') call set_plot (graph%top1, u%orbit) call set_plot (graph%bottom1, u%orbit) call set_plot (graph%top2, u%orbit) call set_plot (graph%bottom2, u%orbit) graph%bottom1%base = plot_none$ ! call plotdo ('INIT', graph, .false., u) ! init plotting !-------------------------------------------------- contains subroutine pset (d2) type (d2_data_struct) d2 d2%p2%plot1%normalize = '' d2%p2%plot2%normalize = '' d2%p2%plot3%normalize = '' d2%p2%plot_data = plot_model$ d2%p2%base = plot_design$ d2%p2%x_axis%max = 100 d2%p2%x_axis%min = 0 d2%p2%x_axis%major_div = 10 d2%p2%x_axis_type = 'INDEX' d2%p2%plot_symbols = .true. end subroutine !-------------------------------------------------- ! contains subroutine set_graph_p2_pointers (p2, where) type (p2_plot_struct), target :: p2 character(*) where ! nullify(p2%d2) nullify(p2%plot1%d1) nullify(p2%plot2%d1) nullify(p2%plot3%d1) p2%plot1%p2 => p2 p2%plot2%p2 => p2 p2%plot3%p2 => p2 p2%where = where end subroutine end subroutine