program sim_ac_eta_test use bmad use random_mod use bsim_cesr_interface 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 sim_ac_and_cbar_mod implicit none type (lat_struct) ring type (coord_struct), allocatable :: orb(:) type (det_struct), allocatable :: bpm(:), bpm_save(:,:) character(40) :: bpm_mask = "^DET\_[0-9]{2}[ewEW]$" ! default to using CESR naming convention logical err, everything_ok integer ios, version, arg_num, iargc, readstatus integer :: lun_list(20) ! for file handling integer i, j, ix, jx, kx, bpm_index integer :: n_bpms = 0 real(rp) :: init_vec(6) ! for starting oscillations character(100) lat_file, file_name integer :: seed = 0. integer :: n_turns = 1024 integer :: n_damping = 0 ! # of damping turns ! variables for bpm errors real(rp) :: bpm_noise = 0, current=1000000 real(rp) harvest type (det_error_struct) bpm_error_sigmas ! parameters for tune tracker logical tunetracker_on TYPE(tt_param_struct) :: tt_params(max_tt) !max_tt=3 set on tune_tracker module CHARACTER(200) vco_out_file INTEGER n_TTs ! number of tune trackers INTEGER n_ele_track INTEGER id(max_tt) REAL(rp) Tring ! period of ring REAL(rp) aFracTune, bFracTune, zFracTune CHARACTER(1) i_str real(rp), allocatable :: tt_tunes(:,:) real(rp) :: target_tunes(3) = 0. ! target tunes for qtuning real(rp), allocatable :: dk1(:) ! for qtuning ! parameters for ac_eta calculation type (cesr_freq_struct), target :: freq type (cesr_det_plane_struct) :: long(0:n_det_maxx) type (cesr_all_data_struct) ac_eta real(rp) :: rms_eta_x = 0, rms_eta_y = 0. real(rp) ,allocatable :: phiz(:), Az(:) logical :: use_new_method=.true. ! intelligent bookkeeping (default to old): logical :: auto_bookkeeper = .true. ! parameters for xy to button values type (cesr_det_dc_position_struct) dc(0:n_det_maxx) namelist /parameters/ lat_file, bpm_noise, bpm_error_sigmas,init_vec, & current, n_damping, n_turns, n_TTs, tt_params,use_new_method, & target_tunes, bpm_mask, seed, auto_bookkeeper !====================== ! Open files arg_num=iargc() if(arg_num==0) then file_name='sim_ac_eta.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 print * print *, '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 bmad_com%auto_bookkeeper = auto_bookkeeper call ran_seed_put(seed) ! 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 ! turn off all kicks / separators ?? ! ring%ele(:)%value(hkick$) = 0 ! ring%ele(:)%value(vkick$) = 0 ! turn on damping if tunetracker is on call set_on_off(rfcavity$, ring, on$) bmad_com%radiation_damping_on = .true. bmad_com%radiation_fluctuations_on = .false. call twiss3_at_start(ring,err) ! the beta, eta, etc twiss parameters in mode3%a,b,c eta in mode%x,y call twiss3_propagate_all(ring) call twiss_at_start(ring) call twiss_propagate_all(ring) ! q_tune to user-specified tunes: global_com%exit_on_error = .false. if (any(target_tunes .gt. 1.e-12)) then everything_ok = set_tune3(ring, target_tunes) call twiss3_at_start(ring,err) ! the beta, eta, etc twiss parameters in mode3%a,b,c eta in mode%x,y call twiss3_propagate_all(ring) call twiss_at_start(ring) call twiss_propagate_all(ring) endif n_ele_track = ring%n_ele_track if (.not. allocated(orb)) allocate(orb(0:n_ele_track)) call closed_orbit_calc(ring, orb, 6) if (.not. any(init_vec(:) > 1.e-12)) then ! floating point comparison; assume < 1.e-12 is negligible init_vec(:) = orb(0)%vec(:) endif ! Locate BPMs we wish to study: call find_bpms(ring, bpm_mask, bpm) n_bpms = ubound(bpm,1) allocate(bpm_save(n_turns, n_bpms)) allocate(tt_tunes(n_turns, n_TTs)) allocate(phiz(n_bpms),Az(n_bpms)) ! initialize the nonlin_bpm call nonlin_bpm_init !load the quads-center calibration data (detcal.dat) ! call nonlin_bpm_init2 !don't load the quads-center calibration data (detcal.dat) ! 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 ! Generate BPM errors ============================================= lun_list(1) = lunget() open(unit=lun_list(1), file='bpms.ma', status='replace') write(lun_list(1), '(a7,12a14)') "!index", "x-offset", "y-offset", "tilt", "g1", "g2", "g3", "g4","shear_x","time(4)" write(lun_list(1), '(a7, 7a14)') "" do i=1,n_bpms call bpm_errors(bpm(i),bpm_error_sigmas, ring%ele(bpm(i)%ix_quad)) write(lun_list(1), '(i7,12e14.4)') bpm(i)%ix_db, bpm(i)%x_offset,bpm(i)%y_offset, & bpm(i)%tilt, bpm(i)%gain(:),bpm(i)%shear_x,bpm(i)%timing(:) enddo close(unit=lun_list(1)) ! Check if the element for each tune tracker's kicker has kick attributes. call check_tt_kickers(ring,tt_params,n_TTs) call tt_init(ring, orb, tt_params, n_TTs, id) !calculate ring period and tunes Tring = ring%ele(n_ele_track)%s / c_light aFracTune = MOD(ring%ele(n_ele_track)%mode3%a%phi,2.0_rp*pi)/2.0_rp / pi bFracTune = MOD(ring%ele(n_ele_track)%mode3%b%phi,2.0_rp*pi)/2.0_rp / pi zFracTune = MOD(ring%ele(n_ele_track)%mode3%c%phi,2.0_rp*pi)/2.0_rp / pi WRITE(*,'(A50,2F10.7)') "Calculated (twiss_and_track) Fractional Tune (a): ", aFracTune WRITE(*,'(A50,2F10.7)') "Calculated (twiss_and_track) Fractional Tune (b): ", bFracTune WRITE(*,'(A50,F10.7)') "Calculated (twiss_and_track) Fractional Tune (z): ", zFracTune !initialize each tune tracker do ix=1, n_TTs call reset_dTT(id(ix), tt_params(ix)) enddo ! simulate and calcualte ac_eta call sim_ac_eta_data(ring, bpm, n_turns, n_TTs, tt_params, id, n_damping, init_vec, use_new_method, ac_eta) ! close open files and close the tune trackers DO i=1,n_TTs CALL dest_dTT(id(i),orb(n_ele_track)) ENDDO ! save ac_eta lun_list(2) = lunget() open(unit=lun_list(2), file='ac_eta.out',status='replace') write(lun_list(2),'(a7,8a18)')"bpm_ix","eta_x_meas","etap_x_meas","eta_y_meas","etap_y_meas",& "eta_x_calc","etap_x_calc","eta_y_calc","etap_y_calc" do i=1,n_bpms write(lun_list(2),'(i7,8es18.4)') bpm(i)%ix_db, ac_eta%ac_eta_x(i)%value, ac_eta%ac_etap_x(i)%value, & ac_eta%ac_eta_y(i)%value, ac_eta%ac_etap_y(i)%value, & ring%ele(bpm(i)%ix_lat)%mode3%x%eta, ring%ele(bpm(i)%ix_lat)%mode3%x%etap,& ring%ele(bpm(i)%ix_lat)%mode3%y%eta, ring%ele(bpm(i)%ix_lat)%mode3%y%etap enddo close(lun_list(2)) rms_eta_x=0.0_rp rms_eta_y=0.0_rp do i=1, n_bpms ! if((i == 49) .or. (i==50)) cycle !veto 49 and 50 rms_eta_x=rms_eta_x+(ac_eta%ac_eta_x(i)%value-ring%ele(bpm(i)%ix_lat)%mode3%x%eta)**2 rms_eta_y=rms_eta_y+(ac_eta%ac_eta_y(i)%value-ring%ele(bpm(i)%ix_lat)%mode3%y%eta)**2 enddo rms_eta_x=sqrt(rms_eta_x/(n_bpms)) rms_eta_y=sqrt(rms_eta_y/(n_bpms)) write(*,'(a19,es10.3,a23,es10.3)') "RMS delta(eta_x) = ", rms_eta_x, " RMS delta(eta_y) = ", rms_eta_y end program sim_ac_eta_test