subroutine nbo_name1(zroot,zdim1,ind1,zdim2,ind2,zdim3,ind3,zname_out, &
     zlroot,zlabel_out)

  !  generate name for a single xplasma item -- nubeam output
  !  dmc -- now also: generate label & possibly modify group name

  character*(*), intent(in) :: zroot   ! profile root name
  character*(*), intent(in) :: zdim1   ! name of 1st dimension  or " "
  integer, intent(in) :: ind1          ! corresponding index value
  character*(*), intent(in) :: zdim2   ! name of 2nd dimension  or " "
  integer, intent(in) :: ind2          ! corresponding index value
  character*(*), intent(in) :: zdim3   ! name of 3rd dimension  or " "
  integer, intent(in) :: ind3          ! corresponding index value

  character*(*), intent(out) :: zname_out   ! the generated name...

  character*(*), intent(in) ::  zlroot ! root label
  character*(*), intent(out) :: zlabel_out  ! the generated label...

  !-------------------------------

  integer :: ilen,ilenl,iuct

  integer, parameter :: imxtbl = 10
  integer iatbl(imxtbl),iztbl(imxtbl),intbl
  character*1 zctbl(imxtbl)
  character*3 zctbl3(imxtbl)
  logical :: init_tbl = .FALSE.

  save iatbl,iztbl,zctbl,zctbl3,init_tbl,intbl,isum

  !-------------------------------

  if(.not.init_tbl) then
     init_tbl=.TRUE.

     iatbl=0; iztbl=0; zctbl=' '
     iztbl(1)=1; iatbl(1)=1; zctbl(1)='H'; zctbl3(1)='H'
     iztbl(2)=1; iatbl(2)=2; zctbl(2)='D'; zctbl3(2)='D'
     iztbl(3)=1; iatbl(3)=3; zctbl(3)='T'; zctbl3(3)='T'
     iztbl(4)=2; iatbl(4)=3; zctbl(4)='3'; zctbl3(4)='He3'
     iztbl(5)=2; iatbl(5)=4; zctbl(5)='4'; zctbl3(5)='He4'
     iztbl(6)=3; iatbl(6)=6; zctbl(6)='L'; zctbl3(6)='Li'
     zctbl(7)='W'; zctbl3(7)='W'
     zctbl(8)='X'; zctbl3(8)='X'
     zctbl(9)='Y'; zctbl3(9)='Y'
     zctbl(10)='Z'; zctbl3(10)='Z'
     intbl=6

  endif

  !-------------------------------

  zname_out=zroot
  zlabel_out=zlroot

  ilen = index(zname_out,' ')-1
  ilenl = len_trim(zlabel_out)

  isum=0
  if(zdim1.ne.' ') isum=isum+1
  if(zdim2.ne.' ') isum=isum+1
  if(zdim3.ne.' ') isum=isum+1

  if(zdim1.ne.' ') then
     call extend(zname_out,ilen,zdim1,ind1)
     call extenda(zlabel_out,ilenl,zdim1,ind1)

     if(zdim2.ne.' ') then
        call extend(zname_out,ilen,zdim2,ind2)
        call extenda(zlabel_out,ilenl,zdim2,ind2)

        if(zdim3.ne.' ') then
           call extend(zname_out,ilen,zdim3,ind3)
           call extenda(zlabel_out,ilenl,zdim3,ind3)

        endif
     endif
  endif

  contains

    subroutine extend(zname_out,ilen,zdim,ind)

      use nbi_com
      implicit NONE

      character*(*), intent(inout) :: zname_out   ! name to be extended
      integer, intent(inout) :: ilen              ! non-blank length
      character*(*), intent(in) :: zdim           ! dimension name
      integer, intent(in) :: ind                  ! index value

      ! extend profile name
      !
      ! example: zdim = "miefi", indx=3 ==> append "_E3"

      integer iz,ia,igot,ir1,ir2,j,k
      character*1 zsuffix
      character*20 zreac

      zsuffix=' '
      if(zdim.eq.'mib') then
         ! ... add "_BMnn"
         call extend1(zname_out,ilen,'_BM',ind,zsuffix)
      else if(zdim.eq.'mibs') then
         ! ... add e.g. "_DB" (deuterium beam) or "_4F" (He4 fusion prod.)
         if(nlfprod(ind)) then
            zsuffix='F'
         else
            zsuffix='B'
         endif
         iz=xzbeams(ind)+0.05
         ia=abeams(ind)+0.05
         call match(iz,ia,igot)
         call extend1(zname_out,ilen,'_'//zctbl(igot),0,zsuffix)
      else if(zdim.eq.'mig') then
         ! ... add e.g. "_D" or "_T" -- gas identification
         iz=backz(ind)+0.05
         ia=aplasm(ind)+0.05
         call match(iz,ia,igot)
         call extend1(zname_out,ilen,'_'//zctbl(igot),0,zsuffix)
      else if(zdim.eq.'mireact') then
         ! ... get reaction abbreviation.
         call catfus_mtype(ind,ir1)
         if(zroot(1:2).eq.'bb') then
            ir2=1
         else
            ir2=0
         endif
         call catfus_nam0(ind,ir1,ir2,zreac)
         ia=index(zreac,':')
         if(ia.gt.1) then
            if((zreac(1:ia-1).eq.'BB').or.(zreac(1:ia-1).eq.'BT')) then
               zreac(1:ia)=' '
            else
               zreac(ia:ia)='_'
            endif
         endif
         iz=len(zreac)
         k=0
         iuct=0
         do j=1,iz
            if(zreac(j:j).eq.'_') then
               iuct=iuct+1
               if(iuct.eq.1) then
                  k=k+1
                  zreac(k:k)=zreac(j:j)
               endif
            else if(index('ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789',zreac(j:j)) &
                 .gt.0) then
               k=k+1
               zreac(k:k)=zreac(j:j)
            endif
         enddo
         zreac(k+1:)=' '
         call extend1(zname_out,ilen,'_'//zreac(1:k),0,zsuffix)
      else if(zdim.eq.'miefi') then
         call extend1(zname_out,ilen,'_E',ind,zsuffix)
      else
         call extend1(zname_out,ilen,'_',ind,zsuffix)
      endif

    end subroutine extend

    subroutine extenda(zlabel_out,ilen,zdim,ind)

      use nbi_com
      implicit NONE

      character*(*), intent(inout) :: zlabel_out  ! label to be extended
      integer, intent(inout) :: ilen              ! non-blank length
      character*(*), intent(in) :: zdim           ! dimension name
      integer, intent(in) :: ind                  ! index value

      ! extend profile name
      !
      ! example: zdim = "miefi", indx=3 ==> append "_E3"

      integer iz,ia,igot,ir1,ir2,j,k
      character*20 zsuffix
      character*20 zreac

      zsuffix=' '
      if(zdim.eq.'mib') then
         ! ... add ": beam#nn"
         call extend1(zlabel_out,ilen,': beam#',ind,zsuffix)
      else if(zdim.eq.'mibs') then
         ! ... add e.g. ": D beam" or ": He4 Fusn"
         if(nlfprod(ind)) then
            zsuffix=' Fusn'
         else
            zsuffix=' Beam'
         endif
         iz=xzbeams(ind)+0.05
         ia=abeams(ind)+0.05
         call match(iz,ia,igot)
         call extend1(zlabel_out,ilen,': '//trim(zctbl3(igot)),0,trim(zsuffix))
      else if(zdim.eq.'mig') then
         ! ... add e.g. ": D target" or ... -- gas identification
         iz=backz(ind)+0.05
         ia=aplasm(ind)+0.05
         call match(iz,ia,igot)
         zsuffix=' target'
         call extend1(zlabel_out,ilen,': '//trim(zctbl3(igot)),0,trim(zsuffix))
      else if(zdim.eq.'mireact') then
         ! ... get reaction abbreviation.
         call catfus_mtype(ind,ir1)
         if(zroot(1:2).eq.'bb') then
            ir2=1
            if(ind.le.8) then
               zsuffix=' beam-beam'
            else if(ind.le.10) then
               zsuffix=' fusn-beam'
            else
               zsuffix=' RFtail-beam'
            endif
         else if(zroot(1:2).eq.'bt') then
            ir2=0
            if(ind.le.8) then
               zsuffix=' beam-target'
            else if(ind.le.10) then
               zsuffix=' fusn-target'
            else
               zsuffix=' RFtail-target'
            endif
         else
            ir2=1
            zsuffix=' reaction'
         endif
         call catfus_nam0(ind,ir1,ir2,zreac)
         ia=index(zreac,':')
         zreac(1:ia)=' '
         iz=len(zreac)
         k=0
         do j=1,iz
            if(zreac(j:j).ne.' ') then
               k=k+1
               zreac(k:k)=zreac(j:j)
            endif
         enddo
         zreac(k+1:)=' '
         call extend1(zlabel_out,ilen,': '//zreac(1:k),0,trim(zsuffix))
      else if(zdim.eq.'miefi') then
         call extend1(zlabel_out,ilen,': Erange#',ind,zsuffix)
      else
         if(ind.eq.1) then
            zsuffix = 'Full E'
         else if(ind.eq.2) then
            zsuffix = 'Half E'
         else if(ind.eq.3) then
            zsuffix = '1/3 E'
         else
            zsuffix = '??? E'
         endif
         call extend1(zlabel_out,ilen,': ',0,trim(zsuffix))
      endif

    end subroutine extenda

    subroutine match(iz,ia,igot)

      use nbi_com
      implicit NONE

      integer, intent(in) :: iz,ia  ! Z and A of specie
      integer, intent(out) :: igot  ! table row output

      !  a value of igot btw 1 and 10 is always returned, but a warning
      !  is generated if the the 10th row was reset to do this; this could
      !  lead to duplicate name xplasma errors downstream...

      integer imatch,i

      imatch=0
      do i=1,intbl
         if((iz.eq.iztbl(i)).and.(ia.eq.iatbl(i))) then
            imatch=i
            exit
         endif
      enddo

      if(imatch.gt.0) then
         igot=imatch
      else
         if(intbl.lt.imxtbl) then
            intbl=intbl+1
         else
            write(nonlin,*) ' ?nbo_name1(match): no match, iz=',iz,' ia=',ia
            write(nonlin,*) '  fixup attempted.'
         endif
         iztbl(intbl)=iz
         iatbl(intbl)=ia
         igot=intbl
      endif

    end subroutine match

    subroutine extend1(zname_out,ilen,zprefix,ind,zsuffix)

      use nbi_com
      implicit NONE

      character*(*), intent(inout) :: zname_out   ! name to be extended
      integer, intent(inout) :: ilen              ! non-blank length

      character*(*), intent(in) :: zprefix        ! prefix
      integer, intent(in) :: ind                  ! numerical value (if >0)
      character*(*), intent(in) :: zsuffix        ! suffix (if non-blank)

      !  note prefix is assumed to be non-blank and to have NO leading or
      !  trailing blanks... if zsuffix is non-blank it to is assumed not
      !  to have any leading or trailing blanks

      !  extend the label with indicated information...
      !  e.g. "btntns" -> "btntns_DDN"

      !--------------------
            
      integer ii,ij
      character*3 zdigs

      ij=len(zprefix)
      call extend2(zname_out,ilen,zprefix,ij)

      if(ind.gt.0) then
         if(ind.le.9) then
            write(zdigs(1:1),'(I1)') ind
            call extend2(zname_out,ilen,zdigs,1)
         else if(ind.le.99) then
            write(zdigs(1:2),'(I2)') ind
            call extend2(zname_out,ilen,zdigs,2)
         else if(ind.le.999) then
            write(zdigs(1:2),'(I3)') ind
            call extend2(zname_out,ilen,zdigs,3)
         else
            call extend2(zname_out,ilen,'xxx',3)
         endif
      endif

      if(zsuffix.ne.' ') then
         ij=len(zsuffix)
         call extend2(zname_out,ilen,zsuffix,ij)
      endif

    end subroutine extend1

    subroutine extend2(zname_out,ilen,zxtend,ilx)

      use nbi_com
      implicit NONE

      character*(*), intent(inout) :: zname_out   ! name to be extended
      integer, intent(inout) :: ilen              ! non-blank length

      character*(*), intent(in) :: zxtend
      integer, intent(in) :: ilx

      integer j

      if((ilen+ilx).gt.len(zname_out)) then
         write(nonlin,*) ' ?nbo_name1:  name truncation error, trying to add'
         write(nonlin,*) '  "',zxtend(1:ilx),'" to "',zname_out,'".'
         write(nonlin,*) '  fixup being applied.'
      endif

      do j=1,ilx
         ilen=ilen+1
         if(ilen.gt.len(zname_out)) ilen=1
         zname_out(ilen:ilen)=zxtend(j:j)
      enddo

    end subroutine extend2

end subroutine nbo_name1
