  subroutine trxpl_orbit_prof(ilnum)


  include 'trxpl.blk'

!    uread stuff
!
      integer, parameter :: r8=selected_real_kind(12,100)
      integer lnout,ilnum
      logical lxout,lchar,lyes

      integer :: nspec,n_species,iorder,lrho,ierror,ik,il,          &
                 id_zeff,id_pot,idcod,ipoints,ii
      integer, dimension(:), allocatable :: id_ns,id_ts,id_ion,     &
                                            id_imp,itype,Izc
      character*20, dimension(:), allocatable :: slbl
      character*50 :: zunit_zeff,zunit_pot
      real*8 :: drho
      real*8, dimension(:), allocatable :: rho,Zr8,Ar8,zaimpd,      &
                                           zzimpd,zziond,zaiond
      real*8, dimension(:,:), allocatable :: zrhoni,zrhonz
      real*8 :: zadumn,zzdumn,zadumd,zzdumd,zzdif
      real*8 :: zaplasmave,zzplasmave,zaimpave,zzimpave,zrhoelcal
      real*8, allocatable :: zaplasm(:),zzplasm(:),zaimp(:),zzimp(:)
                            
      real*8, allocatable :: zrhoel(:),zrhoplasm(:),zrhoimp(:),       &
                                       zeffc(:),zte(:),zti(:),zpot(:)

!
! Code for writing the profiles for the
! non-Boozer version of Roscoe's orbit code. 
! K. Indireshkumar (05/2004)
!
         lrho_loop: do

            call uread(                                             &
               'ENTER NUMBER OF GRID POINTS OR "Q" TO QUIT:$$')

            ierror=0
            if (lchar('Q')) then
               lrho=21
               print *,'Number of zones set to ',lrho
            else
               lrho=idcod(ierror)
            endif

            if (ierror.ne.0) cycle lrho_loop

            exit lrho_loop

         end do lrho_loop

         if (allocated(rho)) deallocate(rho)
         allocate(rho(lrho))

         rho(1)=0.0
         drho=1.0_r8/(lrho-1)
         do ik=2,lrho
            rho(ik)=rho(ik-1)+drho
         enddo
         rho(lrho)=1.0_r8

         call trx_nspec(nspec)

         if(allocated(id_ns)) deallocate(id_ns)
         if(allocated(id_ts)) deallocate(id_ts)
         if(allocated(id_ion)) deallocate(id_ion)
         if(allocated(id_imp)) deallocate(id_imp)
         if(allocated(slbl)) deallocate(slbl)
         if(allocated(itype)) deallocate(itype)
         if(allocated(Zr8)) deallocate(Zr8)
         if(allocated(Ar8)) deallocate(Ar8)
         if(allocated(Zr8)) deallocate(Zr8)
         if(allocated(zziond)) deallocate(zziond)
         if(allocated(zaiond)) deallocate(zaiond)
         if(allocated(zzimpd)) deallocate(zzimpd)
         if(allocated(zaimpd)) deallocate(zaimpd)
         if(allocated(zeffc)) deallocate(zeffc)
         if (allocated(zte)) deallocate(zte)
         if (allocated(zti)) deallocate(zti)
         if (allocated(zpot)) deallocate(zpot)

         allocate(id_ns(nspec),id_ts(nspec),id_ion(nspec),id_imp(nspec))
         allocate(slbl(nspec),itype(nspec),Zr8(nspec),Ar8(nspec),Izc(nspec))
         allocate(zziond(nspec),zaiond(nspec),zzimpd(nspec),zaimpd(nspec))

         allocate(zaplasm(lrho),zzplasm(lrho),zaimp(lrho),zzimp(lrho))
         allocate(zrhoel(lrho),zrhoplasm(lrho),zrhoimp(lrho),zeffc(lrho))
         allocate(zte(lrho),zti(lrho),zpot(lrho))

         iorder=1

         call trx_spec_lbl(nspec,n_species,slbl,itype,Zr8,Ar8,IZc)

         call trxpl_species(nspec,iorder,'T',id_ts)

         call trxpl_species(nspec,iorder,'N',id_ns)

         inumion=0
         inumimp=0
         do ii=1,nspec
           if (itype(ii).eq.-1) then

            ! Get electron temp and density

            call eq_rgetf(lrho,rho,id_ts(ii),0,zte,ierr)
            if(ierr.ne.0) then
             write(6,*) ' ?trxpl: error interpolating electron temp profile'
            endif
            
            call eq_rgetf(lrho,rho,id_ns(ii),0,zrhoel,ierr)
            if (ierr.ne.0) then
             write(6,*) ' ?trxpl: error interpolating electron density profile'
            endif

           elseif (itype(ii).eq.1) then

           ! Decide if the specie is main ion and
           ! get the temperature

            inumion=inumion+1
            zziond(inumion)=Zr8(ii)
            zaiond(inumion)=Ar8(ii)
            id_ion(inumion)=id_ns(ii)
            call eq_rgetf(lrho,rho,id_ts(ii),0,zti,ierr)
            if (ierr.ne.0) then
             write(6,*) ' ?trxpl: error interpolating ion temperature profile'
            endif

           elseif(itype(ii).eq.2) then

           ! Decide if the specie is impurity 
           !  (multiple impurity scenario) 

            inumimp=inumimp+1
            zzimpd(inumimp)=Zr8(ii)
            zaimpd(inumimp)=Ar8(ii)
            id_imp(inumimp)=id_ns(ii)

           elseif(itype(ii).eq.3) then

           ! Decide if the specie is impurity 
           !  (single ``model'' impurity scenario) 

            inumimp=inumimp+1
            zzimpd(inumimp)=Zr8(ii)
            zaimpd(inumimp)=Ar8(ii)
            id_imp(inumimp)=id_ns(ii)

           endif
          enddo

          if(allocated(zrhoni)) deallocate(zrhoni)
          if(allocated(zrhonz)) deallocate(zrhonz)
          allocate(zrhoni(1:lrho,1:inumion))
          allocate(zrhonz(1:lrho,1:inumimp))
            
! Interpolate ion and imputrity densities to lrho grid

         call eq_rgetff(lrho,rho,inumion,id_ion,0,lrho,zrhoni,ierr)

         if(ierr.ne.0) then
            write(6,*) ' ?trxpl: error interpolating ion density profiles'
         endif

         call eq_rgetff(lrho,rho,inumimp,id_imp,0,lrho,zrhonz,ierr)

         if(ierr.ne.0) then
            write(6,*) ' ?trxpl: error interpolating impurity density profiles'
         endif

         zadumn=0.0
         zadumd=0.0
         zzdumn=0.0
         zzdumd=0.0
         zaplasmave=0.0
         zzplasmave=0.0
         ipoints=0
         do ii=1,lrho
          do ig=1,inumion
            zadumn=zadumn+zaiond(ig)*zrhoni(ii, ig)
            zadumd=zadumd+zrhoni(ii, ig)
            zzdumn=zzdumn+zziond(ig)*zziond(ig)*zrhoni(ii, ig)
            zzdumd=zzdumd+zziond(ig)*zrhoni(ii, ig)
          enddo
          zaplasm(ii)=zadumn/zadumd
          zzplasm(ii)=zzdumn/zzdumd
          zaplasmave=zaplasmave+zaplasm(ii)
          zzplasmave=zzplasmave+zzplasm(ii)
          ipoints=ipoints+1
         enddo
         zaplasmave=zaplasmave/ipoints
         zzplasmave=zzplasmave/ipoints

         zadumn=0.0
         zadumd=0.0
         zzdumn=0.0
         zzdumd=0.0
         zaimpave=0.0
         zzimpave=0.0
         ipoints=0
         do ii=1,lrho
          do ig=1,inumimp
           zadumn=zadumn+zaimpd(ig)*zrhonz(ii,ig)
           zadumd=zadumd+zrhonz(ii,ig)
           zzdumn=zzdumn+zzimpd(ig)*zzimpd(ig)*zrhonz(ii,ig)
           zzdumd=zzdumd+zzimpd(ig)*zrhonz(ii,ig)
          enddo
          zzimp(ii)=zzdumn/zzdumd
          zaimp(ii)=zadumn/zadumd
          zaimpave=zaimpave+zaimp(ii)
          zzimpave=zzimpave+zzimp(ii)
          ipoints=ipoints+1
         enddo

         zaimpave=zaimpave/ipoints
         zzimpave=zzimpave/ipoints

         call trx_prof('ZEFFP',zunit_zeff,1,id_zeff,ierr)

         call eq_rgetf(lrho,rho,id_zeff,0,zeffc,ierr)

         call trx_prof('VRPOT',zunit_pot,1,id_pot,ierr)

         if (ierr.eq.0) then

          call eq_rgetf(lrho,rho,id_pot,0,zpot,ierr)

         else

          write(6,*) ' ?trxpl: VRPOT cannot be accessed; proceeding with pot=0'

          zpot(:)=0.0_r8

         endif

         zzdif=zzplasmave-zzimpave

         do ii=1,lrho
          zrhoplasm(ii)=(zrhoel(ii)/zzplasmave)*((zeffc(ii)-zzimpave)/zzdif)
          zrhoimp(ii)=(zrhoel(ii)/zzimpave)*((zzplasmave-zeffc(ii))/zzdif)
         enddo

! Convert densities to cm^{-3}

    zrhoel(:)=1.E-6*zrhoel(:)
    zrhoplasm(:)=1.E-6*zrhoplasm(:)
    zrhoimp(:)=1.E-6*zrhoimp(:)

    
    print *,'Printing diagnostic information'
    print *,'zaplasmave= ',zaplasmave
    print *,'zzplasmave= ',zzplasmave
    print *,' '
    print *,'zaimpave= ',zaimpave
    print *,'zzimpave= ',zzimpave
    print *,' '

    do ii=1,lrho
     zaplasm(ii)=zaplasmave
     zzplasm(ii)=zzplasmave
     zaimp(ii)=zaimpave
     zzimp(ii)=zzimpave
    enddo

    write (ilnum,'((a))') '        XI        '
    write (ilnum,'(5(e19.9))') (rho(ik),ik=1,lrho)
    write (ilnum,'((a))') '        Z_i        '
    write (ilnum,'(5(e19.9))') (zzplasm(ik),ik=1,lrho)
    write (ilnum,'((a))') '        A_i        '
    write (ilnum,'(5(e19.9))') (zaplasm(ik),ik=1,lrho)
    write (ilnum,'((a))') '        Z_I        '
    write (ilnum,'(5(e19.9))') (zzimp(ik),ik=1,lrho)
    write (ilnum,'((a))') '        A_I        '
    write (ilnum,'(5(e19.9))') (zaimp(ik),ik=1,lrho)
    write (ilnum,'((a))') '        n_e        '
    write (ilnum,'(5(e19.9))') (zrhoel(ik),ik=1,lrho)
    write (ilnum,'((a))') '        n_i        '
    write (ilnum,'(5(e19.9))') (zrhoplasm(ik),ik=1,lrho)
    write (ilnum,'((a))') '        n_I        '
    write (ilnum,'(5(e19.9))') (zrhoimp(ik),ik=1,lrho)
    write (ilnum,'((a))') '        t_e        '
    write (ilnum,'(5(e19.9))') (zte(ik),ik=1,lrho)
    write (ilnum,'((a))') '        t_i        '
    write (ilnum,'(5(e19.9))') (zti(ik),ik=1,lrho)
    write (ilnum,'((a))') '        pot        '
    write (ilnum,'(5(e19.9))') (zpot(ik),ik=1,lrho)

    deallocate(rho,zrhoni,zrhonz)
    deallocate(id_ns,id_ts,id_ion,id_imp)
    deallocate(slbl,itype,Zr8,Ar8,Izc)
    deallocate(zziond,zaiond,zzimpd,zaimpd)
    deallocate(zaplasm,zzplasm,zaimp,zzimp)
    deallocate(zrhoel,zrhoplasm,zrhoimp,zeffc)
    deallocate(zte,zti,zpot)

  end subroutine trxpl_orbit_prof
