! read all input files in subdirectories and summarize program compile_resext_input use bmad use beam_mod use multibunch_mod use multibunch_interface use bmadz_other_code_interface use ramp_parameters implicit none integer i, j, k integer lun, lun2 integer nturns integer ios integer n_fft/256/ integer nparticles integer n_clear, n_lost, n_hit integer n_extract_tot(0:2)/3*0/, n_lost_tot(0:2)/3*0/, n_sep_tot(0:2)/3*0/ integer ix_inj, ix_essep, ix_l3, ie_from, ix_magsept1(0:1), ix_magsept2(0:1)/0,0/, ix_extraction_fork integer ix integer iturn, n_alive integer turn, iwords real(rp) e_init, omega, rf_phase_twopi real(rp) initial_offset(6) real(rp) Q(3), phase(3) real(rp) qvert,qhorz, ext_time real(rp) emit_x, emit_y,sig_z, sig_e real(rp) width/0.0002/ real(rp) bump_amp/1./ real(rp) hkick(1000) real(rp) vec(12), ave_time, sigma_t character*299 new_string character*340 string character*19 dir character*29 dir_file character*16 word(30) logical err logical ramp_synch, phase_space/.false./ logical sext/.false./ logical aperture_limit_on/.false./ logical scale_emit/.false./ logical itexists namelist/input/e_init, & !starting energy ramp_synch, & ! ramp t0, & ! start time nturns, & ! number of turns rf_phase_twopi, & ! RF phase initial_offset, & ! coord vec n_fft, & ! number of turns in each fft nparticles, & ! number of particles qvert,qhorz, & ! strength of detuning vertical and horizontal quads sextk2, & ! strength of sextupole octk3, & ! strength of octupole ext_time, & ! extraction start time, when pulse bump is on full turn_on_time, & ! time for detuning quads to get to full strength as fractin of ext_time emit_x, emit_y, sig_z, sig_e, & ! initial beam parameters ext_param, & ! multiplier of extraction sextupole or octupole x_septum, t_septum, & !extraction septum - center line to far edge of septum (0:2), septum thickness (0:2) x_wall, & !center line to wall(0:2) of vacuum chamber, thickness t1, & ! time to stop increase in octupole oct_ramp, quad_ramp, bump_ramp,sext_ramp, & ! oct_ramp(0:7000), octupole function, quad_ramp(0:7000) quad function, bump_ramp(0:7000) bump ramp * 60 hz phase_space, & ! if true write phase space for each particle each turn hbump, bump_bend, & ! hbump(1:3) in radians and the names of the 3 bump bends aperture_limit_on, & ! set true to turn on aperture limits scale_emit, & !scale emittance computed in init_beam_distribution to injection energy bump_amp ! amplitude of pulse bump bmad_com%auto_bookkeeper = .false. oct_ramp = -1. quad_ramp = -1. bump_ramp = -1. sext_ramp = -1. !default septum parameters x_septum(0) = -0.031 !displacement of thin septum 0 from center of chamber x_septum(1) = -0.03 !displacement of septum 1 from center of chamber x_septum(2) = 0.03 !displacement of septum 2 from center of chamber x_wall(0) = -0.045 !distance from center of chamber to outer wall of thin septum (septum 0) x_wall(1) = -0.045 !distance from center of chamber to outer wall of septum 1 x_wall(2) = 1. !distance from center of chamber to outer wall of septum 1 t_septum(0) = 0.0001 !thickness of septum 1 t_septum(1)=0.006 !thickness of septum 1 t_septum(2)=0.006 !thickness of septum 1 string='ls > out.dat' call execute_command_line(string) lun=lunget() open(unit=lun,file='out.dat') lun2=lunget() open(unit=lun2, file='compilation.dat') write(lun2,'(a15,15a12)')'sub_dir','e_init','ramp','nturns','nparticles','qvert','qhorz','sextk2','t_sep(0)','t_sep(1)','t_sep(2)','bump_amp', 'iturn', 'n_ext_tot(0)','n_ext_tot(1)', 'n_ext_tot(2)' do while(.true.) read(lun,'(a)', end=99) new_string if(index(new_string,'2017')==0)cycle dir=trim(new_string) dir_file = trim(dir)//'/input.in' print '(a)', dir_file inquire (file=dir_file, exist=itexists) if (.not.itexists) cycle open(unit=5, file=dir_file, STATUS ='old') read(5, nml=input, IOSTAT=ios) close(unit=5) open(unit=5, file=trim(dir)//'/beam_trajectory.dat') do while(.true.) read(5,'(a)', IOSTAT=ios)string if(ios < 0) exit if(index(string,'turn')/=0)cycle ! read(string,*)iturn,vec(1:12),n_alive, ave_time, sigma_t, n_extract_tot(0), n_lost_tot(0), n_sep_tot(0), n_extract_tot(1), n_lost_tot(1), n_sep_tot(1), n_extract_tot(2), n_lost_tot(2), n_sep_tot(2) i=0 ix = 0 ! print '(a)',string(1:340) do while (ix /= 0 .or. i == 0) call string_trim(string(ix+1:), string, ix) i=i+1 if(ix == 0)exit word(i) = string(1:ix) ! print *,i,ix,word(i),string(1:ix) iwords = i end do ! print '(13a)',word(1), word(12), word(13), word(14), (word(j),j=17,iwords) !ave_time, sigma_t, n_extract_tot(0), n_lost_tot(0), n_sep_tot(0), n_extract_tot(1), n_lost_tot(1), n_sep_tot(1), n_extract_tot(2), n_lost_tot(2), n_sep_tot(2) read(word(1),*)iturn read(word(12),*)ave_time read(word(13),*)sigma_t read(word(14),*)n_alive read(word(17),*)n_extract_tot(0) read(word(18),*)n_lost_tot(0) read(word(19),*)n_sep_tot(0) read(word(20),*)n_extract_tot(1) read(word(21),*)n_lost_tot(1) read(word(22),*)n_sep_tot(1) read(word(23),*)n_extract_tot(2) read(word(24),*)n_lost_tot(2) read(word(25),*)n_sep_tot(2) end do ! if(iturn == 0)print *,' Problem here. iturn = nturn not found' write(lun2,'(a15,1x,es11.4,1x,l11,1x,i11,1x,i11,1x,7es12.4,1x,i11,3(1x,i11))')dir,e_init,ramp_synch,nturns, nparticles,qvert,qhorz,sextk2,t_septum(0),t_septum(1),t_septum(2),bump_amp, iturn, n_extract_tot(0),n_extract_tot(1), n_extract_tot(2) end do 99 continue end