module bmadz_utils ! use bmad use cesr_basic_mod use bmadz_mod use bmadz_interface use bunchcross_mod use zquad_lens_mod use twiss_max_mod use pretz_mod use constraints_mod use nonlin_mod contains subroutine init_ele_init (con, lat, co) implicit none type (lat_struct) lat type (coord_struct), allocatable :: co(:) type (constraint_struct) con real(rp) value, det integer i integer variable, plane ! initialize twiss parameters, coupling, orbit ! special init element with starting twiss parameters if lat is unstable lat%ele_init = lat%ele(0) lat%ele_init%a%beta = con%beta_x_init lat%ele_init%b%beta = con%beta_y_init lat%ele_init%a%alpha = 0.0 lat%ele_init%b%alpha = 0.0 lat%ele_init%a%eta = con%eta_x_init lat%ele_init%b%eta = 0.0 lat%ele_init%a%etap = 0.0 lat%ele_init%b%etap = 0.0 lat%ele_init%c_mat(1,1) = 0.0 lat%ele_init%c_mat(1,2) = 0.0 lat%ele_init%c_mat(2,1) = 0.0 lat%ele_init%c_mat(2,2) = 0.0 co(lat%n_ele_max)%vec(1) = 0.0 co(lat%n_ele_max)%vec(3) = 0.0 co(lat%n_ele_max)%vec(2) = 0.0 co(lat%n_ele_max)%vec(4) = 0.0 do i = 1, con%n_constraint if (con%c(i)%where1 == 'IP_L0' .and. con%c(i)%constraint == target$) then variable = con%c(i)%variable plane = con%c(i)%plane value = con%c(i)%target_value if (variable == beta$) then if (plane == x_plane$ .and. value /= 0) lat%ele_init%a%beta = value if (plane == y_plane$ .and. value /= 0) lat%ele_init%b%beta = value elseif (variable == alpha$) then if (plane == x_plane$) lat%ele_init%a%alpha = value if (plane == y_plane$) lat%ele_init%b%alpha = value elseif (variable == eta$) then if (plane == x_plane$) lat%ele_init%a%eta = value if (plane == x_plane$) lat%ele_init%x%eta = value if (plane == y_plane$) lat%ele_init%b%eta = value elseif (variable == etap$) then if (plane == x_plane$) lat%ele_init%a%etap = value if (plane == x_plane$) lat%ele_init%x%etap = value if (plane == y_plane$) lat%ele_init%b%etap = value elseif (variable == c11$) then lat%ele_init%c_mat(1,1) = value elseif (variable == c12$) then lat%ele_init%c_mat(1,2) = value elseif (variable == c21$) then lat%ele_init%c_mat(2,1) = value elseif (variable == c22$) then lat%ele_init%c_mat(2,2) = value elseif (variable == displacement_$) then if (plane == x_plane$)co(lat%n_ele_max)%vec(1) = value if (plane == y_plane$)co(lat%n_ele_max)%vec(3) = value elseif (variable == co_angle$) then if (plane == x_plane$)co(lat%n_ele_max)%vec(2) = value if (plane == y_plane$)co(lat%n_ele_max)%vec(4) = value endif lat%ele(0) = lat%ele_init endif enddo det = determinant (lat%ele_init%c_mat) lat%ele_init%gamma_c = sqrt(1 - det) return end subroutine init_ele_init !........................................................................ ! ! Subroutine : PLOTDO_bmadz (PLOT_TYPE, HARDCOPY_FLAG, lat, co, pc) ! ! Description: Subroutine to stuff the appropriate data in arrays for ! PLOT_GRAPH to read ! Plot horizontal and vertical root beta and horizontal eta. And plot vertical and horizontal closed orbits if either are nonzero !........................................................................ subroutine plotdo_bmadz (plot_type, lat, co, pc, nonlin) implicit none character(*) plot_type type (lat_struct) lat type (coord_struct), allocatable :: co(:) type (pc_struct) pc type (nonlin_ele_struct), optional, volatile :: nonlin integer n_ele, q_label integer i, j, k, quad_number ! should come back and optimize these as well real x(lat%n_ele_max),y(lat%n_ele_max),rbetax(lat%n_ele_max) real x_e(lat%n_ele_max),y_e(lat%n_ele_max),rbetax_e(lat%n_ele_max) real rbetay(lat%n_ele_max),etax(lat%n_ele_max),s(0:lat%n_ele_max) real rbetay_e(lat%n_ele_max),etax_e(lat%n_ele_max) real spc(2000),zzero(2000) real s_quad(2000), t_quad(2000) real z_max integer id, pgopen integer etamax,etamin real pm(4) !panel margins logical plot_orbit/.false./ if(plot_type(1:1) == 'P')then id = pgopen('bmadz.ps/cps') print *,' write bmadz.ps' elseif(plot_type(1:1) == 'G')then id = pgopen('bmadz.gif/gif') print *,' write bmadz.gif' else id = pgopen('/xs') endif ! id = pgopen(plot_type) ! set window size if (id.le.0) then print*, 'Error in PLOTDO_BMADZ: cannot open device ', plot_type return end if call pgslct(id) call pgask(.false.) do i=1,pc%total_pc spc(i)=pc%cross(i)%ele%s zzero(i)=0. end do call pgscr (0, 1., 1., 1.) call pgscr (1, 0., 0., 0.) call pgpap(5., 1.) call pgscr(2, 1.0, 0.0, 0.0) call pgscr(3, 0.0, 0.0, 1.0) !------------------------------------------------ j=0 k=0 n_ele = lat%n_ele_track s(0) = lat%ele(0)%s do i=1,n_ele s(i) = s(i-1) + lat%ele(i)%value(l$) rbetax(i)=sqrt(lat%ele(i)%a%beta) rbetay(i)=sqrt(lat%ele(i)%b%beta) etax(i)=lat%ele(i)%a%eta x(i) = co(i)%vec(1)*1000. y(i) = co(i)%vec(3)*1000. if(abs(x(i)) > 0. .or.abs(y(i))>0)plot_orbit = .true. if(present(nonlin))then rbetax_e(i)=sqrt(nonlin%nonele_ele(i)%tx%beta) rbetay_e(i)=sqrt(nonlin%nonele_ele(i)%ty%beta) etax_e(i)=nonlin%nonele_ele(i)%tx%eta x_e(i) = nonlin%nonele_ele(i)%co_off(2)%vec(1)*1000. y_e(i) = nonlin%nonele_ele(i)%co_off(2)%vec(3)*1000. endif if(lat%ele(i)%name(1:1) .eq. 'Q')then j=j+1 s_quad(j) = lat%ele(i)%s read(lat%ele(i)%name(2:3),'(i2)', err=10)quad_number if(mod(quad_number,10) .eq. 0 .or. mod(quad_number,10) .eq. 5)then k=k+1 t_quad(k) = lat%ele(i)%s endif 10 continue endif end do etamax = max((maxval(etax(1:n_ele))+.5),1.) etamin = minval(etax(1:n_ele))-1. pm = (/.075, 1., .05, .95/) z_max = lat%ele(n_ele)%s call pgsclp(0) if(plot_orbit)then call pgsubp(1, 5) else call pgsubp(1, 3) endif if(plot_orbit)then !!vertical orbit call pgpage call pgsvp(pm(1), pm(2), pm(3), pm(4)) call pgswin(0., z_max, -10., 10.) call pgsch(3.) call pgbox('bc', 0.0, 0.0, 'bcnsv', 10.0, 2) call pgsci(2) call pgline(n_ele, s(1:), y) if(present(nonlin))then call pgsci(3) call pgsls(2) call pgline(n_ele, s(1:), y_e) endif call pgsci(1) call pgsls(1) call custom_ticks(k, t_quad, zzero-10., 2., 1, 2) call custom_ticks(j, s_quad, zzero-10., 1., 1, 2) call custom_ticks(pc%total_pc, spc, zzero, .5, 1, 2) call pgsch(5.) call pglab('', 'y', '') !horizontal orbit call pgpage call pgsvp(pm(1), pm(2), pm(3), pm(4)) call pgswin(0., z_max, -20., 20.) call pgsch(3.) call pgbox('bc', 0.0, 0.0, 'bcnsv', 20.0, 2) call pgsci(2) call pgline(n_ele, s(1:), x) if(present(nonlin))then call pgsci(3) call pgsls(2) call pgline(n_ele, s(1:), x_e) endif call pgsci(1) call pgsls(1) call custom_ticks(k, t_quad, zzero-20., 4., 1, 2) call custom_ticks(j, s_quad, zzero-20., 2., 1, 2) call custom_ticks(pc%total_pc, spc, zzero, 1., 1, 2) call pgsch(5.) call pglab('', 'x', '') endif !eta call pgpage call pgsvp(pm(1), pm(2), pm(3), pm(4)) call pgswin(0., z_max, float(etamin), float(etamax)) call pgsch(3.) call pgsls(4) call pgbox('', 0., 0., 'g', 1., 0) call pgsls(1) call pgbox('bc', 0.0, 0.0, 'bcnvs', 2.0, 1) call pgsci(2) call pgline(n_ele, s(1:), etax) if(present(nonlin))then call pgsci(3) call pgsls(2) call pgline(n_ele, s(1:), etax_e) endif call pgsci(1) call pgsls(1) call custom_ticks(k, t_quad, zzero, .2, 1, 2) call custom_ticks(j, s_quad, zzero, .1, 1, 2) call pgsch(5.) if(plot_orbit)then call pglab('', '\gy\dx', '') else call pgsch(3.5) call pgmtxt('L',1.5,0.5,0.5, '\gy\dx') endif !sqrt(betay) call pgpage call pgsvp(pm(1), pm(2), pm(3), pm(4)) call pgswin(0., z_max, 0., 10.) call pgsch(3.) call pgsls(4) call pgbox('', 0., 0., 'g', 2., 0) call pgsls(1) call pgbox('bc', 0., 0., 'bcnv', 5., 5) call pgsci(2) call pgline(n_ele, s(1:), rbetay) if(present(nonlin))then call pgsci(3) call pgsls(2) call pgline(n_ele, s, rbetay_e) endif call pgsci(1) call pgsls(1) call custom_ticks(k, t_quad, zzero, 1., 1, 2) call custom_ticks(j, s_quad, zzero, .5, 1, 2) call pgsch(5.) ! call pglab('', '\gb\dy', '') if(plot_orbit)then call pglab('', '\(2255)\gb\dy', '') else call pgsch(3.5) call pgmtxt('L',1.5,0.5,0.5, '\(2255)\gb\dy') endif ! sqrt(betax) call pgpage call pgsvp(pm(1), pm(2), pm(3), pm(4)) call pgswin(0., z_max, 0., 10.) call pgsch(3.) call pgsls(4) call pgbox('', 0., 0., 'g', 2., 0) call pgsls(1) call pgbox('bc', 0., 0., 'bcnv', 5., 5) call pgsci(2) call pgline(n_ele, s(1:), rbetax) if(present(nonlin))then call pgsci(3) call pgsls(2) call pgline(n_ele, s(1:), rbetax_e) endif call pgsci(1) call pgsls(1) call custom_ticks(k, t_quad, zzero, 1., 1, 2) call custom_ticks(j, s_quad, zzero, .5, 1, 2) call pgsch(5.) if(plot_orbit)then call pglab('', '\(2255)\gb\dx', '') else call pgsch(3.5) call pgmtxt('L',1.5,0.5,0.5, '\(2255)\gb\dx') endif call pgclos contains subroutine custom_ticks(n_ticks, x, y, length, orient, pos) integer, intent(in) :: n_ticks real, intent(in) :: x(:), y(:), length integer, intent(in) :: orient, pos integer i real x_tick(2), y_tick(2) do i = 1, n_ticks if (orient.eq.1) then !vertical ticks x_tick(1) = x(i) x_tick(2) = x(i) select case(pos) case(1) ! ticks above axis y_tick(1) = y(i) y_tick(2) = y(i) + length case(2) ! ticks centered on axis y_tick(1) = y(i) - (length/2) y_tick(2) = y(i) + (length/2) case(3) ! ticks below axis y_tick(1) = y(i) - length y_tick(2) = y(i) end select else if (orient.eq.2) then ! horizontal ticks y_tick(1) = y(i) y_tick(2) = y(i) select case(pos) case(1) ! ticks right of axis x_tick(1) = x(i) x_tick(2) = x(i) + length case(2) ! ticks centered on axis x_tick(1) = x(i) - (length/2) x_tick(2) = x(i) + (length/2) case(3) ! ticks left of axis x_tick(1) = x(i) - length x_tick(2) = x(i) end select endif call pgline(2, x_tick, y_tick) enddo end subroutine end subroutine !........................................................................ !........................................................................ subroutine type_out(lat, twiss, co, co_lat, pc, x_emit, sige_e, & chromx,chromy, twiss_max) implicit none type (lat_struct) lat type (coord_struct), allocatable :: co_lat(:) type (coord_struct) co type (ele_struct) twiss type (pc_struct) pc type (twiss_max_struct) twiss_max real(rp) x_emit, sige_e real(rp) chromx, chromy character * 10 name integer i,j integer idum write(26,*)' Horizontal emittance = ',x_emit write(26,*)' Energy spread = ',sige_e write(26,*)' Crossing angle = ',co%vec(2) write(26,*)' Horizontal chromaticity = ',chromx write(26,*)' Vertical chromaticity = ',chromy idum=twiss_max%arc%a%ix_beta write(26,11)twiss_max%arc%a%beta,lat%ele(idum)%name 11 format(1x,' Max arc beta_x = ',f8.3,' @ ', a8) idum=twiss_max%arc%b%ix_beta write(26,12)twiss_max%arc%b%beta,lat%ele(idum)%name 12 format(1x,' Max arc beta_y = ',f8.3,' @ ', a8) idum=twiss_max%arc%a%ix_eta write(26,13)twiss_max%arc%a%eta,lat%ele(idum)%name 13 format(1x,' Max arc eta_x = ',f8.3,' @ ', a8) idum=twiss_max%ir%a%ix_beta write(26,14)twiss_max%ir%a%beta,lat%ele(idum)%name 14 format(1x,' Max ir beta_x = ',f8.3,' @ ', a8) idum=twiss_max%ir%b%ix_beta write(26,15)twiss_max%ir%b%beta,lat%ele(idum)%name 15 format(1x,' Max ir beta_y = ',f8.3,' @ ', a8) idum=twiss_max%ir%a%ix_eta write(26,16)twiss_max%ir%a%eta,lat%ele(idum)%name 16 format(1x,' Max ir eta_x = ',f8.3,' @ ', a8) write(26,17)twiss_max%arc%a%sigma*1000., twiss_max%ir%a%sigma*1000. 17 format(1x,' Max arc sigma_x (mm) = ',f8.3,' Max ir sigma_x (mm) = ',f8.3) write(26,2) 2 format(1x, ' i ',' z ',' element ',' betay ',' betax ', & ' eta ',' etap ',' x ',' y ',' sigma') name= 'IP' write(26,1)0,name,twiss%b%beta, & twiss%a%beta,twiss%a%eta, & twiss%a%etap,co%vec(1),co%vec(3) do i=1,lat%n_ele_track write(26,1)i,lat%ele(i)%name,lat%ele(i)%s,lat%ele(i)%b%beta, & lat%ele(i)%a%beta,lat%ele(i)%a%eta, & lat%ele(i)%a%etap, co_lat(i)%vec(1), co_lat(i)%vec(3), & lat%ele(i)%a%sigma*1000. 1 format(1x,i4,1x,a10,f8.3,2f8.3,5f10.5) end do write(26,3) 3 format(/,1x,'crossing point',' z ',' beta y ',' beta x ', & ' eta x ',' x(mm) ',' y(mm) ',' sigma x(mm) ') do j=1,pc%total_pc write(26,4)j,pc%cross(j)%ele%s,pc%cross(j)%ele%b%beta, & pc%cross(j)%ele%a%beta,pc%cross(j)%ele%a%eta, & pc%cross(j)%orbit%vec(1)*1000.,pc%cross(j)%orbit%vec(3)*1000., & pc%cross(j)%ele%a%sigma*1000. end do 4 format(1x,4x,i4,4x,7f8.2) return end subroutine type_out !........................................................................ !........................................................................ subroutine zrep_out(lat, co, pc, global, twiss_max, & pretz, cesr, nonlin, moment, con) implicit none type (lat_struct) lat type (coord_struct), allocatable :: co(:) type (db_struct) cesr type (pc_struct) pc type (twiss_max_struct) twiss_max type (pretz_struct) pretz type (global_struct) global type (nonlin_ele_struct) nonlin type (moment_struct) moment type (constraint_struct) con integer i, ix, j, jsep(4), k, n, ios, num, l real(rp) num_sigma_x, err, num_sigma_y real(rp) volts character date_str*20, name*8 ! num_sigma_x = 20.0 num_sigma_y = 12.0 err = 10.0 ! mm !------------------------------------------------------------------------ ! ZREP.DAT open(unit=27, file = 'zrep.dat') write(27, '(10x,a9,2x,a)' )' Lattice ',con%lat_file write(27,'(10x,a19,f12.4)')' Beam energy (GeV) ',lat%ele(0)%value(E_TOT$)/1.e9 write(27,*) write(27,'(32x,2(2x,a13))')' Positrons ',' Electrons ' write(27,1)lat%ele(0)%b%beta, nonlin%nonele_ele(0)%ty%beta 1 format(10x,'Bv* South IR',12x,2(2x,f13.4)) write(27,2)lat%ele(0)%a%beta, nonlin%nonele_ele(0)%tx%beta 2 format(10x,'Bh* South IR',12x,2(2x,f13.4)) write(27,3)lat%ele(0)%a%eta, nonlin%nonele_ele(0)%tx%eta 3 format(10x,'Eta South IR',12x,2(2x,f13.4)) write(27,4)twiss_max%arc%b%sigma*1000. * num_sigma_x + err 4 format(10x,'Arc Vert Ap ',12x,2x,f13.4) write(27,5)twiss_max%arc%a%sigma*1000. * num_sigma_x + err 5 format(10x,'Arc Horz Ap ',12x,2x,f13.4) write(27,6)twiss_max%ir%b%sigma*1000. * num_sigma_y 6 format(10x,'IR Vert Ap ',12x,2x,f13.4) write(27,7)twiss_max%ir%a%sigma*1000. * num_sigma_x + err 7 format(10x,'IR Horz Ap ',12x,2x,f13.4) write(27,8)twiss_max%arc%b%beta 8 format(10x,'Arc Bv Max ',12x,2x,f13.4) write(27,9)twiss_max%arc%a%beta 9 format(10x,'Arc Bh Max ',12x,2x,f13.4) write(27,10)twiss_max%arc%a%eta 10 format(10x,'Arc Eta Max ',12x,2x,f13.4) write(27,11)twiss_max%ir%b%beta 11 format(10x,'Ir Bv Max ',12x,2x,f13.4) write(27,12)twiss_max%ir%a%beta 12 format(10x,'Ir Bh Max ',12x,2x,f13.4) write(27,13)twiss_max%ir%a%eta 13 format(10x,'Ir Eta Max ',12x,2x,f13.4) ! if (lat%param%symmetry == ew_antisymmetry$) then ! n=lat%n_ele_symm ! k=2 ! else n=lat%n_ele_track k=1 ! endif write(27,14)lat%ele(n)%b%phi /twopi*k, nonlin%nonele_ele(lat%n_ele_track)%ty%phi/twopi 14 format(10x,'Vert Tune ',12x, 2(2x,f13.4)) write(27,15)lat%ele(n)%a%phi /twopi*k,nonlin%nonele_ele(lat%n_ele_track)%tx%phi/twopi 15 format(10x,'Horz Tune ',12x,2(2x,f13.4)) write(27,'(10x,a12,12x,2(2x,e13.5))')' Horz Emitt ', & global%wig%x_emit, global%mode_electron%a%emittance write(27, '(10x,a12,12x,2x,2(1x,e12.5))')' Sigma E/E ', & global%wig%sige_e, global%mode_electron%sigE_E write(27,'(10x,a14,10x,2(2x,e12.5))')' Mev Loss/rev ', & global%wig%e_loss/1.e6, & global%mode_electron%e_loss/1.e6 write(27,'(10x,a12,13x,2(2x,e14.6))')' J_x ', & global%mode_positron%a%j_damp, & global%mode_electron%a%j_damp write(27,'(10x,a25,2(2x,e14.6))')' Horiz damping decrement ' , & global%mode_positron%a%alpha_damp, & global%mode_electron%a%alpha_damp write(27,'(10x,a25,2(2x,e14.6))')' Longi damping decrement ' , & global%mode_positron%z%alpha_damp, & global%mode_electron%z%alpha_damp write(27,'(10x,a25,2(2x,e14.6))')' Radiation Integral 1 ', & global%mode_positron%synch_int(1), & global%mode_electron%synch_int(1) write(27,'(10x,a25,2(2x,e14.6))')' Radiation Integral 2 ', & global%mode_positron%synch_int(2), & global%mode_electron%synch_int(2) write(27,'(10x,a25,2(2x,e14.6))')' Radiation Integral 3 ', & global%mode_positron%synch_int(3), & global%mode_electron%synch_int(3) write(27,'(10x,a25,2(2x,e14.6))')' Radiation Int 4 (horiz) ', & global%mode_positron%a%synch_int(4), & global%mode_electron%a%synch_int(4) write(27,'(10x,a25,2(2x,e14.6))')' Radiation Int 5 (horiz) ', & global%mode_positron%a%synch_int(5), & global%mode_electron%a%synch_int(5) write(27,'(10x,a25,2(2x,e14.6))')' Momentum compaction ', & global%mode_positron%synch_int(1)/lat%ele(lat%n_ele_track)%s, & global%mode_electron%synch_int(1)/lat%ele(lat%n_ele_track)%s write(27,*) call set_on_off (rfcavity$, lat, on$) volts = 0. do i=1,lat%n_ele_track if(lat%ele(i)%key == rfcavity$)then lat%ele(i)%value(voltage$) = 10.*1.e6/4. !set each of 4 cavities to 2.5e6ev call lat_make_mat6(lat,i) volts = volts + 2.5e6 endif end do call calc_z_tune(lat%branch(0)) write(27,'(7x,a27,f12.4,a7,f12.4 )')' Accelerating voltage (MV) ', & volts/1.e6, ' => Qs ', & lat%z%tune/twopi call set_on_off (rfcavity$, lat, off$) write(27,'(/)') write(27,21)pretz%efficiency 21 format(10x,'Pretz efficiency', g14.7) ! write(27,22)0.,0 22 format(10x,' 9 B UTILIZE',f9.1,'mm@',i3) write(27,23)co(0)%vec(2)*1000. 23 format(10x,'THETA *=> ',f13.4) ! jsep(1)=cesr%h_sep(h_sep_08w$)%ix_lat ! jsep(4)=cesr%h_sep(h_sep_08e$)%ix_lat ! jsep(2)=cesr%h_sep(h_sep_45w$)%ix_lat ! jsep(3)=cesr%h_sep(h_sep_45e$)%ix_lat ! write(27,24)(lat%ele(jsep(i))%value(volt$), i=1,4) !24 format(10x,'HSEP KV=> ',4f9.2) write(27,25)pretz%x%ir_ape*1000. *2. ,lat%ele(pretz%x%ir_ape_ix)%name 25 format(10x,'PRETZ IR=>105',f8.2,' @',a) ! write(27,27)lat%ele(jsep(1))%value(hkick$) * 1000. !27 format(10x,'K08(MR)=>108 ',f13.5) ! write(27,28)lat%ele(jsep(2))%value(hkick$) * 1000. !28 format(10x,'K45(MR)=>109 ',f13.5) write(27,29)pretz%x%arc_ape*1000. *2., lat%ele(pretz%x%arc_ape_ix)%name 29 format(10x,'PRZ ARC=>107',f7.2,' @',a) ! write(27,30)lat%ele(jsep(1))%a%phi /twopi !30 format(10x,'PH H 8=>110 ',f13.5) write(27,31)pretz%x%dnu, lat%ele(pretz%x%dnu_ix)%name 31 format(10x,'DNUH MX/MA ',f9.6,' @',a) write(27,32)pretz%y%dnu, lat%ele(pretz%y%dnu_ix)%name 32 format(10x,'DNUV MX/MA ',f9.6,' @',a) write(27,33)pretz%wt 33 format(10x,'WT BPAR=>208 ',3x,e14.6) write(27,34)global%chromx 34 format(10x,'Horz Chrom ',f13.6) write(27,35)global%chromy 35 format(10x,'Vert Chrom ',f13.6) close(unit=27) !------------------------------------------------------------------------ ! BETA_ORBIT.DAT open(unit = 26, file = 'beta_orbit.dat') call date_and_time_stamp (date_str) write (26, '(4a)') 'Lattice = `', trim(lat%lattice), "'" write (26, '(4a)') 'File_name = `', trim(lat%input_file_name), "'" write (26, '(4a)') 'data_date = `', date_str, "'" write (26, '(a, f8.3, a)') 'Max_arc_sigma_x =', & 1e3*twiss_max%arc%a%sigma, ' ! (mm)' write (26, '(a, f8.3, a)') 'Max_arc_sigma_y =', & 1e3*twiss_max%arc%b%sigma, ' ! (mm)' write (26, '(a)') 'Return' write (26, *) write(26, '(4x, a)') 'i element z beta_y beta_x eta_x' // & ' etap_x x xp y'// & ' sigma' do i = 1, lat%n_ele_track write (26, '(1x,i4,1x,a10,f8.3,2f10.4,6f10.5)') & i, lat%ele(i)%name, lat%ele(i)%s, lat%ele(i)%b%beta, & lat%ele(i)%a%beta, lat%ele(i)%a%eta, & lat%ele(i)%a%etap, co(i)%vec(1), co(i)%vec(2), co(i)%vec(3), & lat%ele(i)%a%sigma*1000. end do close(unit = 26) !------------------------------------------------------------------------ ! DBETA_DE.DAT open (unit = 26, file = 'dbeta_de.dat') write (26, '(4a)') 'Lattice = `', trim(lat%lattice), "'" write (26, '(4a)') 'File_name = `', trim(lat%input_file_name), "'" write (26, '(4a)') 'data_date = `', date_str, "'" write (26, '(a, f8.3, a)') 'x_chrom =', nonlin%chrom_x write (26, '(a, f8.3, a)') 'y_chrom =', nonlin%chrom_y write (26, '(a)') 'Return' write (26, *) write (26, '(4x, a)') 'i element z dbeta_x dbeta_y' do i = 1, lat%n_ele_track write (26, '(1x, i4, 1x, a10, f8.3, 2f9.2)') & i, lat%ele(i)%name, lat%ele(i)%s, & nonlin%non_ele(i)%a%dbeta, nonlin%non_ele(i)%b%dbeta enddo close (unit = 26) !------------------------------------------------------------------------ ! SEXTUPOLE.DAT if (moment%n_sext /= 0) then open (unit = 26, file = 'sextupole.dat') write (26, *) '! Sextupole values' write (26, *) '! Index k2 Name ix_lat' do i = 1, moment%n_sext ix = moment%ix(i) name = moment%name(i) if(index(name, 'SEX') /= 0)then read(name(5:6), *, iostat = ios) num if (name(7:7) == 'E' .and. ios == 0) num = 99 - num endif if(index(name(1:5), 'WIG') /= 0) then j = index(name,'_')+1 read(name(j:j+1), *, iostat = ios) num if (name(8:8) == 'E' .and. ios == 0) num = 99 - num endif if (ios /= 0) print *, & 'ERROR IN ZREP_OUT: PROBLEM READING SEXTUPOLE OR WIGGLER NUMBER: ', trim(name) write (26, '(i7, f12.4, 2x, a12, i9)') num, & ! lat%ele(ix)%value(k2$), moment%name(i), ix moment%k2l(i), moment%name(i), ix enddo close (unit = 26) endif !------------------------------------------------------------------------ ! MOBIUS.DAT ! open (unit = 26, file = 'mobius_beta_orbit.dat') ! write (26, '(4a)') 'Lattice = `', trim(lat%lattice), "'" ! write (26, '(4a)') 'File_name = `', trim(lat%input_file_name), "'" ! write (26, '(4a)') 'data_date = `', date_str, "'" ! write (26, '(a)') 'Return' ! write (26, *) ! write (26, '(26x, a)') '......Mobius projections.....' ! write (26, '(4x, a)') 'i element z beta_x beta_y eta_x' // & ! ' eta_y x_co y_co' ! do i = 1, lat%n_ele_track ! write (26, '(1x, i4, 1x, a10, 5f8.3, 2f10.5)') & ! i, lat%ele(i)%name, lat%ele(i)%s, lat%ele(i)%a%mobius_beta, & ! lat%ele(i)%b%mobius_beta, lat%ele(i)%a%mobius_eta, & ! lat%ele(i)%b%mobius_eta, co(i)%vec(1), co(i)%vec( ! ! enddo ! ! close (unit = 26) !------------------------------------------------------------------------ ! PRETZEL.DAT open(unit=28, file = 'pretzel.dat') write(28,53) 53 format(/,1x,'crossing point',' z ',' beta y ',' beta x ', & 'eta x ',' x(mm) ',' y(mm) ',' sig_x ', & ' dnuh ',' dnuv ',' b_param ') do j=1,pc%total_pc write(28,54)j,pc%cross(j)%ele%s,pc%cross(j)%ele%b%beta, & pc%cross(j)%ele%a%beta,pc%cross(j)%ele%a%eta, & pc%cross(j)%orbit%vec(1)*1000.,pc%cross(j)%orbit%vec(3)*1000., & pc%cross(j)%ele%a%sigma*1000.,pc%cross(j)%dnuh, & pc%cross(j)%dnuv, pc%cross(j)%b_param end do 54 format(1x,4x,i4,4x,7f8.2,2e12.3,f10.3) close(unit=28) open(unit=28, file = 'parasitic_crossings.dat') write(28,'(/,a16,a10,4x,a11,10x,a16)')'crossing point','z','nearest bpm','distance to bpm' do j=1,pc%total_pc write(28,'(i8,8x,f12.4,4x,a16,f10.2)')j,pc%cross(j)%ele%s, pc%cross(j)%bpm, pc%cross(j)%distance_to_bpm end do close(unit=28) open(unit=28, file = 'pretzel_tuneshift.dat') write (28, '(4a)') 'Lattice = `', trim(lat%lattice), "'" write (28, '(4a)') 'File_name = `', trim(lat%input_file_name), "'" write (28, '(4a)') 'data_date = `', date_str, "'" write (28, '(a,i5)') 'Number_of_trains = ', con%n_trains write (28, '(a,i5)') 'Number_of_bunches = ', con%n_cars write (28, '(a)') 'Return' write(28, 55) 55 format(/,1x,' Bunch ',' Dnuv/ma ',' Dnuh/ma ',' Train ',' Car ') l=0 do j=1,con%n_trains do k=1,con%n_cars l=l+1 write(28,'(4x,i2,3x,2(e12.4),3x,i1,3x,2x,i1,2x)') & l,pretz%y%dnu_tot(l), pretz%x%dnu_tot(l), j,k end do end do close(unit=28) !------------------------------------------------------------------------ ! NONLINEAR_BETA_ORBIT.DAT open(unit = 26, file = 'nonlinear_beta_orbit.dat') call date_and_time_stamp (date_str) write (26, '(4a)') 'Lattice = `', trim(lat%lattice), "'" write (26, '(4a)') 'File_name = `', trim(lat%input_file_name), "'" write (26, '(4a)') 'data_date = `', date_str, "'" write (26, '(a, f8.3, a)') 'Horizontal chromaticity =', nonlin%chrom_x write (26, '(a, f8.3, a)') 'Vertical chromaticity =', nonlin%chrom_y write (26, '(a)') 'Return' write (26, *) write(26, '(4x, a)') 'i element z beta_y beta_x eta_x' // & ' etap_x x y sigma' do i = 1, lat%n_ele_track write (26, '(1x,i4,1x,a10,f8.3,2f8.3,4f10.5)') & i, lat%ele(i)%name, lat%ele(i)%s, & nonlin%non_ele(i)%b%beta, & nonlin%non_ele(i)%a%beta, nonlin%non_ele(i)%a%eta, & nonlin%non_ele(i)%a%etap, co(i)%vec(1), co(i)%vec(3) end do close(unit = 26) !------------------------------------------------------------------------ end subroutine end module