subroutine set_quad_params(lat,nbranch) use bmad use muon_mod use parameters_bmad use muon_interface implicit none type (lat_struct), target::lat type (branch_struct), pointer:: branch ! ring integer i integer nbranch integer ix_quad logical verbose logical test_a_quad/.true./, first/.true./ branch =>lat%branch(nbranch) if(first)then lun_quad_params=lunget() open(unit=lun_quad_params, file = trim(directory)//'/quad_parameters.dat') allocate(ele_ref(1:branch%n_ele_max)) first = .false. endif write(lun_quad_params,'(a)')' Set Quad Parameters' do i=1,4 if(quad_params%short_quad_field_index(i) <= -99.)quad_params%short_quad_field_index(i) = quad_params%long_quad_field_index(i) end do do i=1,branch%n_ele_max if (index(branch%ele(i)%name,'QUAD')/=0) then ! Set the quad field indices verbose=.true. call set_a_quad(branch%ele(i), verbose) ele_ref(i) = branch%ele(i) print '(a,1x,i10,1x,a)', 'ele_ref = ',i,ele_ref(i)%name if(test_a_quad)then ix_quad = i call test_quad(lat,nbranch, ix_quad) test_a_quad = .false. endif endif end do return end !****************************** subroutine set_a_quad(ele, verbose) use bmad use muon_mod use parameters_bmad implicit none type (ele_struct), pointer :: lord_ele, ele2 type (ele_struct), target :: ele logical verbose, err ele2=>ele if(ele%slave_status == super_slave$ .or. ele%slave_status == slice_slave$)ele2 => pointer_to_lord(ele,1) if(quad_params%long_quad_plate_index(1)%inner == 0.) then ! set all plates equal quad_params%long_quad_plate_index(1:4)%inner = quad_params%long_quad_field_index(1:4) quad_params%long_quad_plate_index(1:4)%bottom = quad_params%long_quad_field_index(1:4) quad_params%long_quad_plate_index(1:4)%outer = quad_params%long_quad_field_index(1:4) quad_params%long_quad_plate_index(1:4)%top = quad_params%long_quad_field_index(1:4) endif if(quad_params%short_quad_plate_index(1)%inner ==0.)then quad_params%short_quad_plate_index(1:4)%inner = quad_params%short_quad_field_index(1:4) quad_params%short_quad_plate_index(1:4)%bottom = quad_params%short_quad_field_index(1:4) quad_params%short_quad_plate_index(1:4)%outer = quad_params%short_quad_field_index(1:4) quad_params%short_quad_plate_index(1:4)%top = quad_params%short_quad_field_index(1:4) endif if (index(ele2%name,'QUAD1_LONG')/=0)then call set_ele_real_attribute (ele2, 'FIELD_INDEX', quad_params%long_quad_field_index(1), err) call set_quad_es_multipoles(quad_params%long_quad_field_index(1), ele2) call set_quad_fieldmap_grid(quad_params%long_quad_plate_index(1), ele2, verbose) elseif (index(ele2%name,'QUAD1_SHORT')/=0)then call set_ele_real_attribute (ele2, 'FIELD_INDEX', quad_params%short_quad_field_index(1) , err) call set_quad_es_multipoles(quad_params%short_quad_field_index(1), ele2) call set_quad_fieldmap_grid(quad_params%short_quad_plate_index(1), ele2, verbose) elseif (index(ele2%name,'QUAD2_LONG')/=0)then call set_ele_real_attribute (ele2, 'FIELD_INDEX', quad_params%long_quad_field_index(2), err) call set_quad_es_multipoles(quad_params%long_quad_field_index(2), ele2) call set_quad_fieldmap_grid(quad_params%long_quad_plate_index(2), ele2, verbose) elseif (index(ele2%name,'QUAD2_SHORT')/=0)then call set_ele_real_attribute (ele2, 'FIELD_INDEX', quad_params%short_quad_field_index(2) , err) call set_quad_es_multipoles(quad_params%short_quad_field_index(2), ele2) call set_quad_fieldmap_grid(quad_params%short_quad_plate_index(2), ele2,verbose) elseif (index(ele2%name,'QUAD3_LONG')/=0)then call set_ele_real_attribute (ele2, 'FIELD_INDEX', quad_params%long_quad_field_index(3), err) call set_quad_es_multipoles(quad_params%long_quad_field_index(3), ele2) call set_quad_fieldmap_grid(quad_params%long_quad_plate_index(3), ele2,verbose) elseif (index(ele2%name,'QUAD3_SHORT')/=0)then call set_ele_real_attribute (ele2, 'FIELD_INDEX', quad_params%short_quad_field_index(3) , err) call set_quad_es_multipoles(quad_params%short_quad_field_index(3), ele2) call set_quad_fieldmap_grid(quad_params%short_quad_plate_index(3), ele2, verbose) elseif (index(ele2%name,'QUAD4_LONG')/=0)then call set_ele_real_attribute (ele2, 'FIELD_INDEX', quad_params%long_quad_field_index(4), err) call set_quad_es_multipoles(quad_params%long_quad_field_index(4), ele2) call set_quad_fieldmap_grid(quad_params%long_quad_plate_index(4), ele2, verbose) elseif (index(ele2%name,'QUAD4_SHORT')/=0)then call set_ele_real_attribute (ele2, 'FIELD_INDEX', quad_params%short_quad_field_index(4) , err) call set_quad_es_multipoles(quad_params%short_quad_field_index(4), ele2) call set_quad_fieldmap_grid(quad_params%short_quad_plate_index(4), ele2, verbose) elseif (index(ele2%name,'QUAD_CONTINUOUS')/=0)then call set_ele_real_attribute (ele2, 'FIELD_INDEX', quad_params%short_quad_field_index(1) , err) call set_quad_es_multipoles(quad_params%short_quad_field_index(1), ele2) call set_quad_fieldmap_grid(quad_params%short_quad_plate_index(1), ele2, verbose) endif ! print '(a,2es12.4)',branch%ele(i)%name, value_of_attribute(branch%ele(i), 'FIELD_INDEX') , branch%ele(i)%s ! endif return end subroutine set_quad_es_multipoles(field_index,ele) use bmad use parameters_bmad implicit none type(ele_struct) ele type(ele_struct), save :: ele_0 real(rp) field_index, r0 integer i,n logical first/.true./ !if(.not. allocated(QMC)) call initializeQuadMultipoleCoeffs(QMC) if(.not. associated(ele%b_pole_elec))return if(.not. associated(ele%a_pole_elec))return if(first)then ! ele_0%b_pole_elec(:) = ele%b_pole_elec(:) ! ele_0%a_pole_elec(:) = ele%a_pole_elec(:) ele_0 = ele first = .false. endif r0 = ele%value(r0_elec$) n=size(qmc(0,1,:)) !do i=0, min(n_pole_maxx,size(QMC(0,1,:))-1) ! ele%b_pole_elec(i) = (i+1)/r0 * QMC(0,1,i+1) * field_index/0.141 ! ele%a_pole_elec(i) = (i+1)/r0 * QMC(0,2,i+1) * field_index/0.141 !end do write(lun_quad_params,'(2a)')'Element ',ele%name write(lun_quad_params,'(a10,1x,2a12)')'multipole','b_pole','a_pole' do i=0, n_pole_maxx ele%b_pole_elec(i) = ele_0%b_pole_elec(i) * field_index/0.141 ele%a_pole_elec(i) = ele_0%a_pole_elec(i) * field_index/0.141 write(lun_quad_params,'(i10,1x,2es12.4)')i,ele%b_pole_elec(i), ele%a_pole_elec(i) end do return end subroutine subroutine set_quad_fieldmap_grid(plate_index,ele, verbose) use bmad use parameters_bmad use quad_scrape_parameters type(ele_struct) ele type(quad_plate_struct) plate_index real(rp) field_index, KV32/3.44086/ integer ngrids integer i logical verbose !field_index = 0.185 corresponds to quad voltage 32kV ! print '(a,a,1x,4es12.4)','set_quad_params',ele%name,ele%grid_field(3:6)%field_scale if(.not. associated(ele%grid_field))return write(lun_quad_params,'(2a)')'Element ', ele%name ngrids = size(ele%grid_field) if(ngrids == 6) then if(verbose) print '(a,1x,i2,1x,a,a,a)','There are', ngrids,' for quad ',ele%name,' 6 are required for scraping (4 plates + 2 (vertical and radial dipole))' write(lun_quad_params, '(a,1x,i2,1x,a,a)')'There are', ngrids,' for quad ',ele%name ! stop ! ele%grid_field(3:6)%field_scale = KV32/0.185 * field_index ele%grid_field(3)%field_scale = 100./0.157 * plate_index%inner ele%grid_field(4)%field_scale = 100./0.157 * plate_index%bottom ele%grid_field(5)%field_scale = 100./0.157 * plate_index%outer ele%grid_field(6)%field_scale = 100./0.157 * plate_index%top if(verbose) print '(a,a,1x,6es12.4)','set_quad_params',ele%name,ele%grid_field(1:ngrids)%field_scale write(lun_quad_params, '(a,a,1x,6es12.4)')'set_quad_params',ele%name,ele%grid_field(1:ngrids)%field_scale endif if(ngrids == 3)then if(verbose) print '(a,1x,i2,1x,a,a,a)',' There are', ngrids,' grids for quad ',ele%name,' (1 quad + 2 (vertical and radial dipole))' write(lun_quad_params, '(a,1x,i2,1x,a,a,a)')' There are', ngrids,' grids for quad ',ele%name,' (1 quad + 2 (vertical and radial dipole))' ele%grid_field(3)%field_scale = 100./0.157 * plate_index%inner ! Field map is computed for 27.2 kV if(verbose)print '(a,a,1x,6es12.4)','set_quad_params',ele%name,ele%grid_field(1:ngrids)%field_scale write(lun_quad_params, '(a,a,1x,6es12.4)') 'set_quad_params',ele%name,ele%grid_field(1:ngrids)%field_scale endif return end subroutine subroutine set_dipole_params(lat,nbranch, deltaB_onB) use bmad use parameters_bmad type (lat_struct), target::lat type (branch_struct), pointer:: branch ! ring type(ele_struct) ele type (ele_struct), pointer :: lord integer ngrids integer i integer j integer nbranch integer jj logical verbose/.true./ logical first/.true./ logical first_grid_field/.true./ logical err logical, allocatable, save :: associated_grid(:) real(rp), allocatable, save :: field_scale(:), field_scale_radial(:) real(rp), allocatable, save :: field_scale_lord(:,:), field_scale_radial_lord(:,:) real(rp) DeltaB_onB, Delta_B !fractional field offset branch =>lat%branch(nbranch) if(first)then allocate(field_scale(1:branch%n_ele_track)) allocate(field_scale_radial(1:branch%n_ele_track)) allocate(field_scale_lord(1:10,1:branch%n_ele_track)) allocate(field_scale_radial_lord(1:10,1:branch%n_ele_track)) allocate(associated_grid(1:branch%n_ele_track)) associated_grid(:)=.false. first = .false. endif if(first_grid_field) then do j=1,branch%n_ele_track ele = branch%ele(j) if(associated(ele%grid_field))then associated_grid(j) = .true. field_scale(j) = ele%grid_field(1)%field_scale field_scale_radial(j) = ele%grid_field(2)%field_scale else if(ele%field_calc == refer_to_lords$)then do jj = 1,ele%n_lord lord => pointer_to_lord(ele,jj) if(associated(lord%grid_field))then field_scale_lord(jj,j) = lord%grid_field(1)%field_scale field_scale_radial_lord(jj,j) = lord%grid_field(2)%field_scale associated_grid(j) = .true. endif end do endif endif end do first_grid_field=.false. endif do i=1,branch%n_ele_track ele = branch%ele(i) if(associated_grid(i))then if(ele%field_calc /= refer_to_lords$)then ele%grid_field(1)%field_scale = field_scale(i) * (1 +DeltaB_onB) ele%grid_field(2)%field_scale = B_radial if(verbose)print '(a,a,1x,4es12.4)','set_dipole_params ',ele%name,ele%grid_field(1:2)%field_scale print '(a,a,1x,4es12.4)','set_dipole_params ',ele%name,ele%grid_field(1:2)%field_scale print '(a,1x,i10,1x,2es12.4)','set_dipole_params ',i,field_scale(i), field_scale_radial(i) print '(a,es12.4)', ele%name,ele%grid_field(1)%field_scale else do jj=1,ele%n_lord lord => pointer_to_lord(ele,jj) lord%grid_field(1)%field_scale = field_scale_lord(jj,i) * (1+DeltaB_onB) lord%grid_field(2)%field_scale = B_radial if(verbose)print '(a,a,1x,4es12.4)','set_dipole_params ',lord%name,lord%grid_field(1:2)%field_scale print '(a,a,1x,4es12.4)','set_dipole_params ',lord%name,lord%grid_field(1:2)%field_scale print '(a,1x,i10,1x,2es12.4)','set_dipole_params ',i,field_scale_lord(jj,i), field_scale_radial_lord(jj,i) print '(a,es12.4)', lord%name,lord%grid_field(1)%field_scale end do endif else !not associated print '(a16,a)',ele%name,' does not have an associated grid_field and cannot be scaled for ramp' ! Take care of the main dipole part of the kicker field. ! if(index(ele%name,'KICKER')/=0 .or. ele%name,'GAP')/=0)then Delta_B = DeltaB_onB * ele%value(B_field$) if(ele%field_calc == refer_to_lords$)then do j=1,ele%n_lord lord => pointer_to_lord(ele,j) call set_ele_real_attribute (lord, 'DB_FIELD',Delta_B, err) print '(a,es12.4)',lord%name, lord%value(db_field$) end do else call set_ele_real_attribute (ele, 'DB_FIELD', Delta_B, err) print '(a,3es12.4)',ele%name, ele%value(db_field$), ele%value(b_field$) endif endif !if else associated\ branch%ele(i) = ele if(index(ele%name,'FREE')/=0 )then !any element that has dipole field but no quad or kicker or other write(lun_quad_params,'(/,a,a)')'Element ', ele%name if( associated_grid(i))then ngrids = size(ele%grid_field) if(ngrids /= 2) then if(verbose) print '(a,1x,i2,1x,a,a,a)','Set_dipole_params: We have a problem in that there are', ngrids,' for free element ',ele%name,' and there should be 1' stop endif if(associated(ele%grid_field) .and. abs(ele%grid_field(2)%field_scale - B_radial)>1.e-9) then if(verbose)print '(a,1x,es12.4,1x,a,1x,es12.4)','Inconsistent radial field: B_radial = ', B_radial,' ele%grid_field(2) = ', ele%grid_field(2)%field_scale stop write(lun_quad_params, '(a,a,1x,4es12.4)')'set_dipole_params ',ele%name,ele%grid_field(1:2)%field_scale endif if(ele%field_calc == refer_to_lords$)lord => pointer_to_lord(ele,1) if(associated(lord%grid_field) .and. abs(lord%grid_field(2)%field_scale - B_radial)>1.e-9) then if(verbose)print '(a,1x,es12.4,1x,a,1x,es12.4)','Inconsistent radial field: B_radial = ', B_radial,' ele%grid_field(2) = ', ele%grid_field(2)%field_scale stop write(lun_quad_params, '(a,a,1x,4es12.4)')'set_dipole_params ',lord%name,lord%grid_field(1:2)%field_scale endif endif ! associated endif ! dipole field but not a quad or kicker end do !loop over elements return end subroutine