subroutine orbmon (u, graph, err_flag) use cesrv_struct use cesrv_interface implicit none type (universe_struct), target :: u type (graph_struct) graph integer data_or_ref, orbit_num, ipol, ix_train integer raw(4, 120) integer orb_ctl(9), old_two_beam, old_ref, old_synrad integer species, condx_count integer tot_cur, i integer bunch, mamp(183) real(rp) current character(72) lines(5) character(80) setup_str, two_beam_veto, cmd_line character(20) date, all logical err_flag, get_comment, ok, init two_beam_veto = '29 30 34 35 36 39 40 44 45 76 77 81 82 86 87 91 92 93' all = 'all' init = .true. ! Get orbmon commands call vxgetn ('ORBMON CNTRL', 1, 9, orb_ctl) bunch = orb_ctl(9) old_ref = orb_ctl(2) old_two_beam = -999 ! force init logic%nonlinear_calc = .false. logic%opt_data = opt_orbit$ condx_count = 0 ! if run control is RUN (2) or PAUSE (1) then loop do while (orb_ctl(1) > 0) ! if RUN and enabled if ((orb_ctl(1) > 1) .and. (orb_ctl(3) == 1)) then if (bunch == 0) then ! find appropriate bunch species = 1 else call check_bunch_species (species, bunch) end if ! species = 1 ! for debugging ! if e+ OR e- in selected bunch, take orbit if (species == 1 .or. species == 2) then if (bunch == 0) then ! find appropriate bunch call vxgetn('CSR POS MAMP', 1, 183, mamp) do i=1,183 if (mamp(i)>200 .and. mamp(i)<1200) then bunch = i exit end if end do if (bunch == 0) then ! If still no bunch is valid ! try again next iteration ! Check for new commands call vmgetn ('ORBMON CNTRL', 1, 9, orb_ctl) bunch = orb_ctl(9) if (orb_ctl(2) /= old_ref) then old_ref = orb_ctl(2) init = .true. end if cycle end if end if call date_and_time_stamp(date, .true.) call vxgetn('CSR CURRENTS', 6, 6, tot_cur) current = tot_cur/1000. setup_str = ' ' 888 format(a,' ','T1B',i0) if (species >= 1) then write (lines(1), '(a,a,i0,a,f6.2)') date, 't1b',bunch,': e+, cern=', current write (setup_str, 888) 'POS', bunch ! setup_str = 'POS T1B1 ' else write (lines(1), '(a,a,i0,a,f6.2)') date, 't1b',bunch,': e-, cern=', current write (setup_str, 888) 'ELE', bunch ! setup_str = 'ELE T1B1 ' end if lines(2) = '' lines(3) = '' lines(4) = '' lines(5) = '' call vstput ('CSR COMMENTS', 1, 5, lines) call bear_str (raw, setup_str) ! get orbit call butout (raw, orbit_num) ! write orbit print *,' BUTNS.', orbit_num, ' Written' call read_orbit (data_file$, 0, u, graph, err_flag) call plot_data_set (graph%top1, plot_meas$) call plot_data_set (graph%bottom1, plot_meas$) ! if synrad modeling should be done ! if (orb_ctl(9) /= old_synrad) then ! old_synrad = orb_ctl(9) ! if (orb_ctl(9) == 1) then ! ! Turn off limits ! logic%limit_on = .false. ! ! Set seps to saved values ! call pretzel_set (pretzel_saved$, 1.0_rp, u) ! ! Use all hseps and steerings ! call veto_restore_var (all, all, u, u%hsteer_kick) ! call veto_restore_var (all, all, u, u%vsteer_kick) ! call veto_restore_var (all, all, u, u%hsep_kick) ! ! ! Set steering weight to .001% ! cmd_line = 'SET STEERING_WGT *= 0.001' ! call set_params (cmd_line, .false., u, graph, err_flag) ! ! call set_data_useit_opt (u%data) ! end if ! end if ! if (orb_ctl(9) == 1) then ! ! ! Run the optimizer ! call run_optimizer () ! ! ! Recalculate the dmerit matrix ! call dmerit_calc ('reinit') ! call run_optimizer () ! ! call synrad_init (u) ! call do_synrad (u%walls, u, u%ring, logic%synrad_params, & ! u%window, .true.) ! ! end if if (init .or. (old_ref < 0)) then call scale_data (1.0_rp, graph%top1%plot1, .true., graph%top1%plot2) call scale_data (0.3_rp, graph%bottom1%plot1, .true., & graph%bottom1%plot2) call read_orbit (ref_file$, old_ref, u, graph, err_flag) init = .false. end if call plotdo ('X', graph, .false., u) if (condx_count >= orb_ctl(5)) then ! trigger a condx set to be saved call vmputn ("CONDX SETNUM", 2, 2, 1) condx_count = 0 else condx_count = condx_count + 1 end if ! Write info to data node ! orbit data number call vmputn ("ORBMON DATA ", 1, 1, u%orbit%ix_meas) ! orbit ref number call vmputn ("ORBMON DATA ", 2, 2, u%orbit%ix_ref) ! x rms call vmputn ("ORBMON DATA ", 3, 3, nint(1e3*u%orbit%p2%plot1%y_rms)) ! y rms call vmputn ("ORBMON DATA ", 4, 4, nint(1e3*u%orbit%p2%plot2%y_rms)) end if call csr_sleep (orb_ctl(4)*1000) else ! if disabled or paused call csr_sleep (15000) end if ! Check for new commands call vmgetn ('ORBMON CNTRL', 1, 9, orb_ctl) bunch = orb_ctl(9) if (orb_ctl(2) /= old_ref) then old_ref = orb_ctl(2) init = .true. end if ! Veto detectors where species overlap with two beams if (orb_ctl(8) /= old_two_beam) then old_two_beam = orb_ctl(8) if (orb_ctl(8) == 1) then call veto_restore_data ( 'VETO', & two_beam_veto, & .false., u%orbit%x, u%orbit%y) else call veto_restore_data ( 'USE', & all, & .false., u%orbit%x, u%orbit%y) end if call plotdo ('X', graph, .false., u) end if end do ! if out of the loop, orbmon was commanded to stop print *, "Ending orbit monitoring" call mpm_goodbye stop end subroutine orbmon