! ! In the calling program define the structure by: ! RECORD / PRETZ_STRUCT /PRETZ ! ! Example values ! ! PRETZ.X.DNU Maximum horizontal tune shift ! PRETZ.X.DNU_IX Location of maximum horizontal tune shift ! PRETZ.X.DNU_X Maximum horizontal tune shift (horizontal separation only) ! PRETZ.X.DNU_IX_X Location of maximum horizontal tune shift for ! (horizontal separation only) ! PRETZ.X.DNU_X_Y Maximum horizontal tune shift (vertical separation only) ! PRETZ.X.DNU_IX_Y Location of maximum horizontal tune shift for ! (vertical separation only) ! PRETZ.X.ARC_APE Maxium arc horizontal aperture ! PRETZ.X.ARC_APE_IX Location of max arc horizontal aperture ! PRETZ.X.IR_APE Maxium ir horizontal aperture ! PRETZ.X.IR_APE_IX Location of max ir horizontal aperture ! PRETZ.X.DNU_TOT(k) !sum of tune shifts for bunch k ! PRETZ.WT !Welch-Temnykh parameter ! PRETZ.B_PARAM !B parameter ! PRETZ.MIN_SEP !minimum of displacement/sqrt(betax) at pc ! PRETZ.MAX_DISP !maximum of displacement/sqrt(betax) anywhere ! PRETZ.EFFICIENCY !pretz.min_sep/pretz.max_disp ! PRETZ.NSIGMA number of sigma between pretzel trajectory and physical ! aperture ! PRETZ.SIGMA_SEP !minimum separation in units of horizontal beam size ! PRETZ.curly_d !change in curly d with pretzel !- module pretz_mod use precision_def use bmadz_mod use bunchcross_mod use zquad_lens_mod use constraints_mod type p_max_struct real(rp) arc_ape real(rp) ir_ape real(rp) dnu, dnu_x, dnu_y real(rp) dnu_tot(200) integer ir_ape_ix integer arc_ape_ix integer dnu_ix, dnu_ix_x, dnu_ix_y end type type pretz_struct type (p_max_struct) x,y real(rp) wt !welch-temnykh parameter real(rp) b_param !b parameter real(rp) min_sep, max_disp, efficiency, b_efficiency, vert_efficiency real(rp) n_sigma real(rp) sigma_sep real(rp) curly_d end type contains !........................................................................ ! ! Subroutine : PRETZEL (LAT, CON, global, PC, CO, QUAD, PRETZ) ! ! Description: Subroutine to compute pretzel properties, like aperture ! required horizontal and vertical long range tune shift, and ! welch-temnykh ! ! Arguments : ! Input: LAT, PC, CO(0:*) ! CON.N_TRAINS ! number of trains ! CON.N_CARS ! number of bunches per train ! ! Output: PC.CROSS(j).DNUV !long range vertical tune shift at ! crossing j ! PC.CROSS(j).DNUH !long range horizontal tune shift at ! crossing j ! PRETZ.X.DNU Maximum horizontal tune shift ! PRETZ.X.DNU_IX Location of maximum horizontal tune shift ! PRETZ.X.ARC_APE Maxium arc horizontal aperture ! PRETZ.X.ARC_APE_IX Location of max arc horizontal aperture ! PRETZ.X.IR_APE Maxium ir horizontal aperture ! PRETZ.X.IR_APE_IX Location of max ir horizontal aperture ! PRETZ.WT !Welch-Temnykh parameter ! PRETZ.B_PARAM !B parameter ! PRETZ.sigma_sep !minimum horizontal separation in units of ! horiz sig ! ! pc.cross(j).dnuv = betay * (1.-2*y2*sep2_inv)*sep2_inv *6.938e-10 !/ma ! pc.cross(j).dnuh = betax * (1.-2*x2*sep2_inv)*sep2_inv *6.938e-10 !/ma ! pc.cross(j).dnuv_x = betay * (1.-2*y2/x2)/x2 *6.938e-10 !/ma ! pc.cross(j).dnuh_x = betax * (1.-2*x2/x2)/x2 *6.938e-10 !/ma ! pc.cross(j).dnuv_y = betay * (1.-2*y2/y2)/y2 *6.938e-10 !/ma ! pc.cross(j).dnuh_y = betax * (1.-2*x2/y2)/y2 *6.938e-10 !/ma subroutine pretzel(lat, con, global, pc, co, & quad, pretz) implicit none type (lat_struct) lat type (pc_struct) pc type (coord_struct), allocatable :: co(:) type (zquad_struct) quad type (pretz_struct) pretz type (global_struct) global type (constraint_struct) con integer i,j,k, ix_total(100) real(rp) x,y,x2,y2,sep2_inv real(rp) betax, betay real(rp) wt_sum(200),delta_wt real(rp) b_sum(200),delta_b real(rp) aperture, n_sigma real(rp) horizontal_emit real(rp) n_sigma_sep real(rp) const real(rp) etax, sigE_E real(rp) compare(200) real(rp) :: delta_b_max = 0, delta_b_min = 99 real(rp) sep2_inv_min real(rp) :: beta0 = 40 real(rp) :: max_x_disp = 0 logical no_emit integer worst_pc(200) integer ntrains, nbunches, nbuntot integer i_near ! integer nearest_quad ! external nearest_quad compare(:) = 0 const = r_e * lat%param%total_length * e_mass / & (twopi * e_charge * c_light * lat%ele(0)%value(E_TOT$) / 1.0e9) ntrains = con%n_trains nbunches = con%n_cars nbuntot = ntrains*nbunches pretz%n_sigma = 7.5 n_sigma = pretz%n_sigma if (global%wig%x_emit == 0) then no_emit = .true. else no_emit = .false. endif ! pretz%x%dnu=0. pretz%y%dnu=0. pretz%x%dnu_x=0. pretz%y%dnu_x=0. pretz%x%dnu_y=0. pretz%y%dnu_y=0. pretz%min_sep = 1000. pretz%sigma_sep = 1000. delta_b_max = 0. delta_b_min = 99. sep2_inv_min = 99. do k=1,nbuntot !bunch k crossing j pretz%x%dnu_tot(k)= 0. pretz%y%dnu_tot(k)= 0. wt_sum(k)= 0. b_sum(k)= 0. ix_total(k)=0. end do do j=1,pc%total_pc i=pc%cross(j)%ix if((con%exclude_lrbbi(1)(1:4) /= lat%ele(i)%name(1:4)) .and. & (con%exclude_lrbbi(2)(1:4) /= lat%ele(i)%name(1:4)))then x=2.*pc%cross(j)%orbit%vec(1) y=2.*pc%cross(j)%orbit%vec(3) x2=x*x y2=y*y if(x2+y2 <0.0000000001)then write(6,1)j,lat%ele(i)%name 1 format(1x,' SUBROUTINE PRETZEL : no separation at pc #',i3, & /,' in element',1x,a8,1x,' Pretzel parameters not calculated') return endif sep2_inv=1./(x2+y2) sep2_inv_min = min(sep2_inv, sep2_inv_min) betax = pc%cross(j)%ele%a%beta betay = pc%cross(j)%ele%b%beta ! pc.cross(j).dnuv = betay * (1.-2*y2*sep2_inv)*sep2_inv *6.938e-10 !/ma ! pc.cross(j).dnuh = betax * (1.-2*x2*sep2_inv)*sep2_inv *6.938e-10 !/ma pc%cross(j)%dnuv = betay * (1.-2*y2*sep2_inv)*sep2_inv *const *0.001 !/ma pc%cross(j)%dnuh = betax * (1.-2*x2*sep2_inv)*sep2_inv *const *0.001 !/ma if(x2 > 0.00000001)then ! pc.cross(j).dnuv_x = betay * (1.-2*y2/x2)/x2 *6.938e-10 !/ma ! pc.cross(j).dnuh_x = betax * (1.-2*x2/x2)/x2 *6.938e-10 !/ma pc%cross(j)%dnuv_x = betay * (1.-2*y2/x2)/x2 * const *0.001 !/ma pc%cross(j)%dnuh_x = betax * (1.-2*x2/x2)/x2 * const *0.001 !/ma else pc%cross(j)%dnuv_x = 9999. pc%cross(j)%dnuh_x = 9999. endif if(y2 > 0.00000001)then ! pc.cross(j).dnuv_y = betay * (1.-2*y2/y2)/y2 *6.938e-10 !/ma ! pc.cross(j).dnuh_y = betax * (1.-2*x2/y2)/y2 *6.938e-10 !/ma pc%cross(j)%dnuv_y = betay * (1.-2*y2/y2)/y2 * const * 0.001 !/ma pc%cross(j)%dnuh_y = betax * (1.-2*x2/y2)/y2 * const * 0.001 !/ma else pc%cross(j)%dnuv_y = 9999. pc%cross(j)%dnuh_y = 9999. endif if(pretz%x%dnu < abs(pc%cross(j)%dnuh))then pretz%x%dnu = abs(pc%cross(j)%dnuh) pretz%x%dnu_ix = i endif if(pretz%y%dnu < abs( pc%cross(j)%dnuv))then pretz%y%dnu = abs(pc%cross(j)%dnuv) pretz%y%dnu_ix = i endif if(pretz%x%dnu_x < abs(pc%cross(j)%dnuh_x))then pretz%x%dnu_x = abs(pc%cross(j)%dnuh_x) pretz%x%dnu_ix_x = i endif if(pretz%y%dnu_x < abs( pc%cross(j)%dnuv_x))then pretz%y%dnu_x = abs(pc%cross(j)%dnuv_x) pretz%y%dnu_ix_x = i endif if(pretz%x%dnu_y < abs(pc%cross(j)%dnuh_y))then pretz%x%dnu_y = abs(pc%cross(j)%dnuh_y) pretz%x%dnu_ix_y = i endif if(pretz%y%dnu_y < abs( pc%cross(j)%dnuv_y))then pretz%y%dnu_y = abs(pc%cross(j)%dnuv_y) pretz%y%dnu_ix_y = i endif horizontal_emit = global%wig%x_emit sigE_E = global%wig%sige_e etax = pc%cross(j)%ele%a%eta if(con%fully_coupled ) horizontal_emit = 0.5*global%wig%x_emit delta_wt = betay * betax * horizontal_emit * sep2_inv *0.1 * & (5.289/(lat%ele(0)%value(E_TOT$)/1.0e9)) !welch-temnykh/ma delta_b = betay * (betax * horizontal_emit + (etax * sigE_E)**2) * & sep2_inv * 0.10 * (5.289/(lat%ele(0)%value(E_TOT$)/1.0e9)) !b_param/ma pc%cross(j)%b_param = delta_b delta_b_max = max(delta_b_max, delta_b) delta_b_min = min(delta_b_min, delta_b) pretz%min_sep = min(pretz%min_sep, 0.5*sqrt((x2+y2)/betax) ) if (pc%cross(j)%ele%a%sigma < 0.000000000001) then n_sigma_sep = 10000 else n_sigma_sep = 1./(sqrt(sep2_inv)*pc%cross(j)%ele%a%sigma) endif pretz%sigma_sep = min(pretz%sigma_sep, n_sigma_sep) do k=1,nbuntot !bunch k crossing j if(pc%beam_beam(k,j))then pretz%x%dnu_tot(k)= pretz%x%dnu_tot(k) & +pc%cross(j)%dnuh pretz%y%dnu_tot(k)= pretz%y%dnu_tot(k) & +pc%cross(j)%dnuv wt_sum(k)=wt_sum(k)+delta_wt**2 !WT factor b_sum(k)=b_sum(k)+delta_b**2 !WT factor ix_total(k)=ix_total(k)+1 if (compare(k)<=(delta_b**2)) then compare(k) = delta_b**2 worst_pc(k) = j endif endif end do endif enddo do k=1,nbuntot b_sum(k) = sqrt(b_sum(k)) enddo pretz%wt=0. pretz%b_param=0. open(unit=26, file = 'b_param.dat') write (26, '(4a)') 'Lattice = ', "'", trim(lat%lattice), "'" write (26, '(4a)') 'Filename = ', "'", trim(lat%input_file_name), "'" write (26, '(a8,e12.4)') 'sigE_E = ', sigE_E write (26, '(a13,i5)') 'total # pc = ', pc%total_pc write (26, '(a)') 'Bunch # B_Param Worst_PC In Ele Nearest quad s' do k=1,nbuntot pretz%wt = max(pretz%wt ,wt_sum(k)) pretz%b_param = max(pretz%b_param ,B_sum(k)) i_near = nearest_quad(lat, pc%cross(worst_pc(k))%ix ) write (26, '(i4,a1,e10.3,a,i4,3a,f10.3)') k, ' ', B_sum(k), ' ', worst_pc(k),& ' ', lat%ele(pc%cross(worst_pc(k))%ix)%name, lat%ele(i_near)%name, & lat%ele(pc%cross(worst_pc(k))%ix)%s end do close(unit=26) pretz%wt = sqrt(2. * pretz%wt) !/ma pretz%x%arc_ape =0. pretz%y%arc_ape =0. pretz%x%ir_ape =0. pretz%y%ir_ape =0. pretz%max_disp = 0. do j=1,quad%n i=quad%lens(j)%ix aperture = abs((co(i)%vec(1)))+n_sigma * lat%ele(i)%a%sigma if(lat%ele(i)%type == 'ARC')then if(aperture > pretz%x%arc_ape)then pretz%x%arc_ape = aperture pretz%x%arc_ape_ix = i endif else if(aperture > pretz%x%ir_ape)then pretz%x%ir_ape = aperture pretz%x%ir_ape_ix = i endif endif pretz%max_disp = max(pretz%max_disp, abs(co(i)%vec(1))/sqrt(lat%ele(i)%a%beta)) max_x_disp = max(max_x_disp, abs(co(i)%vec(1))) end do pretz%efficiency = 0. if(pretz%max_disp /= 0.)pretz%efficiency = pretz%min_sep/pretz%max_disp if(delta_b_max /= 0.)pretz%b_efficiency = delta_b_min/delta_b_max if(pretz%y%dnu /= 0.)pretz%vert_efficiency = & sqrt( ((beta0/(2.*max_x_disp)**2) * const *0.001)/pretz%y%dnu ) return end subroutine pretzel function nearest_quad(lat, ix) implicit none type (lat_struct) lat integer nearest_quad integer ix, i, j, n i = ix j = 1 n = 0 do while(lat%ele(i)%key /= quadrupole$ .and. index(lat%ele(i)%name, 'IP') == 0) if(j > 0)n = n+1 j = -sign(n,j) i = ix+j if(i == 0 .or. i == lat%n_ele_track)then i = ix exit endif end do nearest_quad = i end function nearest_quad end module pretz_mod