anchor.diff:  !      WRITE(*,*) 'Fraction of absorped particles: ', 100.*fracab/Nhit
   !
   end subroutine collimate2
  -
  -!>
  -!! collimaterhic()
  -!! Collimation for RHIC
  -!<
  -subroutine collimaterhic(c_material, c_length, c_rotation,        &
  -     &     c_aperture, n_aperture,                                      &
  -     &     c_offset, c_tilt,                                            &
  -     &     x_in, xp_in, y_in,                                           &
  -     &     yp_in, p_in, s_in, np, enom,                                 &
  -     &     lhit_pos,lhit_turn,                                          &
  -     &     part_abs_pos_local, part_abs_turn_local,                     &
  -     &     impact, indiv, lint, onesided,                               &
  -     &     name)
  -!
  -!++  Based on routines by JBJ. Changed by RA 2001.
  -!
  -!++  - Deleted all HBOOK stuff.
  -!++  - Deleted optics routine and all parser routines.
  -!++  - Replaced RANMAR call by RANLUX call
  -!++  - Included RANLUX code from CERNLIB into source
  -!++  - Changed dimensions from CGen(100,nmat) to CGen(200,nmat)
  -!++  - Replaced FUNPRE with FUNLXP
  -!++  - Replaced FUNRAN with FUNLUX
  -!++  - Included all CERNLIB code into source: RANLUX, FUNLXP, FUNLUX,
  -!++                                         FUNPCT, FUNLZ, RADAPT,
  -!++                                           RGS56P
  -!++    with additional entries:             RLUXIN, RLUXUT, RLUXAT,
  -!++                                           RLUXGO
  -!++
  -!++  - Changed program so that Nev is total number of particles
  -!++    (scattered and not-scattered)
  -!++  - Added debug comments
  -!++  - Put real dp/dx
  -!
  -
  -  use crcoall
  -  use parpro
  -  use mod_ranlux
  -
  -  implicit none
  -
  -!
  -! BLOCK DBCOLLIM
  -! This block is common to collimaterhic and collimate2
  -! It is NOT compatible with block DBCOMMON, as some variable names overlap...
  -
  -
  -  logical onesided
  -! integer nprim,filel,mat,nev,j,nabs,nhit,np,icoll,nabs_tmp
  -  integer np
  -
  -  integer, allocatable :: lhit_pos(:) !(npart)
  -  integer, allocatable :: lhit_turn(:) !(npart)
  -  integer, allocatable :: part_abs_pos_local(:) !(npart)
  -  integer, allocatable :: part_abs_turn_local(:) !(npart)
  -  integer, allocatable :: name(:) !(npart)
  -!MAY2005
  -
  -  real(kind=fPrec), allocatable :: x_in(:) !(npart)
  -  real(kind=fPrec), allocatable :: xp_in(:) !(npart)
  -  real(kind=fPrec), allocatable :: y_in(:) !(npart)
  -  real(kind=fPrec), allocatable :: yp_in(:) !(npart)
  -  real(kind=fPrec), allocatable :: p_in(:) !(npart)
  -  real(kind=fPrec), allocatable :: s_in(:) !(npart)
  -  real(kind=fPrec), allocatable :: indiv(:) !(npart)
  -  real(kind=fPrec), allocatable :: lint(:) !(npart)
  -  real(kind=fPrec), allocatable :: impact(:) !(npart)
  -
  -  real(kind=fPrec) c_length    !length in m
  -  real(kind=fPrec) c_rotation  !rotation angle vs vertical in radian
  -  real(kind=fPrec) c_aperture  !aperture in m
  -  real(kind=fPrec) c_offset    !offset in m
  -  real(kind=fPrec) c_tilt(2)   !tilt in radian
  -  character(len=4) c_material  !material
  -
  -  real(kind=fPrec) enom
  -  real(kind=fPrec) n_aperture  !aperture in m for the vertical plane
  -  save
  -!=======================================================================
  -  write(lerr,"(a)") "COLL> ERROR collimateRHIC is no longer supported!"
  -  call prror
  -end subroutine collimaterhic
  -!
  -!-----GRD-----GRD-----GRD-----GRD-----GRD-----GRD-----GRD-----GRD-----GRD-----
  -!! END collimaterhic()
   
   !>
   !! ichoix(ma)
  
positive.code:      &                 onesided, flukaname, secondary, 1, nabs_type)
  #endif
        end if !if (n_slices.gt.one .and.
      end if !if(cdb_cNameUC(icoll)(1:4).eq.'COLM') then
    end if !if (found) then
  end subroutine collimate_do_collimator
  
  !>
  
negative.code:     rcp0(j)  = rcp(j)
      ejf0v(j) = ejfv(j)
  
      ! For zero length element track back half collimator length
      ! DRIFT PART
      if(stracki == 0) then
        if(iexact) then
          zpj=sqrt(one-rcxp(j)**2-rcyp(j)**2)
          rcx(j) = rcx(j) - (half*c_length)*(rcxp(j)/zpj)
          rcy(j) = rcy(j) - (half*c_length)*(rcyp(j)/zpj)
        else
          rcx(j) = rcx(j) - (half*c_length)*rcxp(j)
          rcy(j) = rcy(j) - (half*c_length)*rcyp(j)
        end if
      else
        write(lerr,"(a,f13.6)") "COLL> ERROR Non-zero length collimator '"//trim(cdb_cName(icoll))//"' with length = ",stracki
        call prror
      end if
  
  