program ps_nbline_driver

  ! demo program for ps_nbline
  ! demonstrate:
  !   (a) setup of a random number generator (rng);
  !   (b) access to a Plasma State with an NBI machine description plus
  !       powers, voltages, and energy fractions;
  !   (c) fetch and print N randomly chosen starting coordinates for
  !       beam neutrals: (R,phi,Z,v_R,v_phi,v_Z) (m,rad,m,m/s,m/s,m/s)
  !
  ! command line arguments control the rng seed, the state input file,
  ! and the number N

  ! syntax:  
  !    ps_nbline_driver -seed:<seed_str> -ps:<plasma_state_file> -N:<number>

  !    (command line keywords case insensitive; -n:<number> also works).

  use rng_container   ! a container module for the Charles Karney rng
                      ! this is only one of many possible implementations

  use plasma_state_mod
  use ps_nbline_module

  implicit NONE

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

  integer, parameter :: max_args=3
  integer :: nargs

  character*250 args(max_args),arg,value
  character*10 keywd
  character*16 znam16

  integer :: npts          ! #beam ptcl start pts to generate
  character*40 seed_str    ! RNG seed string
  character*120 PSpath     ! path to Plasma State file

  integer :: ierr,istat,ii,icolon,ilenv,istream,ie,ispecm

  integer, parameter :: rng_test_size = 50
  real*8 :: zran(rng_test_size),zgauss(rng_test_size)
  real*8 :: zavg1,zrms1,zavg2,zrms2,xcen,xwid,zv2
  real*8 :: zfrac1,zfrac2,zfrac3,zpco,zpctr,zptot
  real*8, external :: frandm,fgauss

  type (beamlet) :: trajectory

  integer :: ipts
  character*3 scod

  logical :: ilco
  !----------------------------------

  npts = 0
  seed_str = ' '
  PSpath = ' '

  ierr = 0

  !------------------------------------------------
  ! get the number of command line arguments
  call get_arg_count(nargs)

  ! is the number of arguments OK?
  if(nargs.eq.0) then
     ierr = ierr + 1
     write(6,*) ' ?ps_nbline_driver: no command line arguments found.'

  else if(nargs.gt.max_args) then
     ierr = ierr + 1
     write(6,*) ' ?ps_nbline_driver: maximum argument count exceeded: ', &
          nargs,' > ',max_args,'.'
     nargs = max_args
  endif

  !------------------------------------------------
  ! read and echo the arguments

  do ii=1,nargs
     call get_arg(ii,args(ii))
     write(6,'(a,i2,a)') '    argument no. ',ii,': '//trim(args(ii))
  enddo

  !------------------------------------------------
  ! check each individual argument
  !   syntax -<keywd>:<value>

  do ii=1,nargs
     arg = args(ii)
     if(arg(1:1).ne.'-') then
        write(6,*) ' ?ps_nbline_driver: argument #',ii, &
             ' keyword does not start with "-".'
        ierr = ierr + 1
        cycle
     endif

     icolon = index(arg,':')
     if(icolon.le.0) then
        write(6,*) ' ?ps_nbline_driver: argument #',ii, &
             ' keyword ":" delimiter missing.'
        ierr = ierr + 1
        cycle
     else if(icolon.gt.(2+len(keywd))) then
        write(6,*) ' ?ps_nbline_driver: argument #',ii, &
             ' keyword too long.'
        ierr = ierr + 1
        cycle
     endif

     !  syntax -<keywd>:<value> is OK

     keywd = arg(2:icolon-1)

     value = arg(icolon+1:)
     ilenv = len(trim(value))

     call uupper(keywd)  ! convert to uppercase

     !  check keyword; decode value

     if(keywd.eq.'N') then
        call getival(npts)     ! get value field of -N:<number>

     else if(keywd.eq.'SEED') then
        call getcval(seed_str) ! get value field of -SEED:<seed_str>

     else if(keywd.eq.'PS') then
        call getcval(PSpath)   ! get value field of -PS:<path_to_Plasma_State>

     else
        ierr = ierr + 1
        write(6,*) ' ?ps_nbline_driver: keyword unrecognized: '//trim(keywd)
     endif
  enddo

  !---------------------------
  !  did we get everything?

  if(npts.le.0) then
     ierr = ierr+1
     write(6,*) ' ?ps_nbline_driver: a positive number of beam trajectories must be specified.'
  endif

  if(pspath.eq.' ') then
     ierr = ierr+1
     write(6,*) ' ?ps_nbline_driver: a Plasma State file path must be given.'
  endif

  if(seed_str.eq.' ') then
     ierr = ierr+1
     write(6,*) ' ?ps_nbline_driver: a random number seed initialization string must be given.'
  endif

  !---------------------------
  !  syntax scan completed...

  if(ierr.ne.0) then
     write(6,*) ' '
     write(6,*) ' syntax: '
     write(6,*) ' ps_nbline_driver -ps:<Plasma_State_file_path> \ '
     write(6,*) '                  -seed:<RNG_seed_string> \ '
     write(6,*) '                  -N:<number_of_beam_trajectories>'
     write(6,*) ' '
     call exit(ierr)
  endif

  write(6,*) ' '
  write(6,*) ' ps_nbline_driver: syntax OK'
  write(6,*) ' ' 

  !--------------------------------
  !  RNG test

  istream = 1   ! this serial test code only has a single RNG stream

  xcen = 10.0d0
  xwid =  1.0d0 ! will sample exp(-(x-xcen)**2/(2*xwid**2))

  call rngcon_init(seed_str)

  zavg1 = 0.0d0
  zavg2 = 0.0d0

  do ii=1,rng_test_size
     zran(ii) = frandm(istream)
     zavg1 = zavg1 + zran(ii)
     zgauss(ii) = fgauss(istream,xcen,xwid)
     zavg2 = zavg2 + zgauss(ii)
  enddo

  zavg1 = zavg1/rng_test_size
  zavg2 = zavg2/rng_test_size

  zrms1 = 0.0d0
  zrms2 = 0.0d0

  do ii=1,rng_test_size

     zrms1 = zrms1 + (zran(ii)-zavg1)**2
     zrms2 = zrms2 + (zgauss(ii)-zavg2)**2

  enddo

  zrms1 = sqrt(zrms1/rng_test_size)
  zrms2 = sqrt(zrms2/rng_test_size)

  write(6,*) ' ------------------------------------ '
  write(6,*) ' RNG test results:'
  write(6,*) '     frandm          fgauss'
  do ii=1,rng_test_size
     write(6,'(1x,i3,2(1x,1pe15.8))') ii,zran(ii),zgauss(ii)
  enddo

  write(6,*) ' '
  write(6,'(a,2(1x,1pe15.8))') ' frandm mean & rms deviation: ',zavg1,zrms1

  write(6,*) ' '
  write(6,*) '  Guassian sample over exp(-(x-xcen)**2/(2*xwid**2))'

  write(6,'(a,2(1x,1pe15.8))') ' xcen, xwid: ',xcen,xwid
  write(6,'(a,2(1x,1pe15.8))') ' fgauss mean & rms deviation: ',zavg2,zrms2
  write(6,*) ' '

  !--------------------------------
  !  read plasma state

  write(6,*) ' ------------------------------------ '
  write(6,*) ' Read the Plasma State: ',trim(PSpath)

  call ps_get_plasma_state(ierr, filename=trim(PSpath))
  if(ierr.ne.0) then
     write(6,*) '   ?ps_nbline_driver: Plasma State file read error.'
     call exit(ierr)
  endif

  write(6,*) ' '
  write(6,*) ' The number of neutral beams: ',ps%nbeam
  write(6,*) ' '
  write(6,*) ' Check beam energy fractions...'

  call ps_chk_nbfrac(0,ierr)
  if(ierr.ne.0) then
     write(6,*) '   ?ps_nbline_driver: error in beam energy fractions.'
     call exit(ierr)
  endif
  write(6,*) ' '

  write(6,*) ' Name            co?  Pinj(W)       Einj(KeV)     F(full-E)     F(half-E)'

  zpco = 0
  zpctr= 0

  do ii=1,ps%nbeam
     znam16 = ps%nbi_src_name(ii)(1:16)
     ilco = ( ps%srtcen(ii) * ps%kccw_Jphi  .gt. 0.0 ) 

     write(6,'(1x,a,2x,L1,1x,4(2x,1pe12.5))') znam16,ilco,ps%power_nbi(ii), &
          ps%kvolt_nbi(ii), ps%frac_full(ii), ps%frac_half(ii)
     if(ilco) then
        zpco = zpco + ps%power_nbi(ii) + ps%power_nbi_trace(ii)
     else
        zpctr = zpctr + ps%power_nbi(ii) + ps%power_nbi_trace(ii)
     endif
  enddo

  zptot = zpco + zpctr

  if(zptot.le.0.0d0) then
     write(6,*) ' Total Power is ZERO.'
  else
     write(6,'(3x,a,1pe10.3,a,1pe10.3,a,1pe10.3)') 'Total Power (W): ',zptot, &
          ' Co-inj fraction: ',zpco/zptot,' Ctr-inj: ',zpctr/zptot
  endif

  write(6,*) ' '
  write(6,'(a)') ' S   iB E co  Rsta       Phista     Zsta       vR         vPhi       vZ'
  write(6,'(a)') ' --- -- - -- ---------- ---------- ---------- ---------- ---------- ----------'

  zfrac1=0
  zfrac2=0
  zfrac3=0

  zpco = 0
  zpctr= 0

  do ipts=1,npts
     call ps_nbline(istream,frandm,fgauss, &
          ps,All_species, &
          trajectory,ierr)

     if(ierr.ne.0) then
        write(6,*) ' ?ps_nbline: ierr = ',ierr
        exit
     endif

     iE = trajectory%energy_frac
     if(iE.eq.1) zfrac1 = zfrac1 + 1
     if(iE.eq.2) zfrac2 = zfrac2 + 1
     if(iE.eq.3) zfrac3 = zfrac3 + 1

     scod='?  '
     if(trajectory%specie.eq.i_Hydrogen) then
        scod='H  '
     else if(trajectory%specie.eq.i_Deuterium) then
        scod='D  '
     else if(trajectory%specie.eq.i_Tritium) then
        scod='T  '
     else if(trajectory%specie.eq.i_Helium3) then
        scod='He3'
     else if(trajectory%specie.eq.i_Helium4) then
        scod='He4'
     endif

     ilco = (trajectory%vPhi * ps%kccw_Jphi) .gt. 0.0

     ispecm = trajectory%specie
     if(ispecm.gt.3) ispecm = ispecm - 1  ! approx. mass in AMU

     zv2 = (trajectory%vR)**2 + (trajectory%vZ)**2 + (trajectory%vPhi)**2
     if(ilco) then
        zpco = zpco + ispecm*zv2   ! odd units
     else
        zpctr= zpctr+ ispecm*zv2   ! odd units
     endif

     write(6,'(1x,a3,1x,i2,1x,i1,1x,L1,1x,6(1x,1pe10.3))') scod, &
          trajectory%beam_number, trajectory%energy_frac, ilco, &
          trajectory%Rsta, trajectory%Phista, trajectory%Zsta, &
          trajectory%vR, trajectory%vPhi, trajectory%vZ

  enddo

  write(6,*) ' ' 
  write(6,'(a,1x,1pe10.3)') 'full energy fraction:  ',zfrac1/npts
  write(6,'(a,1x,1pe10.3)') 'half energy fraction:  ',zfrac2/npts
  write(6,'(a,1x,1pe10.3)') '(1/3) energy fraction: ',zfrac3/npts
  if(zpco+zpctr.gt.0.0) then
     write(6,*) ' ' 
     write(6,'(a,1x,1pe10.3)') 'Co-injected power fraction:  ', &
          zpco/(zpco+zpctr)
     write(6,'(a,1x,1pe10.3)') 'Ctr-injected power fraction: ', &
          zpctr/(zpco+zpctr)
  endif
  
!--------------------------------------------------------
CONTAINS

  subroutine getival(ival)

    !  get integer value

    integer, intent(out) :: ival  ! unchanged if argument value is omitted

    character*10 :: zidcod

    ival=0

    if(ilenv.eq.0) then
       ierr = ierr + 1
       write(6,*) ' ?ps_nbline_driver: missing value field: '//trim(arg)

    else if(ilenv.gt.len(zidcod)) then
       ierr = ierr + 1
       write(6,*) ' ?ps_nbline_driver: value field too long: '//trim(arg)

    else
       zidcod = ' '
       zidcod(len(zidcod)-ilenv+1:len(zidcod)) = value(1:ilenv)

       read(zidcod,'(I10)',iostat=istat) ival

       if(istat.ne.0) then
          ierr=ierr + 1
          write(6,*) ' ?ps_nbline_driver: integer value decode failed: '// &
               trim(arg)
          ival=0
       endif

    endif

  end subroutine getival

  subroutine getcval(cval)

    !  get character string value
    !    args(iarg); icolon specifies colon location

    character*(*), intent(out) :: cval

    integer :: ilen_cval

    ilen_cval=len(cval)

    if(ilenv.eq.0) then
       ierr = ierr + 1
       write(6,*) ' ?ps_nbline_driver: missing value field: '//trim(arg)

    else if(ilenv.gt.ilen_cval) then
       ierr = ierr + 1
       write(6,*) ' ?ps_nbline_driver: value field too long: '//trim(arg)
       write(6,*) '  maximum length for this value: ',ilen_cval

    else
       cval = value

    endif

  end subroutine getcval

END program ps_nbline_driver

!=====================================================================
!  externally callable interface to RNG

REAL*8 FUNCTION frandm(istream)

  use rng_container
  implicit NONE

  integer :: istream

  frandm = rngcon_frandm(istream)

END FUNCTION frandm

REAL*8 FUNCTION fgauss(istream,xcen,xwid)

  use rng_container
  implicit NONE

  integer :: istream
  real*8 :: xcen,xwid   ! center & width of Gaussian sample

  fgauss = rngcon_fgauss(istream,xcen,xwid)

END FUNCTION fgauss
