c-------------------------------------------------------------------
      subroutine trxpl_mkgs2_smoo(tlabel)
c
c  control smoothing of profile data
c
      use trxpl_gs2_module
      implicit NONE
c
      character*(*) tlabel              ! plotting label
c
c---------------------------------------------
c
      logical lxout,lchar
      integer luntty,lnout
      logical insmoo(num_species),itsmoo(num_species)
      logical ismoo_save(num_species),igsmoo
      integer i,j,k,nrho
      integer idcod,iert,ierr
c
      real*8, dimension(:), allocatable :: rho,f,fsm,epsilon,delta
      real*8, dimension(:), allocatable :: nprof,zprof
      real*8 zlarge,zdum,enda,endb,zbc1,zbc2
      integer idum1,idum2,ibc1,ibc2,iord
c
      character*20 zname,zunits,zpre
      integer :: id=0,idsm
      integer itiflag,inzflag
c
c---------------------------------------------
c
      luntty=lnout(0)
      if(gsmoo) then
         write(luntty,*) ' %trxpl_mkgs2_smoo:'
         write(luntty,*) '  some smoothing was already done; smoothing'
         write(luntty,*) '  takes the original data (only) as input,'
         write(luntty,*) '  prior smoothed data may be replaced.'
      endif
c
      call eq_ngrid(id_rho,nrho)
c
      allocate(rho(nrho),f(nrho),fsm(nrho),epsilon(nrho),delta(nrho))
c
      call eq_grid(id_rho,rho,nrho,k,ierr)
      if(ierr.ne.0) then
         call errmsg_exit('?trxpl_mkgs2_smoo: eq_grid error!')
      endif
c
      zlarge=1.0d35
      epsilon=zlarge
c
      enda=1.0d0         ! center endpt, smooth s.t. grad(f)->0
      endb=0.5d0         ! edge endpt, default smooth
c
      ibc1=1
      zbc1=0.0d0
      ibc2=0
      zbc2=0.0d0
c
 10   continue
c
      insmoo=.FALSE.
      itsmoo=.FALSE.
      igsmoo=.FALSE.
c
      if(lxout(0)) then
         write(luntty,1001)
 1001    format(/
     >      'trxpl_mkgs2_smoo options:'/
     >      ' A -- smooth ALL density profiles'/
     >      ' B -- smooth all ion density profiles,'/
     >      '      renormalize sum(ni*Zi) to ne (quasineutrality)'/
     >      ' C -- smooth all but a few ion density profiles,'/
     >      '      renormalize sum(ni*Zi) to ne (quasineutrality)'/
     >      ' P -- **plot** smoothed & unsmoothed profile'/
     >      ' T -- smooth the electron temperature'/
     >      ' S -- smooth the ion temperature(s) (thermal plasma)'/
     >      ' U -- smooth a selected fast ion "temperature" profile'/
     >      ' V -- smooth ALL temperature profiles'/
     >      ' X -- discard all smoothed data'/
     >      ' Q -- quit')
      endif
      call uread('trxpl_mkgs2_smoo menu option:$')
c
      if(lchar('Q')) then
c
c  exit
c
         go to 900
      else if(lchar('X')) then
c
c  discard smoothed data
c
         gsmoo=.FALSE.
         tsmoo=.FALSE.
         nsmoo=.FALSE.
         dx_smooth_n=0
         dx_smooth_t=0
      else if(lchar('P')) then
c
c  plot smoothed profile
c
         i=1
 15      continue
         if(lxout(0)) call trxpl_mkgs2_summ(luntty,' (profile data)')
         call uread('enter "T" for temperature, "N" for density:$')
         if(lchar('Q')) then
            go to 10
         else if(lchar('N')) then
            j=1
         else if(lchar('T')) then
            j=2
         else
            call uermsg('?trxpl_mkgs2_smoo:  expected "T" "N" or "Q".',
     >         ' ',0)
            go to 15
         endif
c
         call ureadi('select species number to plot:$',i)
         if((i.lt.1).or.(i.gt.num_species)) then
            j=0
         else if(j.eq.1) then
            if(.not.nsmoo(i)) j=0
         else if(j.eq.2) then
            if(.not.tsmoo(i)) j=0
         endif
         if(j.eq.0) then
            call uermsg('?trxpl_mkgs2_smoo: no smoothed profile.',
     >         ' ',0)
            go to 15
         endif
c
         if(j.eq.1) then
            id=id_norig(i)
            idsm=id_nsmoo(i)
            zunits='/m^3'
            zpre='Density,'
         else if(j.eq.2) then
            id=id_torig(i)
            idsm=id_tsmoo(i)
            zunits='keV'
            zpre='Temperature,'
         endif
c
         call eq_rgetf(nrho,rho,id,0,f,ierr)
         if(ierr.ne.0) call errmsg_exit('??trxpl_mkgs2_smoo 77 ?')
         call eq_rgetf(nrho,rho,idsm,0,fsm,ierr)
         if(ierr.ne.0) call errmsg_exit('??trxpl_mkgs2_smoo 78 ?')
c
         if(id.eq.id_torig(i)) then
            f=Tconv(i)*f    ! conversion factor for temperature not density
            fsm=Tconv(i)*fsm
         endif
c
         call r8_grafx2(rho,f,fsm,nrho,' ',zunits,transp_path,tlabel,
     >      zpre//slabel(i)//' vs. rho, dashed curve smoothed.')
c
         go to 15
c
      else if(lchar('A')) then
c
c  smooth all densities
c
         igsmoo=.TRUE.
         insmoo=.TRUE.
      else if(lchar('B')) then
c
c  smooth densities:  all but electron density
c
         igsmoo=.TRUE.
         insmoo=.TRUE.
         insmoo(1)=.FALSE.
c
      else if(lchar('C')) then
c
c  smooth most density profiles
c  select which ion density profiles not to smooth; use subroutine
c  to show available species
c
         insmoo=.TRUE.
         insmoo(1)=.FALSE.
         ismoo_save=nsmoo(1:num_species)
         nsmoo(1:num_species)=insmoo
 20      continue
         if(lxout(0)) call trxpl_mkgs2_summ(luntty,' (profile data)')
         call uread('enter # of specie to exclude, or "Q":$')
         if(lchar('Q')) go to 30
         i=idcod(iert)
         if(iert.ne.0) go to 20
         if((i.lt.1).or.(i.gt.num_species)) then
            call uermsi(
     >         '?trxpl_mkgs2_smoo:  enter species code btw 1 and ',
     >         num_species,0)
            go to 20
         endif
         insmoo(i)=.FALSE.
         nsmoo(i)=.FALSE.
         go to 20
 30      continue
         nsmoo(1:num_species)=ismoo_save
         igsmoo=.FALSE.
         do i=1,num_species
            if(insmoo(i)) igsmoo=.TRUE.
         enddo
c
      else if(lchar('T')) then
c
c  smooth electron temperature
c
         igsmoo=.TRUE.
         itsmoo(1)=.TRUE.
      else if(lchar('S')) then
c
c  smooth ion temperature
c
         igsmoo=.TRUE.
         do i=1,num_species
            if((ltype(i).eq.1).or.(ltype(i).eq.2)) itsmoo(i)=.TRUE.
         enddo
c
      else if(lchar('U')) then
c
c  smooth a fast ion "temperature" profile
c
 50      continue
         if(lxout(0)) call trxpl_mkgs2_summ(luntty,' (profile data)')
         call uread('enter # of FAST ion specie to smooth, or "Q":$')
         if(.not.lchar('Q')) then
            i=idcod(iert)
            if(iert.ne.0) go to 50
            if((i.lt.1).or.(i.gt.num_species)) then
               call uermsi(
     >          '?trxpl_mkgs2_smoo:  enter valid species code, max is ',
     >            num_species,0)
               go to 50
            else if(ltype(i).le.2) then
               call uermsg('?trxpl_mkgs2_smoo:  not a FAST specie:',
     >            slabel(i),0)
               go to 50
            endif
            itsmoo(i)=.TRUE.
            igsmoo=.TRUE.
         endif
c
      else if(lchar('V')) then
c
c  smooth ALL "tempererature" profiles thermal & fast
c
         itsmoo=.TRUE.
         igsmoo=.TRUE.
c
      else
         call uermsg('?trxpl_mkgs2_smoo: invalid option.',' ',0)
      endif
c
      if(igsmoo) then
         if(lxout(0)) then
            write(luntty,*)
     >         ' smoothing parameter "delta" is in units of "rho"'
            write(luntty,*)
     >         ' base of triangular weighting function for smoothing'
            write(luntty,*)
     >         ' convolution is of width 2*delta.  The allowed range'
            write(luntty,*)
     >         ' for delta is between 0.0 and 0.2.'
            delta(1)=0.0
         endif
         call ureadr8('enter smoothing delta (0 for no smoothing):$',
     >      delta(1))
         delta=max(0.0d0,min(0.2d0,delta(1)))
         if(delta(1).gt.0.0) then
            itiflag=0
            inzflag=0
            do i=1,num_species
               j=0
               if(insmoo(i)) then
                  j=1
                  call eq_rgetf(nrho,rho,id_norig(i),0,f,ierr)
                  if(ierr.ne.0)
     >               call errmsg_exit('??trxpl_mkgs2_smoo 87 ?')
                  fsm=f
                  call eq_get_fname(id_norig(i),zname)
               else if(itsmoo(i)) then
                  j=2
                  call eq_rgetf(nrho,rho,id_torig(i),0,f,ierr)
                  if(ierr.ne.0)
     >               call errmsg_exit('??trxpl_mkgs2_smoo 88 ?')
                  fsm=f
                  call eq_get_fname(id_torig(i),zname)
               endif
               if(j.gt.0) then
c
c  id name for smoothed profile
                  k=min(len(zname)-2,len_trim(zname)+1)
                  zname(k:k+2)='_SM'
c
c  calculate smoothed profile
                  call r8filtr6(rho,f,fsm,nrho,
     >               epsilon,nrho,epsilon,0,delta,0,epsilon,
     >               0,epsilon,enda,endb,zdum,idum1,idum2)
c
c  store or replace result
                  call eq_gfnum(zname,id)
                  if(id.eq.0) then
                     iord=iorder
                  else
                     iord=99
                  endif
c  make the spline
                  call eqm_rhofun(iord,id_rho,zname,fsm,
     >               ibc1,zbc1,ibc2,zbc2,id,ierr)
                  if(ierr.ne.0) then
                     write(luntty,*)
     >                  ' ?? trxpl_mkgs2_smoo: eqm_rhofun error.'
                  else
                     gsmoo=.TRUE.
                     if(j.eq.1) then
                        id_nsmoo(i)=id
                        nsmoo(i)=.TRUE.
                        inzflag=1
                        dx_smooth_n(i)=delta(1)
                     else
                        id_tsmoo(i)=id
                        tsmoo(i)=.TRUE.
                        dx_smooth_t(i)=delta(1)
                     endif
                  endif
               endif                    ! j.gt.0, i.e. profile to be smoothed
c
            enddo                       ! species loop
c
c  if a density was smoothed, do quasineutrality renormalization
            if(inzflag.gt.0) then
               allocate(nprof(nrho),zprof(nrho))
c  compute renormalization profile
               fsm=0.0d0
               do i=1,num_species
                  if(nsmoo(i)) then
                     id=id_nsmoo(i)
                  else
                     id=id_norig(i)
                  endif
                  call eq_rgetf(nrho,rho,id,0,nprof,ierr)
                  if(ierr.ne.0)
     >               call errmsg_exit('??trxpl_mkgs2_smoo 45 ?')
                  if(ltype(i).eq.0) then
                     f=nprof
                  else
                     zprof=Zplas(i)
                     if(id_zprof(i).gt.0) then
                        call eq_rgetf(nrho,rho,id_zprof(i),0,zprof,ierr)
                        if(ierr.ne.0)
     >                     call errmsg_exit('??trxpl_mkgs2_smoo 46 ?')
                     endif
                     fsm=fsm + nprof*Zprof
                  endif
               enddo
c  renormalization profile
               f=f/fsm
               write(luntty,*) ' '
               write(luntty,*) 'quasineutrality renormalization factor:'
               do i=1,nrho
                  write(luntty,*) ' surface no. ',i,' factor = ',f(i)
               enddo
               write(luntty,*) ' '
c  apply renormalization profile & store
               do i=1,num_species
                  if((ltype(i).gt.0).and.nsmoo(i)) then
                     call eq_get_fname(id_nsmoo(i),zname)
                     call eq_rgetf(nrho,rho,id_nsmoo(i),0,nprof,ierr)
                     if(ierr.ne.0)
     >                  call errmsg_exit('??trxpl_mkgs2_smoo 47 ?')
                     nprof=f*nprof
                     call eqm_rhofun(99,id_rho,zname,nprof,
     >                  ibc1,zbc1,ibc2,zbc2,id,ierr)
                     if((ierr.ne.0).or.(id.ne.id_nsmoo(i))) then
                        call errmsg_exit(
     >                ' ??trxpl_mkgs2_smoo:  renorm eqm_rhofun error!')
                     endif
                  endif
               enddo
c
               deallocate(nprof,zprof)
            endif
c
         endif                          ! non-zero smoothing parameter
      endif                             ! smoothing was requested
c
      go to 10                          ! reprompt now
c
 900  continue
c
      deallocate(rho,f,fsm,epsilon,delta,stat=k)  ! ignore status code
c
      return
      end
