!  routines to fetch lost orbit data
!
!  beam_info_r8get1 -- get 1d real*8 vector
!
!  code here should be precisely consistent with that in beam_info_out.f90


subroutine beam_info_r8get1(suffix,item,zcnvrt,indep,r8nums,ierr)

  !  get 1d real*8 vector (1 number per deposition neutral track).

  ! look for xplasma data on beam_info
  ! this routine does not depend on nbi_com -- just xplasma.  so, it can be
  ! called safely by a client code, when the nubeam calculation is performed
  ! as a remote service.
  use iso_c_binding, only: fp => c_double
  use nbi_com, only: nonlin
  use xplasma_obj_instance
  implicit none

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

  ! name of deposition dataset (xplasma black box name):
  character*(*), intent(in) :: suffix ! full name is "beam_info_"//trim(suffix)

  character*(*), intent(in) :: item  ! name of item within dataset
  real(fp), intent(in) :: zcnvrt       ! units convertor (multiplicative factor)
  integer, intent(in) :: indep       ! number of tracks
  real(fp), intent(out) :: r8nums(indep) ! data returned, 1 number per track
  integer, intent(out) :: ierr       ! status code on exit, 0=normal

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

  integer, dimension(:), pointer :: idata
  real(fp), dimension(:), pointer :: r8data
  integer :: id
  character*16 item_name
  character*32 zobj_name
  integer :: iadr,inchk
  !-------------------------------------

  r8nums = 0.0_fp
  ierr = 0

  zobj_name = 'beam_info' ! name of xplasma black box
                          ! containing deposition data, if any exists

  call xplasma_blkbxid(s,zobj_name,id)

  if(id.eq.0) then
     ierr = 1
     write(nonlin,*) ' %beam_info_get: beam_info object "',trim(zobj_name), &
          '" not found.'
     return
  endif

  !-------------------------
  ! data exists

  call xplasma_blackbox_retrieve(s,id,ierr, ia_ptr=idata, r8a_ptr=r8data)
  if(ierr.ne.0) then
     write(nonlin,*) ' ?beam_info_get: unexpected error, blackbox "', &
          trim(zobj_name),'":'
     call xplasma_error(s,ierr,nonlin)
     return
  endif

  inchk = idata(2)

  if(inchk.ne.indep) then
     write(nonlin,*) &
          ' ?beam_info_get: #beam_info in data does not match #beams:'
     write(nonlin,*) '            in the data: ',inchk
     write(nonlin,*) '   passed to beam_info_get: ',indep
     ierr = 2
     return
  endif

  item_name = item
  call uupper(item_name)  ! force uppercase

  if(item_name.eq."NLCO") then
     iadr = idata(3) - 1   ! beam direction

  else if(item_name.eq."PINJA") then
     iadr = idata(4) - 1   ! beam power injected (watts*sec)

  else if(item_name.eq."XBZETA") then
     iadr = idata(5) - 1   ! toroidal angle of beam source in an (r,zeta,z), deg

  else if(item_name.eq."XLBAPA") then
     iadr = idata(6) - 1   ! distance, beam source grid to aperture, cm

  else if(item_name.eq."XLBTNA") then
     iadr = idata(7) - 1   ! distance, beam source grid to tangency point, cm

  else if(item_name.eq."RTCENA") then
     iadr = idata(8) - 1   ! tangency major radius, cm, of centerline of beam

  else
     write(nonlin,*) &
          ' ?beam_info_get: unrecognized item name: "',trim(item),'".'
     ierr=3
     return
  endif

  !  ok transfer the data:

  r8nums = r8data(iadr+1:iadr+indep)*zcnvrt

  !  all done.

  nullify(idata)
  nullify(r8data)

end subroutine beam_info_r8get1


