!-----------------------------------------------------------------------
!  hvsigma -- set up table of rate coefficients for heavy neutral beam
!    this routine fills the transp common block
!      hvsigi
!    with rate coefficients for the ionization and stripping of a
!    heavy neutral or partially stripped ion:
!
!      hvsigi(j,iznew,isb)
!
!    gives the rate coefficient (1/sec) in flux zone j for promotion
!    from charge state iznew-1 to charge state iznew of a neutral or
!    ion of species isb, which is a heavy beam species (generally,
!    neon, argon, krypton, or xenon)
!
!  dmc dec 1991
!
!------------------------------
!   dmc 12 dec 1991 -- also compute coulomb log tables for
!   all heavy ion charge states
!      allame  allamx  allamh
!------------------------------
!
!    the cross sections are provided by the subroutine elossr, by
!  david mikkelsen.
!
!    simplifications --
!      (1)  only transitions involving the removal of
!  one electron at a time are considered
!      (2)  the heavy neutral lab frame injection energy is assumed as
!  the energy of the beam particle used as argument to elossr -- this
!  neglects the following:
!       * rotation effects *
!       * slowing down of heavy ion prior to full ionization *
!  the argument that this is sufficient is basically that the velocity
!  of the impurity ion is slow compared to the velocities of the light
!  particles in the plasma target, so that the heavy beam particle's
!  energy is not an important parameter for these atomic physics
!  considerations... probably ok if rotation is not too rapid.
!      (3)  fast ion populations are "maxwellianized" for purposes of
!  estimating their effect on ionization / stripping rates.
!
!    the namelist control nlhvion is used to select whether to include
!  the effects of target ions at all; if nlhvion=.false., only electron
!  collisions are assumed to affect the charge state of the heavy beam
!  particle
!
!------------------------
!
subroutine hvsigma(ier)
  !
  use nbi_com
  use physconst_mod, only: me_kg,mp_kg
 !
  !-----------------------------------------------------------------------
  !  local:  temperature, density, z, a, arguments for elossr:
  !
  !============
  implicit none
  integer :: ier,intarg,ig,isbi,isb,izmax,j,ii,iz,izproj
  !============
  real(fp) :: zeinj,zbz,elossr,zz
  !============
  real(fp), dimension(:), allocatable :: ztemp,zdens,zchrg,zamu,zallam
  real(fp), dimension(:), allocatable :: ztempc,zdensc  ! diff units for coulog routine
  !
  logical :: ilstix
  !
  data ilstix/.false./
  !
  !-----------------------------------------------------------------------
  !
  ier=0
  !
  if(nlhvion) then
     intarg=1+ng+1+nsbeam
  else
     intarg=1  ! electrons only
  end if
  !
  allocate(ztemp(intarg),zdens(intarg))
  allocate(zchrg(intarg),zamu(intarg),zallam(intarg))
  allocate(ztempc(intarg),zdensc(intarg))
  !
  !  electrons:
  zchrg(1)=-1.0_fp
  zamu(1)=me_kg/mp_kg
  !  thermal ions:
  do ig=1,ng
     zchrg(ig+2)=backz(ig)
     zamu(ig+2)=aplasm(ig)
  end do
  !  fast ions:
  do isbi=1,nsbeam
     zchrg(ng+2+isbi)=xzbeams(isbi)
     zamu(ng+2+isbi)=abeams(isbi)
  end do
  !
  !  loop over fast ion species; do table for heavy species only
  !
  do isb=1,nsbeam
     if(.not.nlheavy(isb)) cycle
     !
     zeinj=einjs(isb)
     !
     izmax=xzbeams(isb)+0.5_fp
     !
     do j=lcentr,ledge
        !  impurity ions:
        zchrg(2)=xzimpj(j)
        zamu(2)=aimpj(j)
        !
        !  b field, tesla, for coulomb log routine
        !
        zbz=bzxr*fbz(j,2)*grizc(j) ! approx b, tesla (bz close enuf)
        !
        !  target temperatures and densities
        !
        ztemp(1)=te(j,2)
        zdens(1)=rhoel(j,2)
        !
        ztemp(2)=ti(j,2)
        zdens(2)=rhi(j,2)
        !
        do ig=1,ng
           ztemp(ig+2)=ti(j,2)
           zdens(ig+2)=rhob(j,ig,2)
        end do
        !
        do isbi=1,nsbeam
           ztemp(ng+2+isbi)=0.6666667_fp*ebavps(j,isbi)
           zdens(ng+2+isbi)=rhbs(j,2,isbi)
           if(nlheavy(isbi)) zchrg(ng+2+isbi)=xzbmav(j,isbi)
        end do
        !
        do ii=1,intarg
           ztempc(ii)=ztemp(ii)/1000.0_fp
           zdensc(ii)=zdens(ii)*1.0e6_fp
        end do
        !
        !  fill the table -- loop over charge states
        !
        do iz=1,izmax
           !
           izproj=iz-1
           !
           hvsigi(j,iz,isb) = &
                elossr( zeinj, abeams(isb), izmax, izproj, &
                intarg, zdens, ztemp, zamu, zchrg,  ier )
           !
           if(ier.ne.0) then
              write(nonlin,*) ' ?hvsigma -- elossr error.'
              return
           end if
           !
           !  evaluate the coulomb log tables also
           !
           zz=real(iz)
           call r8_coulog(zeinj/1000.0_fp, abeams(isb), zz, &
                zdensc, ztempc, zamu, zchrg, zallam, ng+2, zbz, ilstix)
           !
           !  store coulomb log results
           !
           allame(j,iz,isb) = zallam(1)
           allamx(j,iz,isb) = zallam(2)
           do ig=1,ng
              allamh(ig,j,iz,isb) = zallam(2+ig)

           end do
           !

        end do
        !

     end do
     !
  end do
  !
  return
end subroutine hvsigma
! 11sep2004 fgtok
