subroutine create_gnu_input(tot_max,kick_max_tot, cbo_min,kick_cbo_min) use bmad use muon_mod use parameters_bmad use quad_scrape_parameters implicit none integer lun integer ios integer nturns, nmuons integer unit integer vparam_id, vparam_cbo_turns integer seed real(rp) xmean_m, xsigma_m, ymean_m, ysigma_m, tmean, tsigma, pxmean, pxsigma, pymean, pysigma, pzmean, pzsigma real(rp) epsx, epsy, tlength, pz real(rp) angle ! real(rp) l_angle_b, l_angle_c, delta_angle real(rp) ring_theta/0./ real(rp)kick_max_tot, cbo_min, kick_cbo_min real(rp) vparam_max, delta_vparam, vparam_min real(rp) inflector_angle real(rp) time_bin_width real(rp) kick(10) !upstream steering integer tot_max character*120 line, lat_file, lat_file_name/''/,new_file/' '/, muon_file/' '/ logical err_flag, inf_end_us/.true./, inf_end_ds/.true./,enerloss/.false./, quad_plate/.true./ logical first/.true./, twiss_file/.false./ logical create_new_distribution/.false./ logical loop/.false./,gnu_input_only/.false./ logical spin_tracking_on/.false./,muon_decay_on/.false./ logical opt_incident/.false./,inj_matrix_tracking/.false./ logical start_tracking_at_inflector_exit/.false./ logical error_fields logical FiberScatter0 logical save_element_by_element_info/.true./ logical write_phase_space_file/.false./ logical make_movie logical use_lattice_twiss type (g2twiss_struct) twiss type (initial_offsets_struct) initial_offsets,initial_offsets_ref, inflector_end_target type (kicker_params_struct) kicker_params type (field_file_struct) fringe_file, inflector_file character *120 azimuthal_exp_z, azimuthal_exp_r character*16 epsdistr, tdistr, pzdistr, inf_aperture, twiss_ref, ring_twiss character*16 steering(10)/10*' '/ !name of upstream steering ! Input namelist structure ("/g-2/test/input.dat") namelist /input/ lat_file_name, nmuons, nturns, & ! GENERAL create_new_distribution, new_file, muon_file, & ! BEAM (write and/or read from file) tdistr, tlength, tsigma, & ! BEAM (longitudinal) pzdistr, pz, pzsigma, & ! BEAM (energy) epsdistr, epsx, epsy, twiss, twiss_ref, & ! BEAM (transverse) inf_aperture, inf_end_us, inf_end_ds, initial_offsets, initial_offsets_ref, enerloss, inflector_angle, inflector_field, & ! INFLECTOR inflector_end_target, & !opt_incident finds initial offsets so that on momentum muon exits inflector with these target values ring_theta, & ! ELEMENT POSITIONING kickerPlates, kickerCircuit, kickerPulseFile, kickerFieldType, & ! KICKER kicker_params, & ! KICKER kicker_tStart, & ! KICKER quad_plate, & ! QUAD SCATTERING quadPlates, quadCircuit, quadFieldType, & ! QUAD quad_params, & ! QUAD twiss_file, & loop, vparam_max, vparam_id, delta_vparam, vparam_min, vparam_cbo_turns, & gnu_input_only,spin_tracking_on, muon_decay_on, inflector_width, opt_incident, & inj_matrix_tracking, & fringe_file, inflector_file, & ! names of field maps for fringe and inflector and a few other details about the maps start_tracking_at_inflector_exit, & !track distribution from inflector exit rather than start of injection line ring_twiss, & ! ring_twiss = 'open' use input twiss as starting point for propagation around ring. ring_twiss='closed' compute closed ring seed, & make_movie, & use_lattice_twiss, & ! to compute twiss parameters through injection line, if true, start with values defined in lattice file write_phase_space_file, & ! to write a file with muon phase space at each element on first turn save_element_by_element_info, & !if true then allocate array muons_ele(:,:) which saves distribution at each element rf_quad, & !parameters of rf quads time_bin_width, & !bin for tbt moments vs time scraping_on, init_quad_focus, init_quad_steer, quad_ramp_start_time, quad_ramp_end_time, & B_radial, & !turn on quad scraping, scraping focus fraction, scraping steering fraction, start time and end time FiberScatter0, & !if true turn on scattering in harp fibers, default = false error_fields, & ! if true call field_errors to introduce errors in g-2 dipole field, default = false azimuthal_exp_z, azimuthal_exp_r, & ! fourier expansion of z and r fields steering, kick !name and strength of upstream steering ! Read the input namelist ("/g-2/files/input.dat") OPEN (UNIT=5, FILE='input.dat', STATUS='old', IOSTAT=ios) READ (5, NML=input, IOSTAT=ios) CLOSE(5) ! write(6,nml=input) lun=lunget() open(unit =lun,file=trim(directory)//'/'//'gnu_input.dat') !write(lun,'(a)')'unset border' !write(lun,'(a)')'unset xtics' !write(lun,'(a)')'unset ytics' !write(lun,'(a)')'set yrange [0:10]' write(lun,'(a8,a1,a,i10,a1)')'1.0 10. ', '"','nmuons = ',nmuons,'"' write(lun,'(a8,a1,a,i10,a1)')'1.0 9.5 ', '"','nturns = ',nturns,'"' write(lun,'(a8,a1,a,es12.4,a1)')'1.0 9. ', '"','pzsigma = ',pzsigma,'"' write(lun,'(a8,a1,a,6f6.2,a1)')'1.0 8.5 ', '"','twiss = ',twiss%betax,twiss%betay, & twiss%alphax,twiss%alphay,twiss%etax,twiss%etapx,'"' write(lun,'(a8,a1,a,6es10.2,a1)')'1.0 8.0 ', '"','initialoffsets = ',initial_offsets,'"' ! write(lun,'(a8,a1,a,a,a1)')'1.0 7.5 ', '"','inf aperture = ',inf_aperture,'"' write(lun,'(a8,a1,a,L,a1)')'1.0 7. ', '"', 'inf end us = ',inf_end_us,'"' write(lun,'(a8,a1,a,L,a1)')'1.0 6.5 ', '"', 'inf end ds = ',inf_end_ds,'"' write(lun,'(a8,a1,a,L,a1)')'1.0 6 ', '"', 'inf end energy loss = ',enerloss,'"' ! write(lun,'(a8,a1,a,i10,a1)')'1.0 5.5 ', '"','kickerPlates = ',kickerPlates,'"' ! write(lun,'(a8,a1,a,i10,a1)')'1.0 5. ', '"','kickerPlates = ',kickerPlates,'"' write(lun,'(a8,a1,a,a,a1)')'1.0 4.5 ', '"','kickerPulseFile = ',kickerPulseFile,'"' write(lun,'(a8,a1,a,i10,a1)')'1.0 4. ', '"','kickerFieldType = ',kickerFieldType,'"' write(lun,'(a8,a1,a,3es12.4,a1)')'1.0 3.5 ', '"','kicker field = ',kicker_params%kicker_field(1:3),'"' write(lun,'(a8,a1,a,L1,a1)')'1.0 3. ', '"','quad plate scatter = ',quad_plate,'"' write(lun,'(a8,a1,a,i10,a1)')'1.0 2.5 ', '"','vparam id = ',vparam_id,'"' write(lun,'(a8,a1,a,1x,i8,1x,a,es12.4,a1)')'1.0 2. ', '"','max stored = ',tot_max,' param = ',kick_max_tot,'"' write(lun,'(a8,a1,a,1x,f10.2,1x,a,es12.4,a1)')'1.0 1.5 ', '"','min cbo = ',cbo_min,' param = ',kick_cbo_min,'"' close(unit=lun) if(gnu_input_only) then print '(a)',' Write gnu input only ' stop endif end