! 2009.09.23 - j. shanks ! program to simulate turn-by-turn orbit data program sim_tbt use bmad use random_mod use dr_misalign_mod use radiation_mod use cesr_basic_mod use sim_utils use nonlin_bpm_mod use sim_bpm_mod use mode3_mod use tune_tracker_mod use tt_tools_mod use ele_noise_mod implicit none type (lat_struct), target :: ring type (ele_struct), pointer :: ele type (coord_struct), allocatable :: orb(:) type(ele_noise_struct) :: ele_noise(n_ele_noise_max) ! may need to change the bounds on this logical err, ok integer i, j, ix, jx, kx, dummy real(rp) harvest integer :: ran_seed = 0. real(rp) :: current = 1000000, skq02w_kick = 0.! amount of horizontal shearing on bpm's, in meters integer :: n_bpms = 0 character(40) :: bpm_mask = "^DET\_[0-9]{2}[ewEW]$" ! default to using CESR naming convention ! For TBT tracking: real(rp) :: init_vec(6)=0. ! for starting oscillations for phase 'measurement' logical :: track6x6 = .false., damping = .false. integer :: n_turns = 1024, n_damping = 0 !if 6x6 tracking, n_damping = # of damping times to wait before taking measurement integer :: single_bpm = -1 ! if in 1:99, will output only data for that BPM, greatly reducing output volume. ! parameters for misalignment; to be read in and loaded into bpm_error_sigmas and ma_params structures type(det_error_struct) :: bpm_error_sigmas type(det_struct), allocatable :: bpm(:) type(det_data_struct), allocatable :: bpm_save(:,:) type(ma_struct) ma_params(20) logical :: misalign_magnets = .false. real(rp) :: bpm_noise = 0. ! parameters for tune tracker logical tunetracker_on, everything_ok TYPE(tt_param_struct) :: tt_params(max_tt) !max_tt=3 set on tune_tracker module INTEGER :: n_TTs = 0 ! number of tune trackers INTEGER id(max_tt) real(rp) :: target_tunes(3) = 0. ! target tunes for qtuning real(rp), allocatable :: dk1(:) ! for qtuning ! File handling: integer ios, version, arg_num, iargc, readstatus integer :: lun_list(20) character(20) :: output_format='separate_files' ! alternative is 'one_file' character(100) lat_file, file_name, lat_file_name, path, output_file_name, rms_file_name character(50) orbit_file namelist /parameters/ lat_file, bpm_error_sigmas, bpm_noise, track6x6, n_damping, & current, n_turns, init_vec, output_format, single_bpm, & n_TTs, tt_params, misalign_magnets, ma_params, target_tunes, bpm_mask, ran_seed, & ele_noise arg_num=iargc() if(arg_num==0) then file_name='sim_tbt.in' else call getarg(1, file_name) end if call string_trim (file_name, file_name, ix) open (unit= 1, file = file_name, status = 'old', iostat = ios) if(ios.ne.0)then write(*,*) write(*,*) 'ERROR: CANNOT OPEN FILE: ', trim(file_name) endif ! read in the parameters rewind(1) read(1, nml = parameters,iostat=readstatus) if(readstatus > 0) then print *,"CAN NOT READ FROM ",file_name stop end if global_com%exit_on_error = .false. ! init lattice if(lat_file(1:8) == 'digested')then call read_digested_bmad_file (lat_file, ring, version) else call fullfilename(lat_file,lat_file) call bmad_parser (lat_file, ring) endif dummy = splitfilename(lat_file,path,lat_file_name) lat_file_name = lat_file_name(1:len_trim(lat_file_name)-4) if (track6x6 .eqv. .true.) then call set_on_off(rfcavity$, ring, on$) bmad_com%radiation_damping_on = .true. bmad_com%radiation_fluctuations_on = .true. !bmad_com%radiation_damping_on = .false. ! hack !bmad_com%radiation_fluctuations_on = .false. else call set_on_off(rfcavity$, ring, off$) bmad_com%radiation_damping_on = .false. bmad_com%radiation_fluctuations_on = .false. endif ! q_tune to user-specified tunes: if (any(target_tunes .gt. 1.e-12)) ok = set_tune3(ring, target_tunes) call twiss_and_track(ring, orb) ! automatically decides between 4D vs 6D, depending on RF ! offset onto the closed orbit: init_vec(:) = init_vec + orb(0)%vec(:) ! Locate BPMs we wish to study: call find_bpms(ring, bpm_mask, bpm) n_bpms = ubound(bpm,1) ! Find resolution in terms of button signal error: call resolution_to_button_error(bpm(1), current, bpm_noise) bpm(:)%butn_res_sigma = bpm(1)%butn_res_sigma if (n_TTs .gt. 0) then call twiss3_at_start(ring, everything_ok) call twiss3_propagate_all(ring) ! Check if the element for each tune tracker's kicker has kick attributes. call check_tt_kickers(ring,tt_params,n_TTs) ! initialize each tune tracker call tt_init(ring, orb, tt_params, n_TTs, id) endif !=== Generate BPM errors ============================================= ! Note that putting values here have no effect on tracking. They're ! only for storage !=== Tracking ========================================================= ! initialize ele_noise modulation: !call init_ele_noise(ring, ele_noise) call sim_tbt_data(ring, bpm, n_turns, track6x6, n_TTs, tt_params, id, n_damping, init_vec, bpm_save, ele_noise=ele_noise) !=== Write-out ======================================================== if (output_format == 'separate_files') then do ix=1,n_bpms if ((bpm(ix)%ix_db == single_bpm) .or. (single_bpm == -1)) then write(*,*) 'Writing out data for detector: ', trim(ring%ele(bpm(ix)%ix_lat)%name) !write(output_file_name, '(a4,i2.2,a4)') 'bpm_', bpm(ix)%ix_db, '.dat' write(output_file_name, '(a,a4)') trim(ring%ele(bpm(ix)%ix_lat)%name), '.dat' lun_list(6) = lunget() open(unit=lun_list(6), file=output_file_name, status='replace') write(lun_list(6),'(a7,10a18)') '!turn', 'b1', 'b2', 'b3', 'b4', 'x', 'px', 'y', 'py', 'z', 'delta' do jx=1,n_turns write(lun_list(6),'(i7,10es18.4)') jx, bpm_save(jx,ix)%amp(1:4), & bpm_save(jx,ix)%vec(1:6) enddo close(lun_list(6)) endif enddo elseif (output_format == 'one_file') then lun_list(6) = lunget() open(unit=lun_list(6), file='bpm_all.dat', status='replace') write(lun_list(6),'(7a18)') '# b3', 'b1', 'b2', 'b4', 'x (m)', 'y (m)', 'I' do ix=1,n_bpms if (ix < 50) then write(lun_list(6),'(a,i2,a1)') '# Location: ', bpm(ix)%ix_db, 'W' else write(lun_list(6), '(a,i2,a1)') '# Location: ', 99-bpm(ix)%ix_db, 'E' endif do jx=1,n_turns write(lun_list(6),'(7es18.4)') bpm_save(jx,ix)%amp(3),bpm_save(jx,ix)%amp(1),bpm_save(jx,ix)%amp(2),& bpm_save(jx,ix)%amp(4), bpm_save(jx,ix)%vec(1), bpm_save(jx,ix)%vec(3) enddo enddo close(lun_list(6)) endif end program sim_tbt