program injbump

   use bmad
   use cesr_basic_mod
 
     implicit none

      type (lat_struct) lat
      type (cesr_struct) cesr
      type (ele_struct) ele 

      integer ix_26, ix_28, ix_36, nargs
      integer n_save
      integer ix_cache
      integer iu,iu1
      integer ix
 
      character*60 lat_file
      character*120 line, last_line
      character*40 current_lat, lattice

      real(rp) k26,k28,k36
      real(rp) x26_36,   xp26_36,   x28_36,   xp28_36

      call mpm_init("BMAD")
      call getlat (current_lat) 
      call choose_cesr_lattice (lattice, lat_file, current_lat, lat)

      nargs = cesr_iargc()
      if(nargs == 1)then
         call cesr_getarg(1,lat_file)
         print *, 'Using ', trim(lat_file)
       else
      lat_file = 'bmad.'
      type '(a,$)',' Lattice file name ? (default= bmad.) '
      read(5,'(a)') line
       call string_trim(line, line, ix)
       lat_file = line
       if(ix == 0) lat_file = 'bmad.'
       type *, ' lat_file = ', lat_file
      endif

       call bmad_parser (lat_file, lat)

      do while(line(1:1) /= 'G')

10    print '(a, $)', '  element change or GO> '
      read(5, '(a)',err=10) line
     
  ix = index(line, '!')
  if (ix /= 0) line = line(:ix-1)        ! strip off comments

  call str_upcase(line, line)
  call string_trim(line, line, ix)

  if (ix == 0) then       ! nothing typed. do the same thing
      line = last_line
  endif

   last_line = line

   call str_upcase(line,line)
   if(line(1:1) /= 'G')call find_change( line, lat)
   end do


  call twiss_at_start(lat)
  call twiss_propagate_all(lat)

  call element_locator('bump_26w',lat,ix_26)
  call element_locator('bump_28w',lat,ix_28)
  call element_locator('bump_36w',lat,ix_36)

! x from 26 at 36 is
   x26_36 = sqrt(lat%ele(ix_26)%a%beta * lat%ele(ix_36)%a%beta) * &
          sin( lat%ele(ix_36)%a%phi - lat%ele(ix_26)%a%phi)
   xp26_36 = sqrt(lat%ele(ix_26)%a%beta / lat%ele(ix_36)%a%beta) * &
          cos( lat%ele(ix_36)%a%phi - lat%ele(ix_26)%a%phi)
! x from 28 cancels x from 26
   x28_36 = sqrt(lat%ele(ix_28)%a%beta * lat%ele(ix_36)%a%beta) * &
          sin( lat%ele(ix_36)%a%phi - lat%ele(ix_28)%a%phi)
   k28 = -x26_36/x28_36
! xp from 36 cancels xp from 26 and 28
   xp28_36 = k28*sqrt(lat%ele(ix_28)%a%beta / lat%ele(ix_36)%a%beta) * &
          cos( lat%ele(ix_36)%a%phi - lat%ele(ix_28)%a%phi)
   k36 = -(xp26_36 + xp28_36)   
   k26=1.

  print *
  print '(/,a13,3a12)','Bumper','Beta x','Phase x','kick'
  print '(a13,3f12.4)',' Bumper 26 W',lat%ele(ix_26)%a%beta, lat%ele(ix_26)%a%phi, k26
  print '(a13,3f12.4)',' Bumper 28 W',lat%ele(ix_28)%a%beta, lat%ele(ix_28)%a%phi, k28
  print '(a13,3f12.4)',' Bumper 36 W',lat%ele(ix_36)%a%beta, lat%ele(ix_36)%a%phi, k36


  call element_locator('bump_26e',lat,ix_26)
  call element_locator('bump_28e',lat,ix_28)
  call element_locator('bump_36e',lat,ix_36)

! x from 26 at 36 is
   x26_36 = sqrt(lat%ele(ix_26)%a%beta * lat%ele(ix_36)%a%beta) * &
          sin( lat%ele(ix_36)%a%phi - lat%ele(ix_26)%a%phi)
   xp26_36 = sqrt(lat%ele(ix_26)%a%beta / lat%ele(ix_36)%a%beta) * &
          cos( lat%ele(ix_36)%a%phi - lat%ele(ix_26)%a%phi)
! x from 28 cancels x from 26
   x28_36 = sqrt(lat%ele(ix_28)%a%beta * lat%ele(ix_36)%a%beta) * &
          sin( lat%ele(ix_36)%a%phi - lat%ele(ix_28)%a%phi)
   k28 = -x26_36/x28_36
! xp from 36 cancels xp from 26 and 28
   xp28_36 = k28*sqrt(lat%ele(ix_28)%a%beta / lat%ele(ix_36)%a%beta) * &
          cos( lat%ele(ix_36)%a%phi - lat%ele(ix_28)%a%phi)
   k36 = -(xp26_36 + xp28_36)   
   k26=1.

  print *
  print '(a13,3f12.4)',' Bumper 26 E',lat%ele(ix_26)%a%beta, lat%ele(ix_26)%a%phi, k26
  print '(a13,3f12.4)',' Bumper 28 E',lat%ele(ix_28)%a%beta, lat%ele(ix_28)%a%phi, k28
  print '(a13,3f12.4)',' Bumper 36 E',lat%ele(ix_36)%a%beta, lat%ele(ix_36)%a%phi, k36

  print '(/,a)',' Note the relative polarity of each bumper kick' 
  print '(a)',' Check traces on D-scope' 
  print '(a)',' Add lattice name to "$CESR_ONLINE/machine_data/save/route/bump_pol.dat"'
  print '(a)',' "CHESS pretzel optics" polarities for (B26/B28/B36) are (+/-/-)' 
  print '(a)',' High tune and all CesrTA optics with E<3GeV have polarities (B26/B28/B36) are (+/+/-)' 

  end