!........................................................................ ! ! Subroutine : SUBROUTINE BUNCHCROSS(lat, con, pc) ! ! Description: ! ! Arguments : INPUT: ! LAT ! CON ! CON%N_TRAINS -- INTEGER: number of bunch trains ! CON%N_CARS -- INTEGER: number of cars per train ! CON%N_14NS_SPACE -- INTEGER: bunch separation in ! units of 14ns ! CON%ELECTRON_OFFSET -- INTEGER: Electron train delay in units of 14ns ! CON%FILE -- CHARACTER: file of occupied positron ! and electron buckets ! ! ! OUTPUT: ! PC ! PC%TOTAL_PC -- INTEGER: number of parasitic crossing ! points ! PC%CROSS(J).ELE.S -- REAL: distance from IP to J'th ! crossing point ! PC%BEAM_BEAM(n,j) -- LOGICAL: true if bunch n has ! parasitic interaction ! at j'th crossing point ! PC%POSBUNCH_ELEBUNCH(j,k,l) -- INTEGER: parasitic ! crossing where positron ! bunch j misses electron ! bunch k. l=1,2 ! ! Mod/Commons: ! ! Calls : ! ! Author : ! ! Modified : ! ! !........................................................................ ! SUBROUTINE BUNCHCROSS(lat, con, pc) use bmad use bunchcross_mod use constraints_mod implicit none integer ntrains,nbunches,nspace integer, parameter :: n_crossings_max=1000 real(rp) circumference type (pc_struct) pc type (lat_struct) lat type (constraint_struct) con real(rp) d(1:n_crossings_max,1:n_crossings_max,1:2), p(0:n_crossings_max) real(rp) s !2ns * c real(rp) half_circumference integer i,j,k,n_p,n_e,m_p,m_e,n integer PosEle(1281,1281,2) integer ncross integer l integer gap integer index(1:n_crossings_max) integer m integer PositronBuckets(1281), ElectronBuckets(1281) integer nposBunch, neleBunch integer ElectronOffset integer ios integer readstatus integer jlast, nposCars integer lun integer nBuckets logical PosBuckets(1281), EleBuckets(1281) logical Pos_BeamBeam(1281,n_crossings_max), Ele_BeamBeam(1281,n_crossings_max) logical new_train character*20 filename namelist / bunchpattern / PositronBuckets, ElectronBuckets, nBuckets nBuckets = 183 !default circumference = lat%param%total_length half_circumference = 0.5*circumference s=0. ntrains = con%n_trains nbunches = con%n_cars nspace = con%n_14ns_space ElectronOffset = con%electron_offset if(ElectronOffset > 19) then print '(1x,a30,i3,a19)',' BUNCHCROSS: ElectronOffset = ',ElectronOffset,' is greater than 19' stop endif PositronBuckets(1:1281)=0 ElectronBuckets(1:1281)=0 nposBunch = 0 neleBunch = 0 PosBuckets(1:1281)=.false. EleBuckets(1:1281)=.false. print *, con%BunchPattern, 'Subroutine bunchcross' if(con%BunchPattern(1:4) == 'NULL')then do i = 1,ntrains gap = ((i-1)*183)/9 !true for 9 bunches in 20 20 21 20 20 21 20 20 21 pattern do j = 1,nbunches EleBuckets(1+(j-1)*nspace + gap + ElectronOffset) = .true. PosBuckets(1+(j-1)*nspace + gap) = .true. nposBunch = nposBunch + 1 PositronBuckets(nposBunch) = 1+(j-1)*nspace + gap neleBunch = neleBunch + 1 ElectronBuckets(neleBunch) = 1+(j-1)*nspace + gap + ElectronOffset end do end do else lun=lunget() filename = trim(con%BunchPattern) print *,' filename = ',filename open (unit=lun, file=filename, status= 'old', iostat = ios) read(lun,nml= bunchpattern, iostat=readstatus) write(6,nml=bunchpattern) if(readstatus > 0) then print *," CAN NOT READ BUNCH PATTERN FROM ", con%BunchPattern,' Subroutine bunchcross' stop endif close(unit=lun) s = circumference/nBuckets jlast = 0 nposCars = 0 new_train = .true. do j = 1,nBuckets if(PositronBuckets(j) /= 0)then PosBuckets(PositronBuckets(j))=.true. nposBunch = nposBunch+1 if((PositronBuckets(j)-jlast <= 2 .and. new_train) .or. nposCars == 0)then nposCars = nposCars + 1 jlast = PositronBuckets(j) new_train = .true. else new_train = .false. endif endif if(ElectronBuckets(j) /= 0)then EleBuckets(ElectronBuckets(j))=.true. neleBunch = neleBunch + 1 endif end do if(mod(nposBunch, nposCars) == 0)then con%n_cars=nposCars con%n_trains = nposBunch/nposCars else con%n_cars = 1 con%n_trains = nposBunch endif endif ! WRITE(FMT,*) N+1 ! WRITE(6,"(I" // ADJUSTL(FMT) // ")") INT1 ! write(fmt,*) do j= 1, nposBunch/20 + 1 if(PositronBuckets(1+(j-1)*20) /= 0)print '(1x,a18,20i5)',' Positron Buckets ',(PositronBuckets(i),i=1+(j-1)*20,20*j) end do do j= 1, neleBunch/20 + 1 if(ElectronBuckets(1+(j-1)*20) /= 0)print '(1x,a18,20i5)',' Electron Buckets ',(ElectronBuckets(i),i=1+(j-1)*20,20*j) end do print '(a14,i4,a14,i4,a14,i4)',' N_bunches = ', nposBunch,' N_trains = ', con%n_trains, ' N_cars = ',con%n_cars m_p = 0 do n_p = 1, nBuckets if(.not. PosBuckets(n_p))cycle m_p = m_p + 1 m_e = 0 do n_e = 1, nBuckets if(.not. EleBuckets(n_e))cycle m_e = m_e + 1 d(m_p,m_e,1) = 0.75 * circumference + 0.5*(n_e-n_p)*s -0.25* circumference d(m_p,m_e,2) = 0.75 * circumference + 0.5*(n_e-n_p)*s +0.25* circumference if(d(m_p,m_e,1) >= circumference) d(m_p,m_e,1) = d(m_p,m_e,1) - circumference if(d(m_p,m_e,2) >= circumference) d(m_p,m_e,2) = d(m_p,m_e,2) - circumference end do end do n=0 p(0) = -1. do i = 1,m_p do j = 1, m_e do k = 1,2 n = n +1 Pos_BeamBeam(i,n) = .true. Ele_BeamBeam(j,n) = .true. p(n) = d(i,j,k) PosEle(i,j,k) = n m = n - 1 if(n >1 )then do l =1, m ! eliminate duplicates if(abs(p(l) - p(m+1)) < 0.0001)then Pos_BeamBeam(i,l) = .true. Ele_BeamBeam(j,l) = .true. PosEle(i,j,k) = l n = m endif end do endif end do end do end do ncross = n ! do i =1,9 ! print '(1x,a30,2i,f))',' i,PosEle(i,2,1)',i,PosEle(i,2,1), d(i,2,1) ! end do call sort_pc(p(1:ncross), index(1:ncross), ncross) do n = 1,ncross do i = 1,m_p pc%Pos_Beam_Beam(i,index(n)) = Pos_BeamBeam(i,n) pc%Beam_Beam(i,index(n)) = Pos_BeamBeam(i,n) end do do i = 1,m_e pc%Ele_Beam_Beam(i,index(n)) = Ele_BeamBeam(i,n) end do end do do i = 1,m_p do j = 1,m_e do k =1,2 pc%posbunch_elebunch(i,j,k) = index(PosEle(i,j,k)) end do end do end do pc%total_pc = ncross do i =1,ncross pc%cross(i)%ele%s = p(i) end do write(11,*)' Positron buckets ' do n =1,nBuckets if(PosBuckets(n))write(11, '(1x,i6)')n if(EleBuckets(n))write(11, '(1x,i6)')n end do write(11, *)' crossing points ' do n=1, ncross write(11, '(1x,i6,f12.4)')n,p(n) end do write(11,*)' Positron bunch ',' Crossing point ' do i = 1,m_p do n = 1, ncross if(pc%Pos_Beam_Beam(i,n))write(11, '(1x,2i16)')i,n end do end do return end subroutine sort_pc(p, nfind, ncross) use bmad implicit none real(rp) p(1:ncross) real(rp) e(1:ncross) integer nfind(1:ncross), mfind(1:ncross) integer ncross, j, jj,kk, k integer n do j=1,ncross e(j)=p(j) mfind(j)=j end do do jj=1,ncross - 1 do kk=jj+1,ncross j=mfind(jj) k=mfind(kk) if(e(k)