subroutine beam_info_out(ierr)

  !  pass to black box information on beams power and directions 
  ! of the beam ptcl. injection (co or counter)

  !  the caller (outptb2) 


  use nbi_com
  use xplasma_obj_instance
  implicit none

  !-------------------------------------
  ! passed:

  integer, intent(out) :: ierr

  !-------------------------------------
  ! local:

  character*32 zobj_name
  character*32 zauth
  character*60 zlabel
  integer :: ido,iertmp

  integer :: isize,r8size,ii

  integer ::iadr_nlco, iadr_pinja,iadr_xbzeta,iadr_xlbapa,iadr_xlbtna
  integer ::iadr_rtcena

  integer, parameter :: ihdr = 40
  integer, parameter :: ibbtype = 850
  integer, dimension(:),allocatable :: inlco !convert logical nlco to integer


  !----------------------------------------
  !  pointers provided by xplasma:

  integer, dimension(:), pointer :: idata
  real(fp), dimension(:), pointer :: r8data
  !----------------------------------------
  !
  !  start of executable code...
  !

  ierr = 0


  zauth = 'beam_info_nubeam'
  zobj_name = 'beam_info'
  zlabel = 'beam info data'

  call xplasma_blkbxid(s,zobj_name,ido)
  if(ido.gt.0) then

     call xplasma_author_set(s,zauth,iertmp)
     call xplasma_remove_item(s,ido,ierr)
     call xplasma_author_clear(s,zauth,iertmp)

  endif
  if(ierr.ne.0) then
     write(nonlin,*) &
          ' ?beam_info_out: unexpected error removing old beam info object:'
     write(nonlin,*) '  object name: '//trim(zobj_name)
     call xplasma_error(s,ierr,nonlin)
     return
  endif

  !-------------------
  !  object removed.  if there is no deposition source, we are done.

  if(nbeam.eq.0) return


  !-------------------
  !  data sizes & addresses

  isize = ihdr + 1
  

  iadr_nlco = 1  
  iadr_pinja = iadr_nlco + nbeam
  iadr_xbzeta = iadr_pinja + nbeam
  iadr_xlbapa = iadr_xbzeta + nbeam
  iadr_xlbtna = iadr_xlbapa + nbeam
  iadr_rtcena = iadr_xlbtna + nbeam



  r8size = iadr_rtcena + nbeam - 1
  !------------------------
  !  create black box object

  call xplasma_author_set(s,zauth,iertmp)

  call xplasma_create_blackbox(s,zobj_name,ibbtype,ido,ierr, &
       iasize=isize, r8asize=r8size, label=' ', &
       ia_ptr=idata, r8a_ptr=r8data)

  call xplasma_author_clear(s,zauth,iertmp)

  if(ierr.ne.0) then
     write(nonlin,*) &
          ' ?bean_info_out: unexpected error creating beam info object:'
     write(nonlin,*) '  object name: '//trim(zobj_name)
     call xplasma_error(s,ierr,nonlin)
     return
  endif

  !------------------------
  !  load integer data

  idata(1:ihdr)=0  ! includes spares

  idata(1)=ihdr
  idata(2)=nbeam
  idata(9)=nsjdotb
  idata(10)=nsnccw
  !  floating point data addresses

  idata(3)=iadr_nlco;    iadr_nlco = iadr_nlco - 1
  idata(4)=iadr_pinja;    iadr_pinja = iadr_pinja - 1
  idata(5)=iadr_xbzeta;    iadr_xbzeta = iadr_xbzeta - 1
  idata(6)=iadr_xlbapa;    iadr_xlbapa = iadr_xlbapa - 1
  idata(7)=iadr_xlbtna;    iadr_xlbtna = iadr_xlbtna - 1
  idata(8)=iadr_rtcena;    iadr_rtcena = iadr_rtcena - 1


  !-------------------
  !  floating point data
  if(allocated(inlco)) deallocate(inlco)
  allocate(inlco(nbeam))
  call nbi_log2int(nlco,inlco,nbeam)
  
  do ii=1,nbeam
     iadr_nlco = iadr_nlco + 1; r8data(iadr_nlco) = real(inlco(ii)) !real*8
     iadr_pinja = iadr_pinja + 1; r8data(iadr_pinja) = pinja(ii) !watts
     iadr_xbzeta = iadr_xbzeta + 1; r8data(iadr_xbzeta) = xbzeta(ii) !deg
     iadr_xlbapa = iadr_xlbapa + 1; r8data(iadr_xlbapa) = xlbapa(ii) !cm
     iadr_xlbtna = iadr_xlbtna + 1; r8data(iadr_xlbtna) = xlbtna(ii) !cm
     iadr_rtcena = iadr_rtcena + 1; r8data(iadr_rtcena) = rtcena(ii) !cm
  enddo

  !-------------------
  !  all done...

  nullify(idata)  ! data has been given over to xplasma 
  nullify(r8data) ! data has been given over to xplasma 

end subroutine beam_info_out
