subroutine rfxqlo_redist(rfraction,ierr)

  !  Redistribute 1d power and current drive profiles, among equivalent
  !  antenna sets.

  !  The input array rfraction(1:n_antenna) indicates which antennas are
  !  equivalent and which profiles are to be redistributed on this call.

  !  The first non-zero element of rfraction(:) should contain the computed
  !  profiles for the equivalent antenna set, with power summed over all
  !  antennas.  Let jfrom=<index to first non-zero element of rfraction>.
  !  The power ratio rfraction(jfrom) will stay on antenna #jfrom.

  !  Other non-zero elements of rfraction(:) specify the other antennas that
  !  are equivalent to antenna #jfrom (same geometry, frequency, and toroidal
  !  mode spectrum); their corresponding rfraction values give the fraction
  !  of power they are each to receive, respectively.

  !  Important:  sum(rfraction)=1.0 expected!

  !  "old_xplasma" representation of 1d profiles is used.  Each profile
  !  has a unique name and integer ID associated with it; these names and
  !  IDs are stored in the "outpros" object array in module: rfxqlo_private.

  !  After all TORIC calculations are done, this routine should be called
  !  once and once only for each set of equivalent RF antennas.

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

  use rfxqlo_private
  implicit NONE

  real*8, intent(in) :: rfraction(n_antenna)

  integer, intent(out) :: ierr         ! error status code, 

  !------------------------------------
  real*8, parameter :: ZERO=0.0d0
  real*8, parameter :: ONE=1.0d0
  real*8, parameter :: ztol=1.0d-10

  real*8 :: rfrsum,zfrom_ext,zdum
  integer :: j,jfrom,jto,inspec

  integer :: idx,idf,idg,inx,idum,inum_nphi,iphi,iant,ispec
  real*8, dimension(:), allocatable :: zx,zfrom,zto
  character*20 :: znam
  !------------------------------------

  ierr=0
  if(n_antenna.le.0) return

  jfrom = 0
  rfrsum = ZERO
  do j=1,n_antenna
     if(rfraction(j).lt.ZERO) then
        ierr=1
        write(lunmsg,*) ' ?rfxqlo_redist: negative fraction, rfraction(',j, &
             ') = ',rfraction(j)
     endif
     if(rfraction(j).gt.(ONE+ztol)) then
        ierr=1
        write(lunmsg,*) ' ?rfxqlo_redist: fraction exceeds ONE, rfraction(',j,&
             ') = ',rfraction(j)
     endif
     rfrsum = rfrsum + rfraction(j)
     if(jfrom.eq.0) then
        if(rfraction(j).gt.ztol) then
           jfrom=j
        endif
     endif
  enddo

  if(abs(ONE-rfrsum).gt.ztol) then
     ierr=1
     write(lunmsg,*) ' ?rfxqlo_redist: sum of fractions not ONE, rfraction =',&
          rfraction
  endif

  if(ierr.ne.0) return

  !----------------------------
  !  rfraction OK.
  !  get x axis; allocate buffers

  call eq_ganum('x_toric4',idx)

  if(idx.eq.0) then
     ierr=1
     write(lunmsg,*) ' ?rfxqlo_redist: expected x axis, x_toric4, not found.'
     return
  endif

  call eq_ngrid(idx,inx)
  allocate(zx(inx),zfrom(inx),zto(inx))

  call eq_grid(idx,zx,inx,idum,ierr)
  if(ierr.ne.0) then
     write(lunmsg,*) ' ?rfxqlo_redist: axis data fetch error.'
     return
  endif

  !----------------------------
  !  number of toroidal modes, this antenna set...

  inum_nphi = antenna_array(jfrom)%num_nphi

  !  this must match for all antennas j in equivalence set (rfraction(j)>0.0).
  !----------------------------
  !  loop over toroidal modes

  do iphi=1,inum_nphi

     !  distribute driven current (if any)

     idf = outpros(iphi,jfrom)%id_jrfe
     if(idf.gt.0) then

        call eq_rgetf(inx,zx,idf,0,zfrom,ierr)
        if(ierr.ne.0) then
           write(lunmsg,*) ' ?rfxqlo_redist: driven current data fetch error.'
           write(lunmsg,*) '  antenna index: ',jfrom,'; mode index: ',iphi
           return
        endif

        do iant=1,n_antenna
           if(rfraction(iant).gt.ztol) then
              zto = zfrom*rfraction(iant)   ! vector expression

              znam = outpros(iphi,iant)%xn_jrfe

              idum = 0
              zdum = ZERO

              call eqm_rhofun(100,idx,znam,zto, idum,zdum,idum,zdum, idg,ierr)
              if(ierr.ne.0) then
                 write(lunmsg,*) ' ?rfxqlo_redist: driven current store error:'
                 write(lunmsg,*) '  from antenna index:  ',jfrom
                 write(lunmsg,*) '    to antenna index:  ',iant
                 write(lunmsg,*) ' toroidal mode index:  ',iphi
                 return
              else
                 outpros(iphi,iant)%id_jrfe = idg ! store ID of profile
              endif

           endif
        enddo
     endif

     ! distribute powers.  These must exist.

     inspec = rfx_ions%n_ions

     do ispec=1,inspec+2

        ! external power

        zfrom_ext = outpros(iphi,jfrom)%ext_pwrs(ispec)

        ! profile

        idf = outpros(iphi,jfrom)%id_pwrs(ispec)
        if(idf.eq.0) then
           ierr=1
           write(lunmsg,*) ' ?rfxqlo_redist: no power profile data found:'
           write(lunmsg,*) '  antenna index: ',jfrom,'; mode index: ',iphi
           write(lunmsg,*) '  species index: ',ispec
           write(lunmsg,*) '  stored name: ',outpros(iphi,jfrom)%xn_pwrs(ispec)
           return
        endif

        call eq_rgetf(inx,zx,idf,0,zfrom,ierr)
        if(ierr.ne.0) then
           write(lunmsg,*) ' ?rfxqlo_redist: power profile data fetch error.'
           write(lunmsg,*) '  antenna index: ',jfrom,'; mode index: ',iphi
           write(lunmsg,*) '  species index: ',ispec
           return
        endif

        do iant=1,n_antenna
           if(rfraction(iant).gt.ztol) then
              ! distrib. external power
              outpros(iphi,iant)%ext_pwrs(ispec) = rfraction(iant)*zfrom_ext

              ! distrib. power profile
              zto = zfrom*rfraction(iant)   ! vector expression

              znam = outpros(iphi,iant)%xn_pwrs(ispec)

              idum = 0
              zdum = ZERO

              call eqm_rhofun(100,idx,znam,zto, idum,zdum,idum,zdum, idg,ierr)
              if(ierr.ne.0) then
                 write(lunmsg,*) ' ?rfxqlo_redist: power profile store error:'
                 write(lunmsg,*) '  from antenna index:  ',jfrom
                 write(lunmsg,*) '    to antenna index:  ',iant
                 write(lunmsg,*) ' toroidal mode index:  ',iphi
                 write(lunmsg,*) '       species index:  ',ispec
                 return
              else
                 outpros(iphi,iant)%id_pwrs(ispec) = idg
              endif
           endif
        enddo  ! antenna loop
     enddo  ! species loop

  enddo  ! toroidal mode loop

  deallocate(zx,zfrom,zto)

end subroutine rfxqlo_redist
