subroutine cesrv_command (cmd_line_in, u, graph, err_flag) use cesrv_interface use super_universe_com use history_recorder use write_lat_file_mod use sim_utils use q_tune_mod, only: q_tune use cesrv_init_groups, only: setup_groups use synrad_output_mod, only: ray_output use cesrv_synrad_plot_mod, only: wall_plot, ray_plot, burn_plot use synrad_window_mod, only: get_window_numbers, find_windows, project_from_windows use quick_plot use cesr_read_data_mod use cesr_element_mod use input_mod use calibrate_sextupole_mod implicit none type p2_plot_pointer_struct type (p2_plot_struct), pointer :: p2 end type type (universe_struct), pointer :: u ! do not change where this points to type (universe_struct), pointer :: uu type (universe_struct) :: u_save type (lat_struct) :: ring_save type (v1_var_struct), pointer :: var1 type (var_struct), pointer :: var type (qp_axis_struct) x_axis type (graph_struct), target :: graph, temp_graph type (p2_plot_struct), pointer :: this_plot type (p2_plot_pointer_struct) :: p2_plot(4) integer i, k, i_cyc, ix, ixq, ix_cmd, ix1, ix2, iopt, typ, ix_e integer itype, ix_what, data_or_ref, ios, ix_plane, ix_plot_where integer ixx, ix_ing, cu_delta, n_uni, ix_data, iw(size(u%window)) integer cu_use(2), ix_var1, ix_bpm, ix_line, load_this, i_value, n_turn integer ix_phase, ix_phase_ref, ix_orbit, ix_orbit_ref, ix_eta, ix_eta_ref integer i_from, i_to, version, plot_type, ix_ac_eta, ix_ac_eta_ref integer, pointer :: i_ptr real(rp) merit0, tune_x, tune_y, maxim, minim, frac, value, factor real(rp) n_part, x_emit, y_emit, x_min, x_max real(rp) del_e, chrom_x, chrom_y, dtune_meas, dtune_model real(rp), pointer :: r_ptr character(*) cmd_line_in character(1) char character(12) ing_name character(20) prefix, what, from_name character(20), save :: plot_where character(40) db_lat, who, match_name, to_name character(140) cmd_file, line2, cmd_line, lat_file, cmd_line_saved, cmd_line_exact character(80) fmt, baseline_string, comment character(140) commandfiles, file_name, data_file logical limited, err_flag, matched, doit, ok, tag, old_logic, finished logical is_matched, old_var_good, minim_present, maxim_present logical found_ele, found, cbar_all, load_golden, no_close, exists logical :: multipoles_on = .true. logical do_all_universes, and_feature, baseline_here character(16) cmd_name character(16) :: cmd_names(72) = [character(16) :: & 'SET', 'RUN', 'SPECIAL', 'Q_TUNE', 'END_FILE', & 'HELP', 'CHROM_TUNE', 'CHANGE', 'DO', 'CLOSE_BUMP', & 'VETO', 'RESTORE', 'LIMIT', 'X_AXIS', 'ENGINE', & 'READ', 'USE', 'PRETZEL', 'PLOT', 'BASELINE', & 'WAVE_SET', 'DELETE_FILE', 'OPT_VARS', 'PAUSE', 'VIEW_UNIVERSE', & 'EXIT', 'CLIP', 'SCALE', 'WRITE', 'BETA_RENORMALIZE', & 'TAKE', 'TRANSFER', 'TAKZZZ', '-------', 'ENERGY_USER_CTRL', & 'SPECIES', 'CUT_RING', 'MULTIPOLE', 'INSERT', 'CALIBRATE', & 'OUTPUT', 'UNITS', 'MERIT_DATA', 'DMERIT', 'RECALIBRATE', & 'REMEMBER', 'LOAD', 'FLATTEN', 'SHOW', 'CREATE_UNIVERSES', & 'SAVE', 'ZERO', 'HISTORY', 'QUIT', 'REVERSE_TRACKING', & 'SPAWN', 'DIFFERENCES', 'FIX_GROUP', 'COLLIDE', 'REANALYZE_PHASE', & 'RF', 'POLARITY', 'CALL', 'SYNRAD ', 'RAYPLOT', & 'BURN', 'RAYOUTPUT', 'PROJECT', 'ORBMON', 'WALLPLOT', & 'EXPORT', 'XBSM'] logical blank_help(72) / & .true., .false., .false., .true., .false., & ! 1 - 5 .false., .false., .true., .true., .true., & ! 6 - 10 .true., .true., .false., .true., .false., & ! 11 - 15 .true., .true., .false., .false., .true., & ! 16 - 20 .true., .true., .true., .false., .true., & ! 21 - 25 .false., .false., .false., .false., .false., & ! 26 - 30 .false., .true., .false., .false., .false., & ! 31 - 35 .true., .true., .false., .true., .true., & ! 36 - 40 .true., .false., .false., .false., .false., & ! 41 - 45 .false., .false., .false., .false., .true., & ! 46 - 50 .true., .true., .false., .false., .false., & ! 51 - 55 .true., .false., .true., .false., .false., & ! 56 - 60 .true., .false., .true., .false., .false., & ! 61 - 65 .false., .false., .false., .false., .false., & .false., .false. / character(16) :: baseline_name(12) = ['DATA', 'MODEL', 'DESIGN', 'REFERENCE', & '--------', 'NONE', 'FIT', 'MB', 'RF', & 'RM', 'RMB', 'BASE_MODEL'] character(16) :: plot_var_names(10) = [& 'QUAD_K1 ', 'SKEW_QUAD_K1 ', 'HORIZONTAL ', 'HBND ', 'VERTICAL ', & 'SEX_K2 ', 'STANDARD ', 'RAW ', 'TWISS ', 'NORMALIZE_BETA'] character(16) :: x_axis_type(4) = [ "INDEX", "PHASE", "TUNE ", "S "] character(16), save :: take_what = '', old_what_data_read = '', what_data_read = '' character(16) read_what character(16) :: top_bot(7) = ['TOP ', 'BOTTOM ', 'ALL ', '2TOP ', '2BOTTOM', '2ALL ', 'ENTIRE '] logical, save :: init_needed = .true. namelist / lrbbi_params / x_emit, y_emit, n_part ! init if (init_needed) then call history_init (100) ! remember last 100 commands init_needed = .false. endif err_flag = .false. cmd_line_saved = cmd_line_in cmd_line = cmd_line_in cmd_line_exact = cmd_line_in 100 continue ! If the line is blank then there is nothing to be done call str_upcase(cmd_line, cmd_line) call string_trim(cmd_line, cmd_line, ix_line) call string_trim(cmd_line_exact, cmd_line_exact, ix_line) if (ix_line == 0 .or. cmd_line(1:1) == '!') return ! Process: Strip command line of comments, etc. ix = index(cmd_line, '!') if (ix /= 0) then cmd_line = cmd_line(:ix-1) ! strip off comments cmd_line_exact = cmd_line_exact(:ix-1) ! strip off comments endif ix = index(cmd_line, '?') if (ix > 1) then cmd_line = cmd_line(:ix-1) // ' ' // cmd_line(ix:) ! add a space cmd_line_exact = cmd_line_exact(:ix-1) // ' ' // cmd_line_exact(ix:) ! add a space endif call string_trim(cmd_line, cmd_line, ix_line) call string_trim(cmd_line_exact, cmd_line_exact, ix_line) ! "*" means do this to all universes ! "&" means a special feature do_all_universes = .false. if (cmd_line(1:1) == '*') then do_all_universes = .true. call string_trim (cmd_line(2:), cmd_line, ix_line) call string_trim (cmd_line_exact(2:), cmd_line_exact, ix_line) endif and_feature = .false. if (cmd_line(1:1) == '&') then and_feature = .true. call string_trim (cmd_line(2:), cmd_line, ix_line) call string_trim (cmd_line_exact(2:), cmd_line_exact, ix_line) endif ! add SET command if cmd_line has "=" ! but is not of the form "show com/route = ..." ix_e = index(cmd_line, '=') if (ix_e /= 0 .and. index('SET', cmd_line(:ix_line)) /= 1) then ix = index(cmd_line, '/') if (ix == 0 .or. ix == ix_e-1) then cmd_line = 'SET ' // cmd_line cmd_line_exact = 'SET ' // cmd_line_exact ix_line = 3 endif endif if (ix_line == 0) then ! nothing typed if (logic%command_file_open) then goto 100 ! ignore else return endif elseif (cmd_line(1:2) == 'L:' .or. cmd_line(1:2) == 'F:') then cmd_name = cmd_line(1:2) call string_trim (cmd_line(3:), cmd_line, ix_line) call string_trim (cmd_line_exact(3:), cmd_line_exact, ix_line) else call match_word (cmd_line, cmd_names, ix_cmd) if (ix_cmd > 0) then cmd_name = cmd_names(ix_cmd) else cmd_name = 'HELP' endif if ((cmd_name == 'EXIT' .or. cmd_name == 'QUIT') .and. ix_line < 3) then print *, 'NOTE: YOU NEED TO TYPE AT LEAST "EXI" OR "QUI" TO EXIT' err_flag = .true. return endif if (cmd_name == 'LOAD' .and. ix_line < 3) then print *, 'NOTE: YOU NEED TO TYPE AT LEAST "LOA" TO LOAD' err_flag = .true. return endif if (cmd_name == 'TAKE' .and. ix_line < 4) then print *, 'NOTE: YOU NEED TO TYPE AT LEAST "TAKE" TO TAKE A MEASUREMENT' err_flag = .true. return endif if (ix_cmd <= 0) then if (ix_cmd == 0) then print *, 'ERROR: UNRECOGNIZED COMMAND: ', cmd_line(:ix_line) print *, ' TYPE "HELP" FOR HELP OR SEE THE WEB DOCUMENTATION' else print *, 'ERROR: AMBIGUOUS COMMAND: ', cmd_line(:ix_line) print *, ' COULD BE:' i = 0 do while (.true.) i = i + 1 if (i > size(cmd_names)) exit if (index(cmd_names(i), cmd_line(:ix_line)) == 1) & print '(20x, a)', cmd_names(i) enddo endif if (logic%command_file_open) then close (logic%iu_command_file) logic%command_file_open = .false. endif err_flag = .true. return endif call string_trim (cmd_line(ix_line+1:), cmd_line, ix) call string_trim (cmd_line_exact(ix_line+1:), cmd_line_exact, ix_line) if (cmd_line(1:1) == '?' .or. (blank_help(ix_cmd) .and. ix_line == 0)) then call help_on_tap (cmd_name) return endif endif ! Record command in the history list (if not a HISTORY or REMEMBER command). ! If recording the commands then write to a file. ! if we are reading from a command file then comment out the commands in ! the file so that upon replay we do not do them twice. if (cmd_name /= 'HISTORY' .and. cmd_name /= 'REMEMBER') then call history_record (cmd_line_saved, logic%command_file_open) if (logic%remembering) then if (logic%command_file_open) then write (logic%iu_remember, *) '! ', trim(cmd_line_saved) else write (logic%iu_remember, *) trim(cmd_line_saved) endif endif endif ! Link two commands if (cmd_name == 'POLARITY') cmd_name = 'SPECIES' !-------------------------------- ! select the command select case (cmd_name) !-------------------------------- ! Baseline for plot case ('BASELINE') call baseline_cmd call plotdo ('X', graph, .false., u) !-------------------------------- ! beta_renormalize case ('BETA_RENORMALIZE') call beta_renormalize (u) call plotdo ('X', graph, .false., u) !-------------------------------- ! Burn case ('BURN') call synrad_init (u) call get_window_numbers (u%window, 'ONE', iw) if (iw(1) == 0) return call burn_plot (u%window, iw(1), u%ring, logic%synrad_params) !-------------------------------- ! calibration of steerings, quads, quad offsets case ('CALIBRATE') ! Check for emergency stop if (logic%command_file_open .and. logic%auto_measurement) then call get_tty_char (char, .false., .true.) if (char /= achar(0)) then print *, 'CHARACTER TYPED. EXITING COMMAND FILE...' close (logic%iu_command_file) logic%command_file_open = .false. return endif endif ! if (index('BPM', cmd_line(:ix_line)) == 1) then who = 'BPM' call string_trim(cmd_line(ix_line+1:), cmd_line, ix_line) call cesr_locator (cmd_line(1:ix_line), prefix, ix_var1, err_flag) if (prefix /= '' .or. err_flag .or. ix_var1 < 0 .or. ix_var1 > 120) then print *, 'ERROR: CANNOT READ BPM NUMBER' err_flag = .true. return endif else do ix_var1 = 1, size(u%var) if (cmd_line(:ix_line) == u%var(ix_var1)%name) exit if (ix_var1 == size(u%var)) then err_flag = .true. print *, 'ERROR: CANNOT FIND VARIABLE IN MY VARIABLE ARRAYS: ', cmd_line(:ix_line) return endif enddo who = u%var(ix_var1)%db_node_name endif call string_trim (cmd_line(ix_line+1:), cmd_line, ix_line) cu_use = 0 if (ix_line /= 0) then ix = index(cmd_line, '%') if (ix /= 0) then if (cmd_line(ix+1:) /= '') then print *, 'ERROR: EXTRA CHARACTERS AFTER "%"' return endif read (cmd_line(1:ix-1), *, iostat = ios) cu_use(2) if (ios /= 0) then print *, 'ERROR: CANNOT READ NUMBER #', i err_flag = .true. return endif else do i = 1, 2 read (cmd_line, *, iostat = ios) cu_use(i) if (ios /= 0) then print *, 'ERROR: CANNOT READ NUMBER #', i err_flag = .true. return endif call string_trim (cmd_line(ix_line+1:), cmd_line, ix_line) if (len_trim(cmd_line) == 0) exit enddo endif endif select case (who) case ('CSR HORZ CUR', 'CSR VERT CUR', 'UND VERT CUR', 'CSR HBND CUR', 'CSR HSP VOLT') call calibrate_steering (ix_var1, 'NEW_CAL', cu_use, u, graph, err_flag) case ('BPM') if (logic%bpm_calib_load_golden .and.all(u%var%cu_golden == 0)) then print *, 'YOU MUST DO "SAVE GOLDEN" TO SAVE GOLDEN STEERINGS!' return endif do i = 1, max(1, logic%bpm_calib_max_cycles) call calibrate_bpm (ix_var1, -1, 'NEW_CAL', cu_use, u, graph, err_flag, i, finished) if (finished) exit enddo if (logic%bpm_calib_load_golden) call load_steerings (u, 1.0_rp, .true.) case ('CSR QUAD CUR', 'CSR QADD CUR') call calibrate_quad (ix_var1, 'NEW_CAL', cu_use, u, graph, err_flag) case ('CSR SQEWQUAD') call calibrate_skewquad (ix_var1, 'NEW_CAL', cu_use, u, graph, err_flag) case ('CSR SEXT CUR') call calibrate_sextupole (ix_var1, cu_use, u, err_flag) case default print *, 'ERROR: CALIBRATION OF THIS VARIABLE NOT IMPLEMENTED' end select !-------------------------------- ! Change variables by hand case ('CHANGE') call change_var (cmd_line, do_all_universes, u) call plotdo ('X', graph, .false., u) !-------------------------------- ! chrom_tune case ('CHROM_TUNE') if (index('DATA', cmd_line(1:ix_line)) == 1) then chrom_x = u%chrom%x%d(1)%meas chrom_y = u%chrom%y%d(1)%meas elseif (index ('DESIGN', cmd_line(1:ix_line)) == 1) then chrom_x = u%chrom%x%d(1)%design chrom_y = u%chrom%y%d(1)%design else if (cmd_line (1:1) == '@') then read (cmd_line(2:), *, iostat = ios) chrom_x, chrom_y else read (cmd_line, *, iostat = ios) chrom_x, chrom_y chrom_x = u%chrom%x%d(1)%model + chrom_x chrom_y = u%chrom%y%d(1)%model + chrom_y endif if (ios /= 0) then print *, 'ERROR: CANNOT READ CHROMATICITIES' return endif endif del_e = 0 call chrom_tune (u%ring, del_e, chrom_x, chrom_y, 0.05_rp, err_flag) call ring_calc (u) call plotdo ('X', graph, .false., u) !-------------------------------- ! clip data case ('CLIP') call parse_scale_clip ('CLIP', err_flag) if (err_flag) return if (logic%plot_what == 'PLOT_WAVE') then call clip_data (maxim, u%wave%p2, .true., .false., .false.) if (u%wave%wave_what == 'CBAR') then u%cbar%m11%d%good_user = u%cbar%m12%d%good_user u%cbar%m22%d%good_user = u%cbar%m12%d%good_user elseif (u%wave%plane == x_plane$) then u%wave%p2%d2%y%d(:)%good_user = u%wave%p2%d2%x%d(:)%good_user elseif (u%wave%plane == y_plane$) then u%wave%p2%d2%x%d(:)%good_user = u%wave%p2%d2%y%d(:)%good_user elseif (u%wave%plane == in_plane$) then u%wave%p2%d2%y%d(:)%good_user = u%wave%p2%d2%a_in%d(:)%good_user elseif (u%wave%plane == out_plane$) then u%wave%p2%d2%y%d(:)%good_user = u%wave%p2%d2%a_out%d(:)%good_user endif elseif (.not. associated (p2_plot(1)%p2)) then print *, 'ERROR: WHAT TO CLIP? (TOP, BOTTOM, X, Y, ..._rp)' print *, ' TYPE "HELP CLIP" FOR MORE INFORMATION' return else do i = 1, size(p2_plot) if (.not. associated(p2_plot(i)%p2)) cycle call clipit (p2_plot(i)%p2) enddo endif call plotdo ('X', graph, .false., u) return !-------------------------------- ! close bump case ('CLOSE_BUMP') if (cmd_line(1:5) == 'CBUMP') then ing_name = 'CHS CBUMPING' else ing_name = 'CSR ' // cmd_line(1:5) // 'ING' endif call string_trim(cmd_line(ix_line+1:), cmd_line, ix_line) read (cmd_line, *, iostat = ios) ix_ing if (ios /= 0 .or. ix_line == 0) then print *, 'ERROR: CANNOT READ BUMP ELEMENT NUMBER: ', cmd_line(:ix_line) return endif call string_trim(cmd_line(ix_line+1:), cmd_line, ix_line) if (ix_line == 0) then cu_delta = 0 else read (cmd_line, *, iostat = ios) cu_delta if (ios /= 0) then print *, 'ERROR: CANNOT READ CU_DELTA' return endif endif call close_bump (ing_name, ix_ing, cu_delta, u, graph, err_flag) if (err_flag) return !-------------------------------- ! Create case ('CREATE_UNIVERSES') read (cmd_line, *, iostat = ios) n_uni if (ios /= 0) then print *, 'ERROR READING NUMBER OF UNIVERSES TO CREATE.' err_flag = .true. return endif if (n_uni < 1) then print *, 'ERROR: UNIVERSE NUMBER MUST BE GREATER THAN 1' err_flag = .true. return endif ix_phase = -1; ix_phase_ref = -1 ix_orbit = -1; ix_orbit_ref = -1 ix_eta = -1; ix_eta_ref = -1 ix_ac_eta = -1; ix_ac_eta_ref = -1 if (u%phase%measured) ix_phase = u%phase%ix_meas if (u%phase%ref_measured) ix_phase_ref = u%phase%ix_ref if (u%orbit%measured) ix_orbit = u%orbit%ix_meas if (u%orbit%ref_measured) ix_orbit_ref = u%orbit%ix_ref if (u%eta%measured) ix_eta = u%eta%ix_meas if (u%eta%ref_measured) ix_eta_ref = u%eta%ix_ref if (u%ac_eta%measured) ix_ac_eta = u%ac_eta%ix_meas if (u%ac_eta%ref_measured) ix_ac_eta_ref = u%ac_eta%ix_ref ix1 = graph%top1%d2%type ix2 = graph%bottom1%d2%type ring_save = u%ring call deallocate_lat_pointers(u%ring) u_save = u deallocate (super%u_) allocate (super%u_(n_uni)) logic%u_num = n_uni do i = 1, n_uni super%u_(i) = u_save super%u_(i)%ring = ring_save call reallocate_coord (super%u_(i)%orb, ring_save%n_ele_max) super%u_(i)%orb(0)%vec = 0 call init_universe (super%u_(i)) call reinit_lat_pointers (super%u_(i)) enddo u => super%u_(1) logic%u_view = 1 call opt_vars_set (logic%opt_vars, .true.) if (ix_phase > 0) call read_phase (data_file$, ix_phase, u, graph, err_flag, .false.) if (ix_phase_ref > 0) call read_phase (ref_file$, ix_phase_ref, u, graph, err_flag, .false.) if (ix_orbit > 0) call read_orbit (data_file$, ix_orbit, u, graph, err_flag) if (ix_orbit_ref > 0) call read_orbit (ref_file$, ix_orbit_ref, u, graph, err_flag) if (ix_eta > 0) call read_eta (data_file$, ix_eta, u, graph, err_flag, .false.) if (ix_eta_ref > 0) call read_eta (ref_file$, ix_eta_ref, u, graph, err_flag, .false.) if (ix_ac_eta > 0) call read_ac_eta (data_file$, ix_ac_eta, u, graph, err_flag, .false.) if (ix_ac_eta_ref > 0) call read_ac_eta (ref_file$, ix_ac_eta_ref, u, graph, err_flag, .false.) nullify (graph%top1%d2, graph%top2%d2, graph%bottom1%d2, graph%bottom2%d2) call set_plot2 (graph%top1, ix1, u) call set_plot2 (graph%bottom1, ix2, u) call plotdo ('X', graph, .false., u) print *, 'Universes Created and Initialized.' !-------------------------------- ! CUT_RING: case ('CUT_RING') if (cmd_line(1:ix_line) == '-') then u%ring%param%geometry = closed$ logic%ix_cut_ring = -1 logic%calc_twiss_with_cut_ring = .false. do i = 1, 6 u%init_orb%v(i)%ix_ele = -1 u%init_orb%v(i)%exists = .false. enddo logic%ok_to_read_dmerit_file = .true. print *, 'Ring is now Closed.' else call locate_element (u%ring, cmd_line(1:ix_line), ix, err_flag) if (err_flag) return u%ring%param%geometry = open$ logic%ix_cut_ring = ix print *, 'Ring is now Open. Cut at: ', u%ring%ele(ix)%name do i = 1, 6 u%init_orb%v(i)%model => u%orb(ix)%vec(i) u%init_orb%v(i)%model = 0 u%init_orb%v(i)%ix_ele = ix u%init_orb%v(i)%exists = .true. enddo logic%ok_to_read_dmerit_file = .false. endif if (and_feature .and. u%ring%param%geometry == open$) then logic%calc_twiss_with_cut_ring = .true. print *, ' Note: Twiss recalc IS using the cut' else logic%calc_twiss_with_cut_ring = .false. endif call opt_vars_set (opt_steering$, .true.) call plotdo ('X', graph, .false., u) !-------------------------------- case ('DELETE_FILE') if (index('MODEL', cmd_line(:ix_line)) == 1) then file_name = '$CESR_ONLINE/acc_control/program_info/cesrv/model/model.number' data_file = '$CESR_ONLINE/acc_control/program_info/cesrv/model/model.' elseif (index('PHASE', cmd_line(:ix_line)) == 1) then file_name = '$CESR_ONLINE/machine_data/mach_meas/phase/phase.number' data_file = '$CESR_ONLINE/machine_data/mach_meas/phase/phase.' elseif (INDEX('ETA', cmd_line(:ix_line)) == 1) then file_name = '$CESR_ONLINE/machine_data/mach_meas/eta/eta.number' data_file = '$CESR_ONLINE/machine_data/mach_meas/eta/eta.' else print *, "I DON'T KNOW WHICH FILE TO DELETE (MODEL, PHASE, ETA)" return endif call get_input_string ('Delete are you sure? ', cmd_line) call string_trim (cmd_line, cmd_line, ix_line) call str_upcase (cmd_line, cmd_line) if (ix_line > 0 .and. index ('YES', cmd_line(:ix_line)) == 1) then call calc_file_number (file_name, 0, ix, err_flag) call change_file_number (file_name, -1) print '(2a, i6)', ' FILE DELETED: ', trim(data_file), ix endif !-------------------------------- ! Dmerit case ('DMERIT') if (ix_line == 0) then call dmerit_calc ('reinit') elseif (index('DIGEST', cmd_line(1:ix_line)) == 1) then call write_digested_dmerit (ok, u) else print *, 'WHAT IS THIS?: ', trim(cmd_line) endif !-------------------------------- ! read in command file case ('DO', 'CALL') if (logic%command_file_open) then print *, 'ERROR: COMMAND FILES CANNOT BE NESTED!' logic%command_file_open = .false. err_flag = .true. endif cmd_file = cmd_line_exact(:ix_line) open (logic%iu_command_file, file = cmd_file, status = 'old', action = 'read', iostat = ios) if (ios /= 0) then call file_suffixer (cmd_line_exact(:ix_line), cmd_file, '.cesrv', .false.) open (logic%iu_command_file, file = cmd_file, status = 'old', action = 'read', iostat = ios) endif cmd_line = cmd_line_exact(ix_line+1:) logic%cmd_file_arg = '' logic%cmd_file_arg(0) = cmd_line do i = 1, 9 call string_trim(cmd_line, cmd_line, ix) if (ix == 0) exit logic%cmd_file_arg(i) = cmd_line(:ix) cmd_line = cmd_line(ix+1:) enddo if (ios == 0) then print *, 'Opened Command File: ', trim(cmd_file) logic%command_file_open = .true. return endif file_name = cmd_file call fullfilename('$CESR_ONLINE/acc_control/program_info/cesrv/command_files', & commandfiles) call file_directorizer (cmd_file, cmd_file, commandfiles, .true.) open (logic%iu_command_file, file = cmd_file, status = 'old', action = 'read', iostat = ios) if (ios == 0) then print *, 'Opened Command File: ', trim(cmd_file) logic%command_file_open = .true. return endif print * print *, 'ERROR: CANNOT OPEN FILE: ', trim(file_name) print *, ' NOR THE FILE: ', trim(cmd_file) err_flag = .true. return !-------------------------------- ! End_file case ('END_FILE') if (.not. logic%command_file_open) then print *, 'NO COMMAND FILE IS OPEN!' return endif close (logic%iu_command_file) logic%command_file_open = .false. !-------------------------------- case ('ENERGY_USER_CTRL') old_var_good = u%energy_var%v(1)%good_user if (ix_line /= 0 .and. index('RING', cmd_line(:ix_line)) == 1) then read (cmd_line(ix_line+1:), *, iostat = ios) value if (ios /= 0) then print *, 'ERROR READING RING ENERGY VALUE.' return endif if (value <= 0) then print *, 'ERROR: RING ENERGY VALUE MUST BE POSITIVE.' return endif call init_lattice (u, .false., no_make_groups$) print *, 'Reinitialized lattice with Energy:', value return endif if (ix_line == 2 .and. cmd_line(:2) == 'ON') then call string_trim (cmd_line(ix_line+1:), cmd_line, ix_line) value = 0 if (ix_line /= 0) then ! there might be a number if (index('-.0123456789', cmd_line(1:1)) /= 0) then read (cmd_line, *) value else print *, 'ERROR: BAD ENERGY VALUE GIVEN' return endif endif if (do_all_universes) then do k = 1, logic%u_num uu => super%u_(k) uu%energy_var%v(1)%model => uu%orb(0)%vec(6) uu%energy_var%v(1)%model = value uu%energy_data%d1%d(1)%good_user = .false. uu%energy_var%v(1)%good_user = .true. enddo else u%energy_var%v(1)%model => u%orb(0)%vec(6) u%energy_var%v(1)%model = value u%energy_data%d1%d(1)%good_user = .false. u%energy_var%v(1)%good_user = .true. endif elseif (ix_line >= 2 .and. index('OFF', cmd_line(:ix_line)) == 1) then if (do_all_universes) then do k = 1, logic%u_num uu => super%u_(k) uu%energy_data%d1%d(1)%good_user = .true. uu%energy_var%v(1)%good_user = .false. uu%energy_var%v(1)%model = 0.0 ! Zero the energy error enddo else u%energy_data%d1%d(1)%good_user = .true. u%energy_var%v(1)%good_user = .false. u%energy_var%v(1)%model = 0.0 ! Zero the energy error endif elseif (ix_line /= 0) then print *, 'ERROR: ENERGY_USER_CTRL HOW? (OFF, ON , or " ")' print *, ' TYPE "HELP ENERGY_USER_CTRL" FOR MORE INFORMATION' return endif call showit ('ENERGY_SHIFT', u) if (old_var_good .neqv. u%energy_var%v(1)%good_user) then print *, 'I should recalculate the dMerit matrix...' doit = .true. call get_cesrv_command ( 'Do you want me to recalculate the dMerit matrix?', & cmd_logic = doit) if (doit) call dmerit_calc ('reinit') endif call ring_calc (u) call plotdo ('X', graph, .false., u) !-------------------------------- ! engine? case ('ENGINE') if (ix_line /= 0) then if (index('FLETCHER', cmd_line(:ix_line)) == 1) then logic%engine = 'FLETCHER-REEVES' elseif (index('MARQUARDT', cmd_line(:ix_line)) == 1) then logic%engine = 'LEVENBERG-MARQUARDT' else print *, "ERROR: I DON'T UNDERSTAND THIS" print *, ' TYPE "HELP ENGINE" FOR MORE INFORMATION' return endif endif print *, 'Optimizing Engine: ', logic%engine !-------------------------------- ! exit case ('EXIT', 'QUIT') call mpm_goodbye stop !-------------------------------- ! export case ('EXPORT') ! could be generalized to other export cases call export_lightsources(u%ring) !-------------------------------- ! F: case ('F:') call bmad_parser (cmd_line_exact, u%ring, err_flag = err_flag) if (err_flag) return call init_lattice(u, .false., make_groups$) call plotdo ('X', graph, .false., u) !-------------------------------- ! fix_group case ('FIX_GROUP') ing_name = 'CSR ' // cmd_line(1:5) // 'ING' call string_trim(cmd_line(ix_line+1:), cmd_line, ix_line) read (cmd_line, *, iostat = ios) ix_ing if (ios /= 0 .or. ix_line == 0) then print *, 'ERROR: CANNOT READ GROUP ELEMENT NUMBER: ', cmd_line(:ix_line) err_flag = .true. return endif call string_trim(cmd_line(ix_line+1:), cmd_line, ix_line) if (ix_line == 0) then print *, 'ERROR: CU_DELTA NEEDS TO BE SPECIFIED!' err_flag = .true. return else read (cmd_line, *, iostat = ios) cu_delta if (ios /= 0) then print *, 'ERROR: CANNOT READ CU_DELTA' err_flag = .true. return endif if (cu_delta == 0) then print *, 'ERROR: CU_DELTA MUST BE NON-ZERO' err_flag = .true. return endif endif call fix_group (ing_name, ix_ing, cu_delta, u, err_flag) if (err_flag) return !-------------------------------- ! Help case ('HELP') if (ix_line == 0) then call help_on_tap ('HELP') else call help_on_tap (cmd_line) endif !-------------------------------- ! History case ('HISTORY') if (ix_line == 0) then call history_type (50) return elseif (index('-+0123456789', cmd_line(1:1)) /= 0) then ! number read (cmd_line(1:ix_line), *, iostat = ios) ix1 if (ios /= 0) then print *, 'ERROR READING HISTORY NUMBER' err_flag = .true. return endif call history_recall (ix1, cmd_line_saved, tag, found) if (.not. found) then print *, 'ERROR: INVALID INDEX FOR THE HISTORY LIST.' err_flag = .true. return endif else call history_recall (cmd_line, cmd_line_saved, tag, found) if (.not. found) then print *, 'ERROR: COMMAND NOT FOUND IN THE HISTORY LIST.' err_flag = .true. return endif endif cmd_line = cmd_line_saved print *, trim(logic%prompt_str), ': ', trim(cmd_line) goto 100 !-------------------------------- case ('INSERT') if (index('BBI', cmd_line(:ix_line)) == 1) then u%ring%ele(1)%name = 'BBI' u%ring%ele(1)%key = beambeam$ u%ring%ele(1)%value(sig_x$) = 400e-6 u%ring%ele(1)%value(sig_y$) = 8e-6 u%ring%ele(1)%value(charge$) = -1 call lat_make_mat6 (u%ring, 1, u%orb) print *, 'Element #1 Converted to a BBI element' call reinit_lat_pointers (u) elseif (index('LRBBI', cmd_line(:ix_line)) == 1) then inquire (file = cmd_line_exact(ix_line+1:), exist = exists) if (.not. exists) call file_suffixer (cmd_line_exact(ix_line+1:), file_name, '.bmad', .false.) call bmad_parser2 (file_name, u%ring, u%orb, err_flag = err_flag) if (err_flag) return call reinit_lat_pointers (u) open (1, file = file_name, status = 'old') read (1, nml = lrbbi_params, iostat = ios) u%ring%a%emit = x_emit u%ring%b%emit = y_emit close (1) if (ios /= 0) then print *, 'ERROR READING "LRBBI_PARAMS" NAMELIST IN FILE' return endif do i = 1, u%ring%n_ele_track if (u%ring%ele(i)%name(1:6) == 'LRBBI_') then u%ring%ele(i)%value(charge$) = -1 u%ring%ele(i)%a = u%ring%ele(i-1)%a u%ring%ele(i)%b = u%ring%ele(i-1)%b endif enddo u%ring%param%n_part = n_part logic%lrbbi_inserted = .true. call ring_calc (u) elseif (index('FILE', cmd_line(:ix_line)) == 1) then call file_suffixer (cmd_line_exact(ix_line+1:), file_name, '.bmad', .false.) call bmad_parser2 (file_name, u%ring, u%orb, err_flag = err_flag) if (err_flag) return call reinit_lat_pointers (u) else print *, 'I DO NOT UNDERSTAND WHAT TO INSERT (BBI, LRBBI, FILE)' return endif print *, 'Insert Done' call plotdo ('X', graph, .false., u) !-------------------------------- ! LIMIT case ('LIMIT') if (ix_line == 0) then logic%limit_on = .true. print *, 'Limits are now Active' elseif (ix_line == 2 .and. cmd_line(:2) == 'ON') then logic%limit_on = .true. print *, 'Limits are now Active' elseif (ix_line >= 2 .and. index('OFF', cmd_line(:ix_line)) == 1) then logic%limit_on = .false. print *, 'Limits are now NOT Active' elseif (index('ZERO', cmd_line(:ix_line)) == 1) then call string_trim(cmd_line(ix_line+1:), cmd_line, ix_line) who = cmd_line(:ix_line) call string_trim(cmd_line(ix_line+1:), cmd_line, ix_line) read (cmd_line(:ix_line), *, iostat = ios) i_value if (ios /= 0) then print *, 'ERROR: BAD NUMBER: ', cmd_line(:ix_line) return endif !! call limit_near_zero (who, i_value) if (index('HORIZONTAL', trim(who)) == 1) then u%hsteer_kick%v(:)%cu_zero_lim = i_value elseif (index('VERTICAL', trim(who)) == 1) then u%vsteer_kick%v(:)%cu_zero_lim = i_value else print *, 'ERROR: LIMIT ZERO HORIZONTAL OR VERTICAL?' return endif else print *, 'ERROR: LIMIT HOW? (ON, OFF, or " ")' print *, ' TYPE "HELP LIMIT" FOR MORE INFORMATION' return endif call limit_calc (limited) call plotdo ('X', graph, .false., u) !-------------------------------- ! load model with design or saved, etc case ('LOAD') ! Right now have 'load golden' default to steerings. load_golden = .false. if (ix_line > 0 .and. index('GOLDEN', cmd_line(1:ix_line)) == 1) then load_golden = .true. call string_trim(cmd_line(ix_line+1:), cmd_line, ix_line) if (ix_line == 0) then print *, 'Saving current Model state (just in case)' call write_model (1, u, " ") call load_steerings (u, frac, load_golden) return endif endif load_this = logic%opt_vars if (ix_line > 0 .and. index ('+-.0123456789 ', cmd_line(1:1)) == 0) then if (index('QUADRUPOLEs', cmd_line(1:ix_line)) == 1) then load_this = opt_quad$ elseif (index('STEERINGS', cmd_line(1:ix_line)) == 1) then load_this = opt_steering$ elseif (index('SEXTUPOLES', cmd_line(1:ix_line)) == 1) then load_this = opt_sex$ elseif (index('_SKEW_SEX', cmd_line(1:ix_line)) == 1) then load_this = opt_skew_sex$ elseif (index('SKEW_QUAD', cmd_line(1:ix_line)) == 1) then load_this = opt_skew_quad$ else print *, 'ERROR: LOAD WHAT? NOTHING LOADED' print *, ' TYPE "HELP LOAD" FOR MORE INFORMATION' return endif call string_trim (cmd_line(ix_line+1:), cmd_line, ix_line) endif frac = 1.0 if (ix_line /= 0) then read (cmd_line, *, iostat = ios) frac if (ios /=0) then print *, 'ERROR READING LOAD NUMBER. NOTHING LOADED' print *, ' TYPE "HELP LOAD" FOR MORE INFORMATION' return endif endif select case (load_this) case (opt_steering$) print *, 'Saving current Model state (just in case)' call write_model (1, u, " ") call load_steerings (u, frac, load_golden) case (opt_quad$) print *, 'Saving current Model state (just in case)' call write_model (1, u, " ") call load_quads (u, frac) case (opt_sex$) print *, 'Saving current Model state (just in case)' call write_model (1, u, " ") call load_sex (u, frac) case (opt_skew_quad$) print *, 'Saving current Model state (just in case)' call write_model (1, u, " ") call load_skew_quads (u, frac) case (opt_skew_sex$) print *, 'Saving current Model state (just in case)' call write_model (1, u, " ") call load_skew_sex (u, frac) case default print *, 'WHAT TO LOAD? (STEERINGS, QUADRUPOLE, ETC.)' end select !-------------------------------- ! L: case ('L:') call getlat (db_lat) call choose_cesr_lattice (logic%lattice, lat_file, db_lat, u%ring, cmd_line, err_flag) if (err_flag) return print *, 'Lattice file: ', trim(lat_file) call init_lattice(u, .false., make_groups$) call plotdo ('X', graph, .false., u) !-------------------------------- ! merit_data case ('MERIT_DATA') if (index('TWISS', cmd_line(:ix_line)) == 1) then call opt_data_set (opt_twiss$, u) elseif (index('ORBIT', cmd_line(:ix_line)) == 1) then call opt_data_set (opt_orbit$, u) elseif (index('ALL_DATA', cmd_line(:ix_line)) == 1) then call opt_data_set (opt_all_data$, u) elseif ('CBAR11' == cmd_line(:ix_line)) then call cbar_true_or_false ('CBAR11', doit) logic%opt_cbar11 = doit call opt_data_set (logic%opt_data, u) elseif ('CBAR22' == cmd_line(:ix_line)) then call cbar_true_or_false ('CBAR22', doit) logic%opt_cbar22 = doit call opt_data_set (logic%opt_data, u) else print *, 'ERROR: WHAT DATA TO USE IN THE OPTIMIZATION? (TWISS, ORBIT, ALL)' endif call set_data_useit_opt (u%data) !-------------------------------- case ('MULTIPOLE') if (cmd_line(:ix_line) == 'ON') then multipoles_on = .true. elseif (ix_line > 1 .and. index('OFF', cmd_line(:ix_line)) == 1) then multipoles_on = .false. elseif (ix_line /= 0) then Print *, 'ERROR: MULTIPOLES "ON" OR "OFF"?' endif u%ring%ele(:)%multipoles_on = multipoles_on print *, 'Multipoles are: ', on_off(multipoles_on) call plotdo ('X', graph, .false., u) !-------------------------------- ! opt_vars case ('OPT_VARS') ! lock/unlock if (index('UNLOCKED', cmd_line(:ix_line)) == 1) then logic%opt_vars_locked = .false. print *, 'Opt_vars are: UNLOCKED' return endif if (index('LOCKED', cmd_line(:ix_line)) == 1) then logic%opt_vars_locked = .true. print *, 'Opt_vars are: LOCKED' return endif ! match to quad, sextupole, etc. call match_word2 (cmd_line, name$%opt_vars, iopt) if (iopt <= 0) then print *, "ERROR: I DON'T UNDERSTAND THIS" print *, ' TYPE "HELP OPT_VARS" FOR MORE INFORMATION' return endif ! unlock before makeing any set and reset to inital state after everything. old_logic = logic%opt_vars_locked logic%opt_vars_locked = .false. call string_trim (cmd_line_exact(ix_line+1:), cmd_line_exact, ix_line) if (iopt == opt_custom$ .or. (iopt == opt_all_vars$ .and. & ix_line /= 0)) then if (ix_line == 0) then file_name = 'special_vars.in' else call file_suffixer (cmd_line_exact, file_name, '.in', .false.) endif call opt_vars_set(iopt, .false., file_name) else call opt_vars_set(iopt, .false.) endif logic%opt_vars_locked = old_logic !-------------------------------- ! ORBMON case ('ORBMON') ! init with current lattice call getlat (db_lat) call choose_cesr_lattice (logic%lattice, lat_file, db_lat, u%ring, '0', err_flag = err_flag) if (err_flag) return call init_lattice(u, .false., make_groups$) logic%plotit = .true. call plotdo ('SCALE .8', graph, .false., u) call plotdo ('X', graph, .false., u) call orbmon(u, graph, err_flag) !-------------------------------- ! OUTPUT case ('OUTPUT') no_close = .false. call match_word2 (cmd_line, ['-NO_CLOSE'], ix, what) select case(what) case ('-NO_CLOSE') no_close = .true. call string_trim(cmd_line(ix_line+1:), cmd_line, ix_line) end select call match_word2 (cmd_line, ['GIF ', 'PS ', 'HARDCOPY'], ix, what) if (what == 'GIF') then call plotdo ('GIF', graph, .false., u, no_close) elseif (what == 'HARDCOPY') then call plotdo ('PS', graph, .true., u) elseif (what == 'PS') then call plotdo ('PS', graph, .false., u, no_close) else print *, 'WHAT TO OUTPUT?' print *, ' TYPE "HELP OUTPUT" FOR MORE INFORMATION' endif !-------------------------------- ! PAUSE case ('PAUSE') if (ix_line == 0) then call milli_sleep (3000) return endif read (cmd_line, *, iostat = ios) value if (ios /= 0) then print *, 'ERROR READING PAUSE VALUE.' return endif if (value > 0) then call milli_sleep (nint(value*1000)) else call get_input_string ('Hit CR to continue:', cmd_line) endif !-------------------------------- ! Pretzel toggle case ('PRETZEL') call match_word2 (cmd_line, pretzel_names, ixx) if (ixx <= 0) then print *, 'ERROR: UNKNOWN PRETZEL SETTING' print *, ' TYPE "HELP PRETZEL" FOR MORE INFORMATION' return endif call string_trim (cmd_line(ix_line+1:), cmd_line, ix_line) if (ix_line == 0) then factor = 1.0 else read (cmd_line, *, iostat = ios) factor if (ios /= 0) then print *, 'ERROR READING FACTOR. NOTHING CHANGED' return endif endif call pretzel_set (ixx, factor, u) print *, 'SEPARATOR STATE: ', pretzel_names(logic%pretzel) call plotdo ('X', graph, .false., u) !-------------------------------- ! Plot case ('PLOT') ixq = index(cmd_line, 'QX') ix = index(cmd_line, '-') if (ix == 0 .or. (ixq /= 0 .and. ixq == ix-2)) then baseline_here = .false. else baseline_here = .true. baseline_string = cmd_line(ix+1:) cmd_line(ix:ix) = ' ' call string_trim(cmd_line(ix:), cmd_line(ix:), ix2) cmd_line(ix:ix+ix2-1) = ' ' ix_line = max(1, ix-1) endif logic%plot_special = .false. if (ix_line == 0) then call plotdo ('X', graph, .false., u) return endif if (index('MAGNIFICATION', cmd_line(:ix_line)) == 1 .and. ix_line > 2) then logic%plotit = .true. call plotdo ('SCALE ' // cmd_line(ix_line+1:), graph, .false., u) call plotdo ('X', graph, .false., u) return endif if (index('WIDE', cmd_line(:ix_line)) == 1 .and. ix_line > 1) then logic%plotit = .true. logic%wide_plot_window = .not. logic%wide_plot_window call plotdo ('WIDE', graph, .false., u) call plotdo ('X', graph, .false., u) return endif if (cmd_line == 'ON') then logic%plotit = .true. call plotdo ('INIT', graph, .false., u) call plotdo ('X', graph, .false., u) return endif if (cmd_line == 'OFF') then logic%plotit = .false. return endif ! Allow "plot phase top" or "plot top phase" syntax call match_word2 (cmd_line, top_bot, ix_plot_where, plot_where) if (ix_plot_where < 0) return ! ambiguous name if (ix_plot_where > 0) then cmd_line = cmd_line(ix_line+1:) else call string_trim (cmd_line(ix_line+1:), line2, ix2) if (ix2 /= 0 .and. cmd_line(1:3) /= 'FFT') then call match_word2 (line2, top_bot, ix_plot_where, plot_where) if (ix_plot_where <= 0) then print *, 'ERROR: I DO NOT UNDERSTAND WHERE TO PLOT (TOP, BOTTOM, ALL, " ")' return endif endif endif if (ix_plot_where == 0) plot_where = '' call pointer_to_p2_plots (plot_where) matched = .false. ! Try to match against a data type call match_word2 (cmd_line, name$%data_type_name, ixx, match_name) if (match_name == 'FFT') then call set_plot2(graph%top1, x_fft_data$, u) call set_plot2(graph%bottom1, y_fft_data$, u) logic%plot_what = 'PLOT_DATA' matched = .true. endif if (match_name == '2Q') then if (.not. associated(p2_plot(2)%p2)) then print *, 'BAD COMBINATION...' return endif call set_plot2(p2_plot(1)%p2, q2x_data$, u) call set_plot2(p2_plot(2)%p2, q2y_data$, u) if (associated(p2_plot(4)%p2)) then call set_plot2(p2_plot(3)%p2, q2x_data$, u) call set_plot2(p2_plot(4)%p2, q2y_data$, u) endif logic%plot_what = 'PLOT_DATA' matched = .true. endif if (match_name == 'QX') then if (.not. associated(p2_plot(2)%p2)) then print *, 'BAD COMBINATION...' return endif call set_plot2(p2_plot(1)%p2, qx_plus_qy_data$, u) call set_plot2(p2_plot(2)%p2, qx_minus_qy_data$, u) if (associated(p2_plot(4)%p2)) then call set_plot2(p2_plot(3)%p2, qx_plus_qy_data$, u) call set_plot2(p2_plot(4)%p2, qx_minus_qy_data$, u) endif logic%plot_what = 'PLOT_DATA' matched = .true. endif if (match_name == 'Q_RES') then if (.not. associated(p2_plot(2)%p2)) then print *, 'BAD COMBINATION...' return endif call set_plot2(p2_plot(1)%p2, q2x_data$, u) call set_plot2(p2_plot(2)%p2, q2y_data$, u) if (associated(p2_plot(4)%p2)) then call set_plot2(p2_plot(3)%p2, qx_plus_qy_data$, u) call set_plot2(p2_plot(4)%p2, qx_minus_qy_data$, u) endif logic%plot_what = 'PLOT_DATA' matched = .true. endif if (ixx < 0) return ! ambiguous name if (ixx > 0 .and. .not. matched) then logic%plot_what = 'PLOT_DATA' if (ixx == spline_data$ .and. ix_plot_where <= 0) then if (graph%bottom1%d2%type == phase_data$) then call set_plot2(graph%top1, ixx, u) else call set_plot2(graph%bottom1, ixx, u) endif elseif (ixx == wave_data$) then logic%plot_what = 'PLOT_WAVE' elseif (ix_plot_where <= 0) then if (ixx == cbar_data$) then call set_plot2 (graph%bottom1, ixx, u) else call set_plot2 (graph%top1, ixx, u) endif else call pointer_to_p2_plots (plot_where) do i = 1, size(p2_plot) if (.not. associated(p2_plot(i)%p2)) cycle call set_plot2 (p2_plot(i)%p2, ixx, u) enddo endif matched = .true. endif ! Try to match against "model", "base", etc call match_word2 (cmd_line, name$%plot_data_name, ixx, match_name) if (ixx < 0) return ! ambiguous name if (ixx > 0) then do i = 1, size(p2_plot) if (.not. associated(p2_plot(i)%p2)) cycle call plot_data_set (p2_plot(i)%p2, ixx, .true.) if (plot_type_has(plot_ref$, ixx)) then if (.not. p2_plot(i)%p2%d2%ref_measured) then print *, 'ERROR: A REFERENCE MUST BE READ IN BEFORE YOU CAN PLOT THIS.' print *, ' USE THE "READ" COMMAND TO READ IN A REFERENCE.' return endif call baseline_set (plot_ref$, subtract$, p2_plot(i)%p2, do_set = .true.) endif enddo matched = .true. endif ! Try a variable name if (.not. matched) then call match_word2 (cmd_line(1:ix_line), plot_var_names, ixx, match_name) if (match_name == 'QUAD_K1') then logic%plot_what = 'PLOT_QUAD_K1' elseif (match_name == 'SKEW_QUAD_K1') then logic%plot_what = 'PLOT_SKEW_QUAD_K1' elseif (match_name == 'HORIZONTAL') then logic%plot_what = 'PLOT_HSTEER_KICK' elseif (match_name == 'HBND') then logic%plot_what = 'PLOT_HBND_KICK' elseif (match_name == 'VERTICAL') then logic%plot_what = 'PLOT_VSTEER_KICK' elseif (match_name == 'SEX_K2') then logic%plot_what = 'PLOT_SEX_K2' elseif (match_name == 'STANDARD') then logic%plot_what = 'PLOT_DATA' elseif (match_name == 'RAW') then logic%plot_what = 'PLOT_RAW' elseif (match_name == 'TWISS') then call set_plot2 (graph%top1, phase_data$, u) call set_plot2 (graph%bottom1, cbar_data$, u) elseif (match_name == 'NORMALIZE_BETA') then if (u%beta%p2%plot1%normalize == '') then u%beta%p2%plot1%normalize = 'DESIGN' u%beta%p2%plot2%normalize = 'DESIGN' u%spline_beta%p2%plot1%normalize = 'DESIGN' u%spline_beta%p2%plot2%normalize = 'DESIGN' print *, 'Beta normalization is: On' else u%beta%p2%plot1%normalize = '' u%beta%p2%plot2%normalize = '' u%spline_beta%p2%plot1%normalize = '' u%spline_beta%p2%plot2%normalize = '' print *, 'Beta normalization is: Off' endif call set_normalization (graph%top1) call set_normalization (graph%top2) call set_normalization (graph%bottom1) call set_normalization (graph%bottom1) else print *, 'ERROR: I DO NOT UNDERSTAND WHAT TO PLOT: ', trim(cmd_line) print *, ' TYPE "HELP PLOT" FOR MORE INFORMATION' return endif endif if (baseline_here) then cmd_line = baseline_string call string_trim (cmd_line, cmd_line, ix_line) call baseline_cmd endif call plotdo ('X', graph, .false., u) !-------------------------------- ! project case ('PROJECT') call project_from_windows (u%window) !-------------------------------- ! q_tune model case ('Q_TUNE') if (index('DATA', cmd_line(1:ix_line)) == 1) then tune_x = u%tune%x%d(1)%meas tune_y = u%tune%y%d(1)%meas elseif (index ('DESIGN', cmd_line(1:ix_line)) == 1) then tune_x = u%tune%x%d(1)%design tune_y = u%tune%y%d(1)%design else if (cmd_line (1:1) == '@') then read (cmd_line(2:), *, iostat = ios) tune_x, tune_y tune_x = (tune_x /390.1 + int(u%tune%x%d(1)%model/twopi)) * twopi tune_y = (tune_y /390.1 + int(u%tune%y%d(1)%model/twopi)) * twopi else read (cmd_line, *, iostat = ios) tune_x, tune_y tune_x = u%tune%x%d(1)%model + tune_x * twopi / 390.1 tune_y = u%tune%y%d(1)%model + tune_y * twopi / 390.1 endif if (ios /= 0) then print *, 'ERROR: CANNOT READ TUNES' return endif endif call q_tune (tune_x, tune_y, u, and_feature) call plotdo ('X', graph, .false., u) !-------------------------------- ! rayoutput case ('RAYOUTPUT') call synrad_init (u) call ray_output (u%window, u%ring, logic%synrad_params) !-------------------------------- ! Rayplot case ('RAYPLOT') call synrad_init (u) call get_window_numbers (u%window, 'ONE', iw) if (iw(1) == 0) return call ray_plot (u%window, iw(1)) !-------------------------------- ! Read in k file, data file, etc case ('READ') data_or_ref = data_file$ call match_word2 (cmd_line, ['DATA ', 'REFERENCE'], ix, read_what) if (ix > 0) then if (read_what == 'DATA') data_or_ref = data_file$ if (read_what == 'REFERENCE') data_or_ref = ref_file$ call string_trim (cmd_line_exact(ix_line+1:), cmd_line_exact, ix) call string_trim (cmd_line(ix_line+1:), cmd_line, ix_line) endif ! Old style ix = index(cmd_line, ':') if (ix > 0 .and. ix <= ix_line) then cmd_line(ix:ix) = ' ' cmd_line_exact(ix:ix) = ' ' ix_line = ix - 1 if (is_integer(cmd_line)) then ! Trap "0" (zero) used for letter "O" error print *, 'READ WHAT?' err_flag = .true. return endif endif if (is_integer(cmd_line)) then read (cmd_line, *, iostat = ios) ix_data what_data_read = old_what_data_read if (what_data_read == '') then if (logic%opt_data == opt_orbit$) then what_data_read = 'ORBIT' elseif (logic%opt_data == opt_twiss$) then what_data_read = 'PHASE' else print *, 'READ WHAT? (ORBIT, ETC.)' err_flag = .true. return endif endif else call match_word2 (cmd_line, [ & 'MODEL ', 'MODEL_DIGESTED ', 'CSR ', & 'BIGGRP ', 'DESIGN_DIGESTED', 'MODE_MATRIX ', & 'CONDX ', 'PHASE ', 'ORBIT ', & 'ETA ', 'AC_ETA ', 'BETA ', & 'FAKE ', 'TBT '], ix, what_data_read) if (ix < 0) return ! ambiguous command call string_trim (cmd_line_exact(ix_line+1:), cmd_line_exact, ix) call string_trim (cmd_line(ix_line+1:), cmd_line, ix_line) ! Read number if necessary select case (what_data_read) case ('FAKE', 'MODEL_DIGESTED', 'DESIGN_DIGESTED') case default if (ix_line == 0) then ix_data = 0 elseif (what_data_read /= 'CSR' .or. cmd_line(1:ix_line) /= '*') then read (cmd_line, *, iostat = ios) ix_data if (ios /= 0) then print *, 'ERROR: CANNOT READ NUMBER' err_flag = .true. return endif endif end select endif ! select case (what_data_read) case ('MODE_MATRIX') call read_mode_matrix (cmd_line_exact, u) case ('MODEL') call read_model (ix_data, u, err_flag) if (graph%top1%base == plot_design$ .and. graph%top1%plot_data /= plot_model$) & call baseline_set (plot_model$, set_to$, graph%top1) if (graph%bottom1%base == plot_design$ .and. graph%bottom1%plot_data /= plot_model$) & call baseline_set (plot_model$, set_to$, graph%bottom1) case ('CSR') if (cmd_line(1:ix_line) == '*') then ix_data = 0 what_data_read = 'CESR_DB' endif call read_save_set_cu (what_data_read, ix_data, data_or_ref, u, err_flag) call setup_groups (u, make_groups$) if (logic%opt_vars == 0) logic%opt_vars = opt_quad$ return case ('BIGGRP') logic%biggrp_set = ix_data call setup_groups (u, make_groups$) return case ('CONDX') call read_save_set_cu (what_data_read, ix_data, data_or_ref, u, err_flag) if (logic%opt_vars == 0) logic%opt_vars = opt_sex$ return case ('MODEL_DIGESTED') call read_digested_bmad_file (cmd_line_exact, u%ring, version, err_flag) if (err_flag) return print *, 'Read Ring file: ', trim(cmd_line_exact) case ('DESIGN_DIGESTED') call read_digested_bmad_file (cmd_line_exact, u%ring, version, err_flag) if (err_flag) return print *, 'Read Design Lattice file: ', trim(cmd_line_exact) logic%lattice = u%ring%lattice call upcase_string(logic%lattice) call init_lattice (u, .false., reestablish_groups$) case ('ORBIT') logic%plot_what = 'PLOT_DATA' call read_orbit (data_or_ref, ix_data, u, graph, err_flag) case ('PHASE') logic%plot_what = 'PLOT_DATA' call read_phase (data_or_ref, ix_data, u, graph, err_flag, and_feature) case ('ETA') logic%plot_what = 'PLOT_DATA' call read_eta (data_or_ref, ix_data, u, graph, err_flag, and_feature) case ('AC_ETA') logic%plot_what = 'PLOT_DATA' call read_ac_eta (data_or_ref, ix_data, u, graph, err_flag, and_feature) case ('BETA') logic%plot_what = 'PLOT_DATA' call read_beta (data_or_ref, ix_data, u, graph, err_flag) case ('TBT') logic%plot_what = 'PLOT_DATA' call read_tbt (data_or_ref, ix_data, u, graph, err_flag) case ('FAKE') logic%plot_what = 'PLOT_DATA' call file_suffixer (cmd_line_exact, cmd_line_exact, '.dat', .false.) call read_fake_data (data_or_ref, cmd_line_exact, u, graph, err_flag) case default print *, 'READ WHAT?' err_flag = .true. return end select ! End stuff if (err_flag) return if (data_or_ref == data_file$) then select case (what_data_read) case ('PHASE', 'ORBIT', 'ETA', 'AC_ETA', 'BETA', 'FILE', 'TBT') !call plot_data_set (graph%top1, plot_meas$) !call plot_data_set (graph%bottom1, plot_meas$) old_what_data_read = what_data_read end select endif call ring_calc (u) call plotdo ('X', graph, .false., u) !-------------------------------- ! calibration of steerings case ('RECALIBRATE') ix_bpm = -1 who = '' if (ix_line > 0 .and. index('BPM', cmd_line(:ix_line)) == 1) then who = 'BPM' call string_trim (cmd_line(ix_line+1:), cmd_line, ix_line) if (ix_line > 0 .and. cmd_line(2:2) /= ':') then read (cmd_line, *, iostat = ios) ix_bpm if (ios /= 0) then print *, 'ERROR READING BPM INDEX.' return endif endif elseif (ix_line > 0 .and. index('QUADRUPOLE', cmd_line(:ix_line)) == 1) then who = 'QUAD' call string_trim (cmd_line(ix_line+1:), cmd_line, ix_line) endif if (cmd_line(1:1) /= '') then if (cmd_line(1:2) == 'O:') then plot_type = orbit_data$ elseif (cmd_line(1:2) == 'P:') then plot_type = phase_data$ else print *, 'ERROR: RECALIBRATE WITH WHAT TYPE OF DATA? ("ORBIT" OR "PHASE")' return endif do i = 1, 2 if (cmd_line(2:2) == ':') call string_trim(cmd_line(3:), cmd_line, ix_line) read (cmd_line, *, iostat = ios) ix if (ios /= 0) then print *, 'ERROR: CANNOT READ DATA FILE NUMBER #', i err_flag = .true. return endif call string_trim (cmd_line(ix_line+1:), cmd_line, ix_line) if (plot_type == orbit_data$) then if (i == 1) then call read_orbit (ref_file$, ix, u, graph, err_flag) else call read_orbit (data_file$, ix, u, graph, err_flag) endif if (err_flag) return else if (i == 1) then call read_phase (ref_file$, ix, u, graph, err_flag, .false.) else call read_phase (data_file$, ix, u, graph, err_flag, .false.) endif if (err_flag) return endif enddo endif ! Find which steering has changed. found_ele = .false. do i = 1, size(u%var) if (.not. u%var(i)%exists) cycle select case (u%var(i)%db_node_name) case ('CSR HORZ CUR', 'CSR VERT CUR', 'UND VERT CUR', 'CSR HBND CUR') if (abs(u%var(i)%cu_saved - u%var(i)%cu_saved_ref) < 10) cycle case ('CSR QUAD CUR', 'CSR QADD CUR', 'CSR SQEWQUAD') if (abs(u%var(i)%cu_saved - u%var(i)%cu_saved_ref) < 10) cycle case ('CSR HSP VOLT') if (abs(u%var(i)%cu_saved - u%var(i)%cu_saved_ref) < 50) cycle case default cycle end select if (found_ele) then fmt = '(i13, 3x, a, 2i10)' print *, 'ERROR: MORE THAN ONE STEERING/QUADRUPOLE HAS CHANGED:' print '(a, 21x, a)', ' Ring_Index Name', 'Cu Cu_saved' print fmt, u%var(ix_var1)%ix_ele, u%var(ix_var1)%name, & u%var(ix_var1)%cu_saved, u%var(ix_var1)%cu_saved_ref print fmt, u%var(i)%ix_ele, u%var(i)%name, & u%var(i)%cu_saved, u%var(i)%cu_saved_ref err_flag = .true. return endif found_ele = .true. ix_var1 = i enddo if (.not. found_ele) then print *, 'ERROR: CANNOT FIND A VARIABLE THAT HAS CHANGED!' err_flag = .true. return endif ! recalibrate select case (u%var(ix_var1)%db_node_name) case ('CSR QUAD CUR', 'CSR QADD CUR') if (who == 'QUADRUPOLE') then call calibrate_quad (ix_var1, 'RECAL', cu_use, u, graph, err_flag) else call calibrate_bpm (ix_bpm, ix_var1, 'RECAL', cu_use, u, graph, err_flag, 0) endif case ('CSR SQEWQUAD') call calibrate_skewquad (ix_var1, 'RECAL', cu_use, u, graph, err_flag) case ('CSR HORZ CUR', 'CSR VERT CUR', 'UND VERT CUR', 'CSR HBND CUR') call calibrate_steering (ix_var1, 'RECAL', cu_use, u, graph, err_flag) end select !-------------------------------- ! Reanalyze Phase data case ('REANALYZE_PHASE') call match_word2 (cmd_line, ['DATA ', 'REFERENCE'], ix, read_what) if (ix < 0) return ! ambiguous command if (ix == 0) then read_what = 'DATA' else call string_trim (cmd_line(ix_line+1:), cmd_line, ix_line) endif ! logic%plot_what = 'PLOT_DATA' if (read_what == 'DATA') then data_or_ref = data_file$ ! DATA file else data_or_ref = ref_file$ ! REF file endif call string_trim (cmd_line, cmd_line, ix_line) if (ix_line == 0 .or. cmd_line(1:ix_line) == '*') then ix_data = u%phase%ix_meas else read (cmd_line, *, iostat = ios) ix_data if (ios /= 0) then print *, 'ERROR: CANNOT READ NUMBER' return endif endif call read_phase (data_or_ref, ix_data, u, graph, err_flag, .true.) ! if (err_flag) return if (read_what == 'DATA') then call plot_data_set (graph%top1, plot_meas$) call plot_data_set (graph%bottom1, plot_meas$) endif call ring_calc (u) call plotdo ('X', graph, .false., u) !-------------------------------- ! REMEMBER case ('REMEMBER') if (logic%remembering) then print *, 'ERROR: I AM ALREADY RECORDING YOU COMMANDS IN A FILE.' print *, ' A NEW RECORDING FILE *NOT* OPENED.' err_flag = .true. return endif if (ix_line == 0) then logic%remember_file_name = "cesrv_cmds.in" else call file_suffixer (cmd_line_exact, logic%remember_file_name, '.in', .false.) endif logic%iu_remember = lunget() open (logic%iu_remember, file = logic%remember_file_name, iostat = ios) if (ios /= 0) then print *, 'ERROR: CANNONT OPEN FILE: ', trim(logic%remember_file_name) err_flag = .true. return endif logic%remembering = .true. do i = -99, 0 call history_recall (i, line2, tag, found) if (found) then if (tag) then ! command file was open write (logic%iu_remember, *) '! ', trim(line2) else write (logic%iu_remember, *) trim(line2) endif endif enddo print *, 'Recording Commands in: ', trim(logic%remember_file_name) !-------------------------------- ! REVERSE_TRACKING case ('REVERSE_TRACKING') logic%reverse_tracking = .not. logic%reverse_tracking !-------------------------------- ! RF toggle case ('RF') if (cmd_line(:ix_line) == 'ON') then logic%rf_on = .true. elseif (ix_line > 1 .and. index('OFF', cmd_line(:ix_line)) == 1) then logic%rf_on = .false. elseif (ix_line /= 0) then Print *, 'ERROR: RF "ON" OR "OFF"?' endif call set_on_off (rfcavity$, u%ring, on_off_int(logic%rf_on), u%orb) print *, 'RF is:', on_off(logic%rf_on) call plotdo ('X', graph, .false., u) !-------------------------------- ! RUN optimizer. ! at end transfer new quad k's to the ring lattice and calculate betas case ('RUN', 'FLATTEN') call set_data_useit_opt (u%data) logic%plot_what = 'PLOT_DATA' call plot_data_set (graph%top1, plot_meas$) call plot_data_set (graph%bottom1, plot_meas$) ! if (logic%opt_data == opt_orbit$) then ! call set_plot2 (graph%top1, orbit_data$, u) ! elseif (logic%opt_data == opt_twiss$) then ! call set_plot2 (graph%top1, phase_data$, u) ! endif call baseline_set (plot_design$, subtract$, graph%bottom1, graph%top1) call baseline_set (plot_fit$, subtract$, graph%bottom1, graph%top1) if (plot_type_has(plot_model_and_base$, logic%opt_base)) then if (graph%top1%d2%type /= graph%bottom1%d2%type) & call baseline_set (plot_model_and_base$, add$, graph%bottom1) if (graph%top2%d2%type /= graph%bottom2%d2%type) & call baseline_set (plot_model_and_base$, add$, graph%bottom2) else call baseline_set (plot_model$, add$, graph%top1) call baseline_set (plot_model$, add$, graph%top2) if (graph%top1%d2%type /= graph%bottom1%d2%type) & call baseline_set (plot_model$, add$, graph%bottom1) if (graph%top2%d2%type /= graph%bottom2%d2%type) & call baseline_set (plot_model$, add$, graph%bottom2) endif print *, 'Optimizing using: ', name$%opt_vars(logic%opt_vars) print *, 'Data to Optimize: ', name$%opt_data(logic%opt_data) call run_optimizer () call run_optimizer () call plotdo('X', graph, .false., u) call showit ('TOP10', u) call showit ('CHROM', u) dtune_meas = modulo(u%tune%x%d(1)%meas, twopi) - modulo(u%tune%y%d(1)%meas, twopi) dtune_model = modulo(u%tune%x%d(1)%model, twopi) - modulo(u%tune%y%d(1)%model, twopi) if (count(u%skew_quad_k1%v%good_opt) > 0 .and. & abs(dtune_meas - dtune_model) > 0.02 * (abs(dtune_meas) + abs(dtune_model))) then print * print *, 'WARNING: SKEW QUAD MODEL VALUES WILL BE INACCURATE DUE TO DIFFERENCES BETWEEN' print *, ' THE MEASURED AND MODEL TUNE SPLIT Qx -Qy.' endif !-------------------------------- ! SAVE case ('SAVE') call match_word2 (cmd_line, ['GOLDEN ', 'BPM_CALIBRATION', & 'CONDX ', 'CSR '], ixx, match_name) select case (match_name) case ('GOLDEN') u%var%cu_golden = u%var%cu_saved u%data%meas_golden = u%data%meas print *, 'Golden CU values saved.' case ('BPM_CALIBRATION') u%bpm_offset(u%new_bpm_offset%ix_data) = u%new_bpm_offset call write_bpm_quad_offsets (u%bpm_offset) print *, 'detcal.ok updated.' case ('CSR', 'CONDX') call save_this_set (match_name, err_flag) case default print *, 'SAVE WHAT? (CSR, CONDX, GOLDEN, or BPM_CALIBRATION)' end select !-------------------------------- ! scale data case ('SCALE') call parse_scale_clip ('SCALE', err_flag) if (err_flag) return if (logic%plot_what == 'PLOT_WAVE') then call scale_data (maxim, u%wave%p2%plot1, .false.) elseif (logic%plot_what == 'PLOT_RAW') then if (logic%last_read == phase_data$ .or. logic%last_read == ac_eta_data$) then call raw_scale (u%raw_phase_x) call raw_scale (u%raw_phase_y) else call raw_scale (u%raw_orbit) endif elseif (.not. associated(p2_plot(1)%p2)) then print *, 'WHAT TO SCALE? (TOP, BOTTOM, X, Y, ..._rp)' print *, ' TYPE "HELP SCALE" FOR MORE INFORMATION' return else do i = 1, size(p2_plot) if (.not. associated(p2_plot(i)%p2)) cycle call scale_the_data (p2_plot(i)%p2) enddo endif call plotdo ('X', graph, .false., u) return !-------------------------------- ! SET case ('SET') call set_params(cmd_line_exact, do_all_universes, u, graph, err_flag) if (err_flag) return call plotdo('X', graph, .false., u) !-------------------------------- ! SHOW case ('SHOW') if (and_feature) then call get_cesrv_command ('File name to save output in:', file_name) call showit (cmd_line, u, file_name) else call showit (cmd_line, u) endif !-------------------------------- ! SPAWN case ('SPAWN') call system_command (cmd_line_exact) return !-------------------------------- ! SPECIAL PROCEDURE case ('SPECIAL') call special_procedure (u, graph, cmd_line_exact) return !-------------------------------- ! SPECIES case ('SPECIES') if (index('ELECTRON', cmd_line(:ix_line)) == 1) then u%ring%param%particle = electron$ elseif (index('POSITRON', cmd_line(:ix_line)) == 1) then u%ring%param%particle = positron$ else print *, 'ERROR: WHAT SPECIES? (ELECTRON, POSITRON)' print *, ' TYPE "HELP SPECIES" FOR MORE INFORMATION' return endif print *, 'Species is: ', particle_name(u%ring%param%particle) doit = .true. call get_cesrv_command('Reinit dmerit matrix (used by the optimizer)?', & cmd_logic = doit) if (doit) call dmerit_calc ('reinit') call plotdo ('X', graph, .false., u) !-------------------------------- ! synrad case ('SYNRAD') call synrad_init (u) call do_synrad (u%walls, u, u%ring, logic%synrad_params, u%window) !-------------------------------- ! load model with design or saved, etc case ('TAKE') data_or_ref = data_file$ ! set default line2 = ' ' if (take_what /= 'ETA' .and.take_what /= 'AC_ETA') then ! set default based upon last meas if (logic%opt_data == opt_twiss$) then take_what = 'PHASE' elseif (logic%opt_data == opt_orbit$) then take_what = 'ORBIT' else take_what = '' endif endif do while (ix_line /= 0) call match_word (cmd_line(:ix_line), & ['DATA ', 'REFERENCE ', 'ORBIT ', 'PHASE ', 'ETA ', & 'AUTO ', 'AC_ETA ', 'TBT ', 'CHROMATICITY'], ix, matched_name = who) select case (who) case('DATA') data_or_ref = data_file$ case('REFERENCE') data_or_ref = ref_file$ case('ORBIT', 'PHASE', 'ETA', 'AC_ETA', 'TBT', 'CHROMATICITY') take_what = who case('AUTO') line2 = cmd_line(ix_line+1:) exit case default print *, 'ERROR: I DO NOT UNDERSTAND: ', cmd_line(:ix_line) print *, ' TYPE "HELP TAKE" FOR MORE HELP' return end select call string_trim (cmd_line(ix_line+1:), cmd_line, ix_line) enddo select case (take_what) case ('CHROMATICITY') call take_chrom (data_or_ref, u, err_flag) case ('ORBIT') call take_orbit (data_or_ref, u, graph, .true., err_flag, line2) case ('PHASE') if (line2 == ' ') then call take_phase (data_or_ref, u, graph, err_flag, .false.) else call take_phase (data_or_ref, u, graph, err_flag, .true., line2) endif case ('ETA') call take_eta (data_or_ref, u, graph, err_flag) case ('AC_ETA') call take_ac_eta (data_or_ref, u, graph, err_flag, .false.) case ('TBT') n_turn = -1 if (cmd_line /= '') then read (cmd_line, *, iostat = ios) n_turn if (ios /= 0) then print *, 'ERROR: CANNOT READ NUMBER OF TURNS.' n_turn = -1 endif endif if (n_turn < 1) then call get_input_string ('How many turns of data to take? <-1 -> Abort>:', cmd_line) read (cmd_line, *, iostat = ios) n_turn if (ios /= 0) then print *, 'ERROR: CANNOT READ NUMBER OF TURNS.' n_turn = -1 endif if (n_turn < 1) then err_flag = .true. return endif endif call take_tbt (n_turn, data_or_ref, u, graph, err_flag) case default print *, 'ERROR: TAKE WHAT? (ORBIT, ETC.)' return end select call plot_data_set (graph%top1, plot_meas$) call plot_data_set (graph%bottom1, plot_meas$) call plotdo ('X', graph, .false., u) !-------------------------------- ! TRANSFER case ('TRANSFER') call match_word2 (cmd_line, [ & 'DESIGN ', 'SAVED ', 'ZERO ', & 'MODEL ', 'DATA ', 'REFERENCE ', 'S-R ', & 'OLD ', 'BASE_MODEL '], i_from, from_name) if (i_from < 0) return ! ambiguous name call string_trim (cmd_line(ix_line+1:), cmd_line, ix) call match_word2 (cmd_line, name$%change, i_to, to_name) if (i_to < 0) return ! ambiguous name call string_trim (cmd_line(ix+1:), cmd_line, ix) if (ix == 0) then factor = 1.0 else read (cmd_line, *, iostat = ios) factor if (ios /= 0) then print *, 'ERROR READING SCALE FACTOR.' return endif endif call transfer (from_name, to_name, factor, u) call plotdo ('X', graph, .false., u) !-------------------------------- ! units case ('UNITS') if (ix_line /= 0) then if (index('PHASE', cmd_line(:ix_line)) == 1) then i_ptr => logic%phase_units r_ptr => logic%phase_conversion_factor elseif (index('TUNE', cmd_line(:ix_line)) == 1) then i_ptr => logic%tune_units r_ptr => logic%tune_conversion_factor else print *, 'ERROR: SET UNITS FOR PHASE OR TUNE?' err_flag = .true. return endif call string_trim(cmd_line(ix_line+1:), cmd_line, ix_line) if (ix_line /= 0) then if (index('RADIANS', cmd_line(:ix_line)) == 1) then r_ptr = 1 i_ptr = radians$ elseif (index('DEGREES', cmd_line(:ix_line)) == 1) then r_ptr = 180 / pi i_ptr = degrees$ elseif (index('CYCLES', cmd_line(:ix_line)) == 1) then r_ptr = 1 / twopi i_ptr = cycles$ elseif (index('KHZ', cmd_line(:ix_line)) == 1) then r_ptr = 390.1 / twopi i_ptr = kHz$ else print *, 'ERROR: WHAT UNITS? (Radians, Degrees, Cycles, kHz)' endif endif endif print *, 'Phase Units: ', frequency_units_name(logic%phase_units) print *, 'Tune Units: ', frequency_units_name(logic%tune_units) !-------------------------------- ! veto/restore data or variables case ('VETO', 'RESTORE', 'USE') if (index('0123456789', cmd_line(1:1)) /= 0 .and. logic%plot_what == 'PLOT_WAVE') then match_name = u%wave%wave_what else call match_word2 (cmd_line, name$%change, itype, match_name = match_name) cmd_line = cmd_line(ix_line+1:) endif select case (match_name) case ('ALL_DATA') if (cmd_name == 'USE' .or. cmd_name == 'RESTORE') then u%data(:)%good_user = .true. else u%data(:)%good_user = .false. endif call set_data_useit_opt (u%data) call showit ('', u) case ('ALL_VARS') if (cmd_name == 'USE' .or. cmd_name == 'RESTORE') then u%var(:)%good_user = .true. else u%var(:)%good_user = .false. endif call set_var_useit (u) call showit ('OPT_VARIABLES', u) case ('BETA') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%beta%x, u%beta%y) call data_type_useit (u%phase) call data_type_useit (u%cbar) case ('SPLINE_BETA') call veto_restore_data (trim(cmd_name), cmd_line, & do_all_universes, u%spline_beta%x, u%spline_beta%y) case ('PHASE') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%phase%x, u%phase%y) call data_type_useit (u%cbar) call data_type_useit (u%beta) case ('ETA') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%eta%x, u%eta%y) case ('CHROMATICITY') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%chrom%x, u%chrom%y) case ('CMAT') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%cmat_a%m12, u%cmat_a%m22) call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%cmat_b%m12, u%cmat_b%m11) case ('CMAT_A') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%cmat_a%m12, u%cmat_a%m22) case ('CMAT_B') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%cmat_b%m12, u%cmat_b%m11) case ('CBAR') call veto_restore_data (trim(cmd_name), cmd_line, & do_all_universes, u%cbar%m12, u%cbar%m11, u%cbar%m22) call data_type_useit (u%phase) call data_type_useit (u%beta) case ('ORBIT') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%orbit%x, u%orbit%y) case ('AC_ETA') if (logic%ac_eta_type == xy$)call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%ac_eta%x, u%ac_eta%y) if (logic%ac_eta_type == c12$)call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%ac_eta_c12%a, u%ac_eta_c12%b) if (logic%ac_eta_type == sincos$)call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%ac_eta_yx%yxcos, u%ac_eta_yx%yxsin) case ('MODE_ETA') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%mode_eta%x, u%mode_eta%y) case ('QUADRUPOLE') call veto_restore_var (trim(cmd_name), cmd_line, u, u%quad_k1) case ('BPM_TILT') call veto_restore_var (trim(cmd_name), cmd_line, u, u%bpm_tilt) case ('SKEW_QUAD') call veto_restore_var (trim(cmd_name), cmd_line, u, u%skew_quad_k1) case ('_SKEW_SEX') call veto_restore_var (trim(cmd_name), cmd_line, u, u%skew_sex_k2) case ('SEXTUPOLE') call veto_restore_var (trim(cmd_name), cmd_line, u, u%sex_k2) case ('CUSTOM_VAR') call veto_restore_var (trim(cmd_name), cmd_line, u, u%custom_var) case ('HORIZONTAL') call veto_restore_var (trim(cmd_name), cmd_line, u, u%hsteer_kick) case ('VERTICAL') call veto_restore_var (trim(cmd_name), cmd_line, u, u%vsteer_kick) case ('H_SEPARATOR') call veto_restore_var (trim(cmd_name), cmd_line, u, u%hsep_kick) case ('INIT_ORB') call veto_restore_var (trim(cmd_name), cmd_line, u, u%init_orb) case ('GROUP') cmd_line = 'GROUP ' // cmd_line call match_var_type (cmd_line, var1, u, err_flag) if (err_flag) return call veto_restore_var (trim(cmd_name), cmd_line, u, var1) case ('SLAVE') call veto_restore_slave (trim(cmd_name), cmd_line, u) case ('TUNE') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%tune%x, u%tune%y) case ('E_XRAY') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%e_xray%x, u%e_xray%y) case ('P_XRAY') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%p_xray%x, u%p_xray%y) case ('DE_E', 'ENERGY') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%energy_data%d1) call veto_restore_var (trim(cmd_name), cmd_line, u, u%energy_var) case ('Q_RES') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%q2x%a_in, u%q2x%a_out) call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%q2y%a_in, u%q2y%a_out) call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%qx_plus_qy%a_in, u%qx_plus_qy%a_out) call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%qx_minus_qy%a_in, u%qx_minus_qy%a_out) case ('2Q') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%q2x%a_in, u%q2x%a_out) call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%q2y%a_in, u%q2y%a_out) case ('2QX') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%q2x%a_in, u%q2x%a_out) case ('2QY') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%q2y%a_in, u%q2y%a_out) case ('QX') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%qx_plus_qy%a_in, u%qx_plus_qy%a_out) call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%qx_minus_qy%a_in, u%qx_minus_qy%a_out) case ('QX+QY') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%qx_plus_qy%a_in, u%qx_plus_qy%a_out) case ('QX-QY') call veto_restore_data (trim(cmd_name), cmd_line, do_all_universes, u%qx_minus_qy%a_in, u%qx_minus_qy%a_out) case default print *, 'ERROR: BAD NAME (MUST BE "QUAD", "PHASE", ...)' print *, ' TYPE "HELP ', trim(cmd_name), '" FOR MORE INFORMATION' return end select call plotdo ('X', graph, .false., u) !-------------------------------- ! View case ('VIEW_UNIVERSE') read (cmd_line, *, iostat = ios) ix if (ios /= 0) then print *, 'ERROR READING UNIVERSE NUMBER.' err_flag = .true. return endif if (ix < 1 .or. ix > logic%u_num) then print *, 'ERROR: UNIVERSE NUMBER OUT OF RANGE.' err_flag = .true. return endif u => super%u_(ix) logic%u_view = ix ! save some plot info temp_graph = graph ! reset the graph pointers to point to the new universe call set_plot2 (graph%top1, graph%top1%d2%type, u) call set_plot2 (graph%bottom1, graph%bottom1%d2%type, u) ! but now restore some graph stuff that was reset graph%top1%plot_data = temp_graph%top1%plot_data graph%top1%base = temp_graph%top1%base graph%top1%plot1%y_axis = temp_graph%top1%plot1%y_axis graph%top1%plot2%y_axis = temp_graph%top1%plot2%y_axis graph%top1%plot3%y_axis = temp_graph%top1%plot3%y_axis graph%bottom1%plot_data = temp_graph%bottom1%plot_data graph%bottom1%base = temp_graph%bottom1%base graph%bottom1%plot1%y_axis = temp_graph%bottom1%plot1%y_axis graph%bottom1%plot2%y_axis = temp_graph%bottom1%plot2%y_axis graph%bottom1%plot3%y_axis = temp_graph%bottom1%plot3%y_axis call plotdo ('X', graph, .false., u) !-------------------------------- ! Wallplot case ('WALLPLOT') call synrad_init (u) if (cmd_line == '') then x_min = u%ring%ele(0)%s x_max = u%ring%ele(u%ring%n_ele_track)%s else read (cmd_line, *, iostat = ios) x_min, x_max if (ios /= 0) then print *, 'CANNOT READ X_MIN AND X_MAX.' return endif endif call wall_plot (x_min, x_max, u%walls, u%ring) !-------------------------------- ! wave analysis case ('WAVE_SET') call match_word2 (cmd_line, name$%data_type_name, ix_what, match_name) if (ix_what <= 0) then print *, 'ERROR: WHAT TO WAVE ANALYZE (ORBIT, PHASE, ..._rp)?' print *, ' TYPE "HELP WAVE" FOR MORE INFORMATION' return endif call match_word2 (cmd_line(ix_line+1:), name$%plane, u%wave%plane) if (u%wave%plane <= 0 .and. ix_what /= cbar_data$) then print *, 'ERROR: WHICH PLANE TO WAVE ANALYZE (X, Y, ...)?' print *, ' TYPE "HELP WAVE" FOR MORE INFORMATION' return endif u%wave%wave_what = match_name select case (match_name) case ('CBAR') u%wave%p2%d2 => u%cbar u%wave%plane = null_plane$ case ('ORBIT') u%wave%p2%d2 => u%orbit case ('PHASE') u%wave%p2%d2 => u%phase case ('ETA') u%wave%p2%d2 => u%eta case ('AC_ETA') u%wave%p2%d2 => u%ac_eta case ('Q2X') u%wave%p2%d2 => u%q2x case ('Q2Y') u%wave%p2%d2 => u%q2y case ('QX_PLUS_QY') u%wave%p2%d2 => u%qx_plus_qy case ('QX_MINUS_QY') u%wave%p2%d2 => u%qx_minus_qy case default u%wave%wave_what = '' end select if (u%wave%p2%d2%type == graph%top1%d2%type) then this_plot => graph%top1 elseif (u%wave%p2%d2%type == graph%bottom1%d2%type) then this_plot => graph%bottom1 else this_plot => u%wave%p2%d2%p2 endif u%wave%p2%base = this_plot%base u%wave%p2%plot_data = this_plot%plot_data if (u%wave%plane == x_plane$) then u%wave%p2%plot1%y_axis = this_plot%plot1%y_axis u%wave%p2%plot1%title = this_plot%plot1%title u%wave%p2%plot1%conversion_factor = this_plot%plot1%conversion_factor u%wave%p2%plot1%normalize = this_plot%plot1%normalize u%wave%p2%plot1%d1 => this_plot%plot1%d1 else u%wave%p2%plot1%y_axis = this_plot%plot2%y_axis u%wave%p2%plot1%title = this_plot%plot2%title u%wave%p2%plot1%conversion_factor = this_plot%plot2%conversion_factor u%wave%p2%plot1%normalize = this_plot%plot2%normalize u%wave%p2%plot1%d1 => this_plot%plot2%d1 endif logic%plot_what = 'PLOT_WAVE' if (and_feature) u%wave%write_raw = .true. call plotdo ('X', graph, .false., u) !-------------------------------- ! write to file case ('WRITE') if (index('MODEL', cmd_line(:ix_line)) == 1) then call get_input_string ('Optional Comment:', comment) call write_model (0, u, comment) elseif (index('DIGESTED', cmd_line(:ix_line)) == 1) then call string_trim (cmd_line_exact(ix_line+1:), cmd_line_exact, ix) if (cmd_line_exact == ' ') cmd_line_exact = 'digested_bmad.lat' call write_digested_bmad_file (cmd_line_exact, u%ring, 0) print *, 'Digested BMAD lattice file created with name: ', trim(cmd_line_exact) elseif (index('ORBIT', cmd_line(:ix_line)) == 1) then call string_trim (cmd_line_exact(ix_line+1:), cmd_line_exact, ix) if (cmd_line_exact == ' ') cmd_line_exact = 'orbit.dat' call write_orbit (cmd_line_exact, u) elseif (index('PHASE', cmd_line(:ix_line)) == 1) then call string_trim (cmd_line_exact(ix_line+1:), cmd_line_exact, ix) if (cmd_line_exact == ' ') cmd_line_exact = 'phase.dat' call write_phase (cmd_line_exact, u) elseif (index('BMAD', cmd_line(:ix_line)) == 1) then call string_trim (cmd_line_exact(ix_line+1:), cmd_line_exact, ix) if (cmd_line_exact == ' ') cmd_line_exact = 'bmad.lat' call write_bmad_lattice_file (cmd_line_exact, u%ring) else print *, 'WRITE WHAT? (MODEL, RING).' endif print *, 'Written: ', trim(cmd_line_exact) !-------------------------------- ! X-AXIS case ('X_AXIS') call match_word2 (cmd_line, x_axis_type, itype, match_name) if (itype <= 0) then print *, 'ERROR: UNKNOWN X_AXIS TYPE' print *, ' TYPE "HELP X_AXIS" FOR MORE INFORMATION' return endif print *, 'Changing X-axis scale to: ', match_name call x_axis_set (match_name, x_axis, u) doit = .true. if (associated(graph%top1%d2)) then if (graph%top1%d2%type == cbar_data$ .and. (match_name == 'PHI' .or. match_name == 'TUNE')) doit = .false. endif if (doit) then graph%top1%x_axis = x_axis graph%top1%x_axis_type = match_name graph%top1%d2%p2%x_axis = x_axis graph%top1%d2%p2%x_axis_type = match_name endif doit = .true. if (associated(graph%bottom1%d2)) then if (graph%bottom1%d2%type == cbar_data$ .and. & (match_name == 'PHI' .or. match_name == 'TUNE')) doit = .false. endif if (doit) then graph%bottom1%x_axis = x_axis graph%bottom1%x_axis_type = match_name graph%bottom1%d2%p2%x_axis = x_axis graph%bottom1%d2%p2%x_axis_type = match_name endif call plotdo ('X', graph, .false., u) !-------------------------------- ! XBSM case ('XBSM') call xbsm_calc (u, cmd_line) !-------------------------------- ! ZERO case ('ZERO') if (index('CBAR', cmd_line(:ix_line)) == 1) then print*, "Zeroing the cbar data, vetoing the IR cbars and matching all phase data to design!" u%cbar%m11%d(:)%meas = 0.0 u%cbar%m12%d(:)%meas = 0.0 u%cbar%m22%d(:)%meas = 0.0 u%cbar%m12%d( [0,1,2,4,7,8,9,10,11,97,98,99] )%useit_opt = .false. u%cbar%m12%d( [0,1,2,4,7,8,9,10,11,97,98,99] )%useit_plot = .false. u%phase%x%d(:)%meas = u%phase%x%d(:)%design u%phase%y%d(:)%meas = u%phase%y%d(:)%design elseif (index('DCHROM', cmd_line(:ix_line)) == 1) then print *, 'Setting Data and Ref chromaticities to zero dChrom.' do i = 1, logic%u_num uu => super%u_(i) uu%chrom%x%d(1)%meas = uu%chrom%x%d(1)%model uu%chrom%y%d(1)%meas = uu%chrom%y%d(1)%model uu%chrom%x%d(1)%ref = uu%chrom%x%d(1)%design uu%chrom%y%d(1)%ref = uu%chrom%y%d(1)%design enddo else print *, 'ZERO WHAT?' err_flag = .true. return endif call plotdo ('X', graph, .false., u) !-------------------------------- ! Unrecognized command case default print *, 'INTERNAL COMMAND PARSING ERROR! PLEASE GET HUMAN EXPERT HELP' end select contains !---------------------------------------------------------------------- ! contains subroutine cbar_true_or_false (title, doit) character(*) title logical doit call string_trim(cmd_line(ix_line+1:), cmd_line, ix_line) if (ix_line == 0) then doit = .true. print *, 'Optimizing: ', title, ' is ON' elseif (index('TRUE', cmd_line(:ix_line)) == 1) then doit = .true. print *, 'Optimizing: ', title, ' is ON' elseif (index('FALSE', cmd_line(:ix_line)) == 1) then doit = .false. print *, 'Optimizing: ', title, ' is OFF' else print *, 'ERROR: TRUE OR FALSE?' return endif end subroutine !---------------------------------------------------------------------- ! contains subroutine baseline_cmd integer i ! is_matched = .true. call match_word2 (cmd_line, baseline_name, ix_what) if (ix_what < 0) return if (ix_what == 0) then call parse_which_plots (cmd_line, is_matched) call string_trim (cmd_line(ix_line+1:), cmd_line, ix_line) call match_word2 (cmd_line, baseline_name, ix_what) if (ix_what < 0) return else call string_trim (cmd_line(ix_line+1:), cmd_line, ix_line) if (ix_line /= 0) then call parse_which_plots (cmd_line, is_matched) else call pointer_to_p2_plots ('') endif endif if (ix_what <= 0 .or. .not. is_matched) then print *, 'ERROR: YOU MUST PLOT THIS BEFORE YOU SET THE BASELINE' print *, ' TYPE "HELP BASELINE" FOR MORE INFORMATION' return endif do i = 1, size(p2_plot) if (.not. associated(p2_plot(i)%p2)) cycle call set_this_baseline (p2_plot(i)%p2) enddo end subroutine !---------------------------------------------------------------------- ! contains subroutine set_this_baseline (p2_plt) type (p2_plot_struct) p2_plt ! if (p2_plt%d2%type == none_data$) return if (plot_type_has(plot_ref$, ix_what) .and. .not. p2_plt%d2%ref_measured) then print *, 'ERROR: A REFERENCE MUST BE READ IN FOR: ' // trim(p2_plt%d2%name) print *, ' BEFORE YOU CAN SWITCH TO THIS BASELINE.' print *, ' USE THE "READ" COMMAND TO READ IN A REFERENCE.' else call baseline_set (ix_what, set_to$, p2_plt, do_set = .true.) endif end subroutine !---------------------------------------------------------------------- ! contains subroutine clipit (this_plot) type (p2_plot_struct) this_plot logical l1, l3 if (this_plot%d2%type == cbar_data$) then l1 = this_plot%plot1%d1%d(1)%useit_opt l3 = this_plot%plot3%d1%d(1)%useit_opt call clip_data (maxim, this_plot, l1, .true., l3) elseif (ix_plane == x_plane$ .or. ix_plane == in_plane$) then call clip_data (maxim, this_plot, .true., .false., .false.) elseif (ix_plane == y_plane$ .or. ix_plane == out_plane$) then call clip_data (maxim, this_plot, .false., .true., .false.) else call clip_data (maxim, this_plot, .true., .true., .false.) endif end subroutine !---------------------------------------------------------------------- ! contains subroutine parse_scale_clip (who, err) character(*) who logical err, level_read, is_matched ! setup defaults err = .false. ix_plane = null_plane$ maxim_present = .false. ! True when "max" construction present minim_present = .false. ! True when "min" construction present level_read = .false. maxim = 0 is_matched = .false. ! parse line to see which plots are to be scaled or clipped do if (ix_line == 0) exit if (is_real(cmd_line, .true.)) then if (level_read) then print *, 'ERROR: TWO CONFUSED? THERE SEEM TO BE TWO NUMBERS' err = .true. return endif read (cmd_line, *, iostat = ios) maxim level_read = .true. ! get max/min elseif (cmd_line(1:4) == 'MAX ' .or. cmd_line(1:4) == 'MIN ') then do if (cmd_line(1:3) == 'MAX') then call get_max_min ('MAX', maxim, maxim_present, who, err) if (err) return elseif (cmd_line(1:3) == 'MIN') then call get_max_min ('MIN', minim, minim_present, who, err) if (err) return else if (maxim_present .or. minim_present) return exit endif enddo ! get which plots else found = .false. if (cmd_line(1:ix_line) == 'X') then ix_plane = x_plane$ found = .true. elseif (cmd_line(1:ix_line) == 'Y') then ix_plane = y_plane$ found = .true. elseif (cmd_line(1:ix_line) == 'IN' .or. cmd_line(1:ix_line) == 'A_IN') then ix_plane = in_plane$ found = .true. elseif (cmd_line(1:ix_line) == 'OUT' .or. cmd_line(1:ix_line) == 'A_OUT') then ix_plane = out_plane$ found = .true. elseif (.not. is_matched) then call parse_which_plots (cmd_line, is_matched) if (is_matched) found = .true. endif if (.not. found) then print *, 'ERROR: CANNOT MATCH "', cmd_line(1:ix_line), '" TO A DISPLAYED PLOT' print *, ' TYPE "HELP ', trim(who), '" FOR MORE INFORMATION' err = .true. return endif endif call string_trim (cmd_line(ix_line+1:), cmd_line, ix_line) enddo ! cleanup if (.not. is_matched) call pointer_to_p2_plots ('') end subroutine !--------------------------------------------------------------------------- ! contains subroutine get_max_min (name, value, flag, who, err) character(*) name, who real(rp) value logical flag, err ! cmd_line = cmd_line(4:) read (cmd_line, *, iostat = ios) value flag = .true. call string_trim(cmd_line, cmd_line, ix_line) call string_trim(cmd_line(ix_line+1:), cmd_line, ix_line) if (ios /= 0) then print * print *, 'ERROR: CANNOT READ ', name, ' NUMBER' print *, ' TYPE "HELP ', trim(who), '" FOR MORE INFORMATION' err = .true. return endif end subroutine !--------------------------------------------------------------------------- ! contains subroutine parse_which_plots (line, is_matched) integer i, ix, ix_dat(4), ix3, top_type, bottom_type, top2_type, bottom2_type logical is_matched character(*) line character(20) where_tb, data_type ! is_matched = .false. ix_dat = -10 call match_word2 (line, name$%data_type_name, ix_dat(1), data_type) if (ix_dat(1) < 0) return call match_word2 (line, top_bot, ix3, where_tb) if (ix3 < 0) return top_type = -1 if (associated(graph%top1%d2)) top_type = graph%top1%d2%type bottom_type = -1 if (associated(graph%bottom1%d2)) bottom_type = graph%bottom1%d2%type top2_type = -1 if (associated(graph%top2%d2)) top2_type = graph%top2%d2%type bottom2_type = -1 if (associated(graph%bottom2%d2)) bottom2_type = graph%bottom2%d2%type cbar_all = .false. if (ix_dat(1) == cbar_all_data$) then ix_dat(1) = cbar_data$ cbar_all = .true. endif select case (data_type) case ('QX') ix_dat(1) = qx_plus_qy_data$ ix_dat(2) = qx_minus_qy_data$ case ('2Q') ix_dat(1) = q2x_data$ ix_dat(2) = q2y_data$ case ('Q_RES') ix_dat(1) = q2x_data$ ix_dat(2) = q2y_data$ ix_dat(3) = qx_plus_qy_data$ ix_dat(4) = qx_minus_qy_data$ end select do i = 1, size(p2_plot) nullify(p2_plot(i)%p2) enddo if (ix_dat(1) > 0) then if (ix_dat(1) == wave_data$) then is_matched = .true. else ix = 0 if (any(top_type == ix_dat)) then; ix=ix+1; p2_plot(ix)%p2 => graph%top1; endif if (any(bottom_type == ix_dat)) then; ix=ix+1; p2_plot(ix)%p2 => graph%bottom1; endif if (any(top2_type == ix_dat)) then; ix=ix+1; p2_plot(ix)%p2 => graph%top2; endif if (any(bottom2_type == ix_dat)) then; ix=ix+1; p2_plot(ix)%p2 => graph%bottom2; endif if (ix > 0) is_matched = .true. endif elseif (ix3 > 0) then is_matched = .true. call pointer_to_p2_plots (where_tb) endif end subroutine !--------------------------------------------------------------------------- ! contains subroutine pointer_to_p2_plots (string) character(*) string integer i ! Init do i = 1, size(p2_plot) nullify(p2_plot(i)%p2) enddo ! Wave if (logic%plot_what == 'PLOT_WAVE') then p2_plot(1)%p2 => u%wave%p2 return endif ! select case (string) case ('ALL') p2_plot(1)%p2 => graph%top1 p2_plot(2)%p2 => graph%bottom1 case ('TOP') p2_plot(1)%p2 => graph%top1 case ('BOTTOM') p2_plot(1)%p2 => graph%bottom1 case ('2ALL') if (logic%wide_plot_window) then p2_plot(1)%p2 => graph%top2 p2_plot(2)%p2 => graph%bottom2 endif case('2TOP') if (logic%wide_plot_window) then p2_plot(1)%p2 => graph%top2 endif case ('2BOTTOM') if (logic%wide_plot_window) then p2_plot(1)%p2 => graph%bottom2 endif case ('ENTIRE', '') p2_plot(1)%p2 => graph%top1 p2_plot(2)%p2 => graph%bottom1 if (logic%wide_plot_window) then p2_plot(3)%p2 => graph%top2 p2_plot(4)%p2 => graph%bottom2 endif end select end subroutine !--------------------------------------------------------------------------- ! contains subroutine raw_scale (raw) type (raw_struct) raw integer i ! if (maxim == 0) then do i = 0, 120 maxim = max(maxim, maxval(raw%det(i)%amp)) enddo call qp_calc_axis_scale (0.0_rp, maxim, raw%y_axis) else raw%y_axis%max = maxim call qp_calc_axis_places (raw%y_axis) endif end subroutine raw_scale !--------------------------------------------------------------------------- ! contains subroutine scale_the_data (plot) type (p2_plot_struct) plot ! if (.not. associated(plot%d2)) return if (maxim_present .or. minim_present) then if (ix_plane == null_plane$ .and. plot%d2%type == cbar_data$) then call put_max_min (plot%plot1%y_axis) call put_max_min (plot%plot2%y_axis) call put_max_min (plot%plot3%y_axis) elseif (ix_plane == x_plane$ .or. ix_plane == in_plane$) then call put_max_min (plot%plot1%y_axis) elseif (ix_plane == y_plane$ .or. ix_plane == out_plane$) then call put_max_min (plot%plot2%y_axis) else call put_max_min (plot%plot1%y_axis) call put_max_min (plot%plot2%y_axis) endif return endif ! if (ix_plane == null_plane$ .and. plot%d2%type == cbar_data$) then if (cbar_all) then call scale_data (maxim, plot%plot1, .true., plot%plot2, plot%plot3) else call scale_data (maxim, plot%plot2, .true.) call plot_y_axis_min_max_transfer (plot%plot2%y_axis, plot%plot1%y_axis) call plot_y_axis_min_max_transfer (plot%plot2%y_axis, plot%plot3%y_axis) endif elseif (ix_plane == x_plane$ .or. ix_plane == in_plane$) then call scale_data (maxim, plot%plot1, .true.) elseif (ix_plane == y_plane$ .or. ix_plane == out_plane$) then call scale_data (maxim, plot%plot2, .true.) else call scale_data (maxim, plot%plot1, .true., plot%plot2) endif end subroutine !--------------------------------------------------------------------------- ! contains subroutine put_max_min (y_axis) type (qp_axis_struct) y_axis real(rp) old_min, old_max ! old_min = y_axis%min old_max = y_axis%max if (maxim_present) y_axis%max = maxim if (minim_present) y_axis%min = minim if (y_axis%min == y_axis%max) then print *, 'PUT_MAX_MIN: AXIS_MIN = AXIS_MAX!' y_axis%min = old_min y_axis%max = old_max return endif call qp_calc_axis_places (y_axis) if (y_axis%places < 0) y_axis%places = 0 end subroutine put_max_min !--------------------------------------------------------------------------- ! contains subroutine set_normalization (p2_plot) type (p2_plot_struct) p2_plot if (p2_plot%d2%type == beta_data$ .or. p2_plot%d2%type == spline_data$) then p2_plot%plot1%normalize = u%beta%p2%plot1%normalize p2_plot%plot2%normalize = u%beta%p2%plot2%normalize call scale_data(0.0_rp, p2_plot%plot1, .true., p2_plot%plot2) endif end subroutine set_normalization end subroutine