c----------------------------------------------------------------------
      subroutine trxpl_gs2fas(itype,zmulti,znroot,ztroot,ztrat,
     >   ierr)
c
c  acquire fast species based on contents of standard TRANSP multigraph
c
      use trxpl_gs2_module
c
      implicit NONE
c
      integer, intent(in) :: itype      ! fast ion type beam/rf/fusion prod.
      character*(*), intent(in) :: zmulti  ! multigraph name
      character*(*), intent(in) :: znroot  ! root of density profile names
      character*(*), intent(in) :: ztroot  ! root of temperature prof names
      real*8, intent(in) :: ztrat       ! factor to get temperature or 2/3<E>
c
      integer, intent(out) :: ierr      ! completion code, 0=OK
c
c  zmulti refers to the multigraph of fast ion specie densities
c  znroot refers to the expected root of name of individual density profiles
c    full name will be <znroot>_<species-code>, where
c
c       <species-code>     means
c         H or P            hydrogen,  Z=1,A=1
c         D                 deuterium, Z=1,A=2
c         T                 tritium,   Z=1,A=3
c         3                 helium-3,  Z=2,A=3
c         4                 helium-4,  Z=2,A=4
c
c  ztroot refers to the expected root of name of individual temperature or
c  average energy profile.  The species-code found in the density multigraph
c  will also be used for the temperature profile
c
c  ztrat*[<ztroot>_<species-code>] gives the temperature or 2/3<E> profile
c    we expect ztrat=1.0 or ztrat=2/3
c
c
c  ierr -- the error flag will be set if the multigraph contains a density
c    profile name with form <root>_<species> where either <root> or <species>
c    has an unexpected value.  Also, if a density profile exists but the
c    corresponding temperature or <E> profile is absent, the error flag will
c    be set.
c
c------------------------------------------
c
      integer, parameter :: ns=6
      character*1 scodes(ns)
      character*3 sclabl(ns)
      integer izz(ns),iaa(ns)
c
      character*20 lbl_types(3:5)
c
      integer i,j,k,kt,is,imulti,istype
      integer nomatch
c
      character*64 zlabel
      character*32 zunits
c
      integer infuns
      character*10 zmembs(max_species),ztest1,ztest2,zname1,zname2
      integer isigns(max_species)
c
      data scodes/'H','P','D','T','3','4'/
      data sclabl/'H','H','D','T','He3','He4'/
      data izz   / 1 , 1 , 1 , 1 , 2   , 2   /
      data iaa   / 1 , 1 , 2 , 3 , 3   , 4   /
c
      data lbl_types/'beam ion','RF minority ion','fusion product'/
c
c------------------------------------------
c
      call rplabel(zmulti,zlabel,zunits,imulti,istype)
      if(imulti.eq.-1000) return        ! no such fast species this run
c
      call rpmulti(zmulti,istype,zlabel,zunits,infuns,isigns,zmembs,
     >   ierr)
      if(ierr.ne.0) then
         call uermsg('?trxpl_mkgs2:  multigraph read error: ',zmulti,0)
         return
      endif
c
      ztest1=znroot
      kt=len_trim(znroot)+1
      ztest1(kt:kt)='_'
      call uupper(ztest1)
c
      nomatch=0
c
      do i=1,infuns
         ztest2=zmembs(i)
         call uupper(ztest2)
         if(ztest1(1:kt).ne.ztest2(1:kt)) then
            nomatch=nomatch+1
            if(nomatch.gt.1) then
               write(6,*)
     >            ' ?trxpl_mkgs2:  too many multigraph members with'
               write(6,*)
     >            '  names not starting with:  ',ztest1
               write(6,*) '  multigraph is:  ',zmulti
               write(6,*) '  contents:  ',(zmembs(j),j=1,infuns)
               ierr=1
               return
            endif
         else
            is=0
            do j=1,ns
               if(ztest2(kt+1:10).eq.scodes(j)) then
                  is=j
               endif
            enddo
            if(is.eq.0) then
               write(6,*)
     >            ' ?trxpl_mkgs2: unrecognized species code: ',ztest2
               write(6,*)
     >            '  in multigraph:  ',zmulti
               ierr=1
               return
            endif
c
            zname1=znroot(1:len_trim(znroot))//'_'//scodes(is)
            zname2=ztroot(1:len_trim(ztroot))//'_'//scodes(is)
            call uupper(zname1)
            call uupper(zname2)
c
            num_species=num_species+1
            j=num_species
            ltype(j)=itype
            Aplas(j)=iaa(is)/mass_ref
            Zplas(j)=izz(is)
            Tconv(j)=ztrat
            call trx_prof(zname1,zunits,iorder,id_norig(j),ierr)
            if(ierr.ne.0) then
               call uermsg('TRANSP profile access failed',
     >            zname1,0)
               return
            endif
            call trx_prof(zname2,zunits,iorder,id_torig(j),ierr)
            if(ierr.ne.0) then
               call uermsg('TRANSP profile access failed',
     >            zname2,0)
               return
            endif
            slabel(j)=sclabl(is)
            k=len_trim(slabel(j))+2
            slabel(j)(k:)=lbl_types(itype)
         endif
      enddo
c
      ierr=0
      return
c
      end
