subroutine plot_fp_ce(n1)

  ! plot Coronal equilibtium data from fpreact
  use iso_c_binding, only: fp => c_double
  use physconst_mod, only: zero, one
  use periodic_table_mod
  implicit NONE
  ! data buffers -- uninitialized!

  integer, intent(in) :: n1  ! dimension info

  real(fp), dimension(:), allocatable :: te       ! Te in keV 
  real(fp), dimension(:), allocatable :: dens       ! Ne in m-3
  real(fp), dimension(:,:), allocatable :: rioniz      ! Impurity ionization rate
  real(fp), dimension(:,:), allocatable :: rrecom      ! Impurity  recombination rate
  real(fp), dimension(:,:), allocatable :: rrad        ! Impurity  radiation rate
  real(fp), dimension(:,:,:), allocatable :: rioniz3      ! Impurity ionization rate
  real(fp), dimension(:,:,:), allocatable :: rrecom3      ! Impurity  recombination rate
  real(fp), dimension(:,:,:), allocatable :: rrad3        ! Impurity  radiation rate
  real(fp), dimension(:,:), allocatable :: rcoron      ! Impurity  coronal equilibrium
  real(fp), dimension(:), allocatable :: rcorrad     ! Impurity  coronal  radiation
  real(fp), dimension(:,:), allocatable :: rcorrad3     ! Impurity  coronal  radiation
  real(fp), dimension(:,:,:), allocatable :: rcoron3      ! Impurity  coronal equilibrium
  real(fp), dimension(:), allocatable :: rcorrad_brem     ! Impurity  coronal  radiation (line+bremsstrahlung)
  real(fp), dimension(:,:), allocatable :: rcorrad_brem3  ! Impurity  coronal  radiation (line+bremsstrahlung)
  real(fp), dimension(:,:), allocatable :: rrad_brem        ! Impurity  radiation rate bremsstrahlung
  real(fp), dimension(:,:,:), allocatable :: rrad_brem3        ! Impurity  radiation rate bremsstrahlung
  real(fp), dimension(:,:), allocatable :: wk      !work array
  real(fp), dimension(:,:), allocatable :: fun,fun2    !array to be plotted
  real(fp), dimension(:), allocatable :: te_vec       ! Te in keV 

  !----------------------------------
  integer luntrm,lnout
  logical lxout,lchar

  integer izimp,jzimp
  real(fp) :: azimp
  real(fp) :: temin, temax,denmin, denmax !policy for max and min Te and Ne

  integer loglin(2) ! linear=1, log=2 -- spacing control
  logical :: ilplot,ilplot2
  integer :: iert,idcod,izch,i,iizch,jizch

  character*60 zlbl1
  character*10 zflbl,zlbl2
  character*60 zhlbl
  character*28 zhlbl1
  character*36 zhlbl2

!----------------------------------
  zlbl1='PREACT "ADPAK" database' 
  luntrm=lnout(0)
  loglin(1)=1
  loglin(2)=1
  if(lxout(0)) write(luntrm,1001)
1001 format(/ &
          'plot of coronal equilibrium of selected neutral specieimpurity as a'/ &
          'function of Te and Ne'/ &
          '(hit "," to exit)'/)
  
  do
     izimp=0
     iert=0
     if(lxout(0)) write(luntrm,*) ' enter Z impurity from 3 to 74 (58, 59, 60 not allowed)'
     !3 <= Z impurity <=74  and  58,59,60 has some  
     !problems with neutral radiation numerics,
     !so they are forbidden.
     if(lxout(0)) write(luntrm,*) ' Q -- to exit'
     call uread(' enter integer :$')
     izimp=idcod(iert)
     if(iert.ne.0) exit
     if( izimp.eq.58.or.izimp.eq.59.or.izimp.eq.60.or.izimp.lt.3.or.izimp.gt.74) then
        write(luntrm,'(a26,i3)')' You entered Z impurity = ',izimp
        write(luntrm,*)'Z impurity must be in range from 3 to 74 (58, 59, 60 not allowed).'
        cycle
     endif
     
     if(allocated(te)) deallocate(te)
     allocate(te(n1))
     if(allocated(te_vec)) deallocate(te_vec)
     allocate(te_vec(n1))
     if(allocated(dens)) deallocate(dens)
     allocate(dens(n1))
     
     call psmmx('Ne, 1/m3',denmin,denmax,dens,n1,n1,loglin(1),one,1.0E20_fp)
     
     call psmmx('Te KeV',temin, temax,te,n1,n1,loglin(2),0.01_fp,100.0_fp)
     
     if(allocated(rioniz)) deallocate(rioniz)
     allocate(rioniz(iZimp+1,n1))
     
     if(allocated(rioniz3)) deallocate(rioniz3)
     allocate(rioniz3(iZimp+1,n1,n1))
     
     if(allocated(rrecom)) deallocate(rrecom)
     allocate(rrecom(iZimp+1,n1))
     
     if(allocated(rrecom3)) deallocate(rrecom3)
     allocate(rrecom3(iZimp+1,n1,n1))
     
     if(allocated(rrad)) deallocate(rrad)
     allocate(rrad(iZimp+1,n1))
     
     if(allocated(rrad3)) deallocate(rrad3)
     allocate(rrad3(iZimp+1,n1,n1))
     
     if(allocated(rrad_brem)) deallocate(rrad_brem)
     allocate(rrad_brem(iZimp+1,n1))
     
     if(allocated(rrad_brem3)) deallocate(rrad_brem3)
     allocate(rrad_brem3(iZimp+1,n1,n1))
     
     if(allocated(rcoron)) deallocate(rcoron)
     allocate(rcoron(iZimp+1,n1))
     
     if(allocated(rcoron3)) deallocate(rcoron3)
     allocate(rcoron3(iZimp+1,n1,n1))
     
     if(allocated(rcorrad)) deallocate(rcorrad)
     allocate(rcorrad(n1))
     
     if(allocated(rcorrad3)) deallocate(rcorrad3)
     allocate(rcorrad3(n1,n1))
     
     if(allocated(rcorrad_brem)) deallocate(rcorrad_brem)
     allocate(rcorrad_brem(n1))
     
     if(allocated(rcorrad_brem3)) deallocate(rcorrad_brem3)
     allocate(rcorrad_brem3(n1,n1))
     
     if(allocated(fun)) deallocate(fun)
     allocate(fun(n1,n1))

     if(allocated(fun2)) deallocate(fun2)
     allocate(fun2(n1,n1))
     
     write(luntrm,'(i4,a36)') n1,' points are evaluating. Please wait.'
     do i=1,n1
        if(mod(i,100).eq.0) write(luntrm,'(i4,a36)')i,' points have been evaluated'
        te_vec(1:n1)=te(i)
        call imptable_ioniz_r8(iZimp, n1, te_vec, dens, iZimp+1, rioniz) !** <sigma*v*ne> Impurity ionization rate
        call imptable_recom_r8(iZimp, n1, te_vec, dens, iZimp+1, rrecom) !** <sigma*v*ne> Impurity recombination rate
        call imptable_rad_r8(iZimp, n1, te_vec, dens, iZimp+1, rrad) !** <sigma*v*ne> Impurity radiation rate (no bremsstrahlung)
        call imptable_brem_r8(iZimp, n1, te_vec, dens, iZimp+1, rrad_brem) !' ** <sigma*v*ne> Impurity bremsstrahlung ' 
        call impreaction_coronal_r8(iZimp, n1, rioniz, rrecom, iZimp+1, rcoron)
        call impreaction_coronal_rad_r8(iZimp, n1, rcoron, rrad, iZimp+1, rcorrad)
        call impreaction_coronal_rad_r8(iZimp, n1, rcoron, rrad+rrad_brem, iZimp+1, rcorrad_brem)
        rioniz3(1:izimp+1,i,1:n1)=rioniz(1:izimp+1,1:n1)
        rrecom3(1:izimp+1,i,1:n1)=rrecom(1:izimp+1,1:n1)
        rrad3(1:izimp+1,i,1:n1)=rrad(1:izimp+1,1:n1)
        rrad_brem3(1:izimp+1,i,1:n1)=rrad_brem(1:izimp+1,1:n1)
        rcoron3(1:izimp+1,i,1:n1)=rcoron(1:izimp+1,1:n1)
        rcorrad3(i,1:n1)=rcorrad(1:n1)
        rcorrad_brem3(i,1:n1)=rcorrad_brem(1:n1)
     enddo
     do
        if(lxout(0)) write(luntrm,*) &
             ' I -- ionization rate <sigma*v*ne>' 
        if(lxout(0)) write(luntrm,*) &
             ' R -- recombination rate' 
        if(lxout(0)) write(luntrm,*) &
             ' D -- radiation rate' 
        if(lxout(0)) write(luntrm,*) &
             ' C -- coronal equilibrium(CE) radiation rate' 
        if(lxout(0)) write(luntrm,*) &
             ' E -- coronal equilibrium(CE) density fraction' 
        if(lxout(0)) write(luntrm,*) &
             ' A -- coronal equilibrium(CE) average charge state' 
        if(lxout(0)) write(luntrm,*) &
             ' Q -- to exit' 
        call uread('select option:$')
        ilplot=.false. !do not make these plots
        ilplot2=.false. !do not make these plots
        if(lchar('I'))then
           zhlbl='<sigma*v*ne> ionization'
           zflbl='1/sec'
           call get_charge_state(iert)
           jizch=izch-1
           if(iert.eq.0) then
              ilplot=.true.
              fun(1:n1,1:n1)=rioniz3(izch,1:n1,1:n1)
           endif
        elseif(lchar('R'))then
           zhlbl='<sigma*v*ne> recombination rate '
           zflbl='1/sec'
           call get_charge_state(iert)
           jizch=izch-1
           if(iert.eq.0) then
              ilplot=.true.
              fun(1:n1,1:n1)=rrecom3(izch,1:n1,1:n1)
           endif
        elseif(lchar('D'))then
!radiation power per ion, if multiplying by the number ofions would give 
!actual power; multipying by the specie ion density would give radated 
!power density.
           if(lxout(0)) write(luntrm,*) &
                ' L -- line radiation rate' 
           if(lxout(0)) write(luntrm,*) &
                ' B -- line+bremsstrahlung radiation rate' 
           if(lxout(0)) write(luntrm,*) &
                ' C -- compare line and line+bremsstrahlung radiation rates' 
           if(lxout(0)) write(luntrm,*) &
                ' Q -- to exit' 
           call uread('select option:$')
           if(lchar('Q'))then
              exit
           elseif(lchar('L')) then
              zhlbl='line radiation rate'
              zflbl='watts/ion'
              call get_charge_state(iert)
              jizch=izch-1
              if(iert.eq.0) then
                 ilplot=.true.
                 fun(1:n1,1:n1)=rrad3(izch,1:n1,1:n1)
              endif
           elseif(lchar('B'))then
              zhlbl='line+brems radiation rate'
              zflbl='watts/ion'
              call get_charge_state(iert)
              jizch=izch-1
              if(iert.eq.0) then
                 ilplot=.true.
                 fun(1:n1,1:n1)=rrad_brem3(izch,1:n1,1:n1)+&
                      &rrad3(izch,1:n1,1:n1)
              endif
           elseif(lchar('C'))then
              ilplot2=.false.
              zhlbl1='line radiation rate'
              zhlbl2='line+brems radiation rate'
              zflbl='watts/ion'
              call get_charge_state(iert)
              jizch=izch-1
              if(iert.eq.0) then
                 ilplot2=.true.
                 fun(1:n1,1:n1)=rrad3(izch,1:n1,1:n1)
                 fun2(1:n1,1:n1)=rrad_brem3(izch,1:n1,1:n1)+&
                      &rrad3(izch,1:n1,1:n1)
              endif
              
           endif
        elseif(lchar('E'))then
           zhlbl='CE, density fraction'
           zflbl=' '
           call get_charge_state(iert)
           jizch=izch-1
           if(iert.eq.0) then
              ilplot=.true.
              fun(1:n1,1:n1)=rcoron3(izch,1:n1,1:n1)
           endif
        elseif(lchar('A'))then
           zhlbl='CE, average charge'
           jizch=-1
           zflbl=' '
           ilplot=.true.
           izch=1
           fun=zero
           do i=1,izimp
              fun(1:n1,1:n1)=fun(1:n1,1:n1)+i*rcoron3(i+1,1:n1,1:n1)
           enddo
        elseif(lchar('C'))then
           if(lxout(0)) write(luntrm,*) &
                ' L -- CE radiation rate, line only ' 
           if(lxout(0)) write(luntrm,*) &
                ' B -- CE radiation rate, line+bremsstrahlung ' 
           if(lxout(0)) write(luntrm,*) &
                ' C -- compare CE(line) and CE(line+bremsstrahlung) radiation rates' 
           if(lxout(0)) write(luntrm,*) &
                ' Q -- to exit' 
           call uread('select option:$')
           if(lchar('Q'))then
              exit
           elseif(lchar('L')) then
              zhlbl='CE radiation(line only)'
              zflbl='watts'
              izch=1
              jizch=-1
              ilplot=.true.
              fun(1:n1,1:n1)=rcorrad3(1:n1,1:n1)
           elseif(lchar('B'))then
              zhlbl='CE radiation rate(line+brems)'
              zflbl='watts'
              izch=1
              jizch=-1
              ilplot=.true.
              fun(1:n1,1:n1)=rcorrad_brem3(1:n1,1:n1)
           elseif(lchar('C'))then
              zhlbl1='CE radiation rate(line)'
              zhlbl2='CE radiation rate(line+brems)'
              zflbl='watts'
              izch=1
              jizch=-1
              ilplot2=.true.
              fun(1:n1,1:n1)=rcorrad3(1:n1,1:n1)
              fun2(1:n1,1:n1)=rcorrad_brem3(1:n1,1:n1)
           endif
        elseif(lchar('Q'))then
           exit
        endif

        if(ilplot.or.ilplot2) then

           if(allocated(wk))deallocate(wk)
           allocate(wk(n1,2))
           wk=zero
           ! find impurity atomic weight
           call inv_periodic_table(trim(to_periodic_table(izimp,0.,-1,1)),.true.,jzimp,azimp,iizch)
           
           zlbl2=trim(to_periodic_table(izimp,azimp,jizch,1))

        endif
        if(ilplot) then
           call r8_grf3f1(te,fun,dens,wk,n1,n1,n1,&
                & ' Te',zhlbl,' Ne','KeV' ,zflbl,'1/m3 ',zlbl1,zlbl2,0)
           cycle
        elseif(ilplot2) then
           call r8_grf3f2(te,fun,fun2,dens,wk,n1,n1,n1,&
                & ' Te',zhlbl1,zhlbl2,' Ne','KeV(Te)' ,zflbl,'1/m3(Ne)',zlbl1,zlbl2,0)
        else
           cycle
        endif
     enddo
  enddo
         


contains
  
  subroutine get_charge_state(ierr)
    integer :: ierr,iert
    ierr=1
    izch=0
22  write(luntrm,2011) izimp
2011 format(/&
          &' select charge state from 0 to ',i3/&
          &' Q -- to exit')     
    call uread(' enter integer :$')
    izch=idcod(iert)
    if(iert.ne.0) then
       ierr=1
       return
    else
       if(izch.lt.0.or.izch.gt.izimp) then
          write(luntrm,2012)izimp
2012      format(/&
               &' !wrong selected charge state'/&
               &' !must be in interval [0, ',i3,']')
          goto 22
       else
          ierr=0 
       endif
    endif
    izch=izch+1

  endsubroutine get_charge_state

end subroutine plot_fp_ce
!
subroutine psmmx(item,xmin,xmax,x,nx,nmax,loglin,xminmin,xmaxmax)
  !
  !============
  ! idecl:  explicitize implicit INTEGER declarations:
  use iso_c_binding, only: fp => c_double
  IMPLICIT NONE
  INTEGER nmax,nx,iert,ix
  !============
  ! idecl:  explicitize implicit real declarations:
  real(fp) zmin,r8dcod,zmax,xrat
  !============
  character*(*) item   ! item whose limits are being set
  real(fp) xmin,xmax       ! the set limits (output)
  real(fp) x(nmax)         ! x array spanning the limits (output)
  integer loglin       ! linear=1, log=2 -- spacing control
  real(fp) xminmin         ! the min allowed lower limit (xmin)
  real(fp) xmaxmax         ! the max allowed upper limit (xmax)
  !
  logical lxout,lchar
  !
  character*12 cspc(2)
  data cspc/'linear      ','logarithmic '/
  !
  !--------------------------------------------
  !
5 continue
  if(lxout(0)) write(6,1000) item,xminmin,xmaxmax
1000 format(' hard ',a,' limits:  ',1pe11.4,' to ',1pe11.4)
  !
1001 format(/&
  &' %psmmx:  enter "L" to toggle log/linear spacing control.'/&
  &'  current setting:  ',a)
  !
10 continue
  if(lxout(0)) write(6,1001) cspc(loglin)
  call uread('plotsig:  enter '//item//' lower limit:$')
  if(lchar('L')) then
     loglin=3-loglin
     go to 10
  endif
  zmin=r8dcod(iert)
  if(iert.ne.0) go to 10
!
20 continue
  if(lxout(0)) write(6,1001) cspc(loglin)
  call uread('plotsig:  enter '//item//' upper limit:$')
  if(lchar('L')) then
     loglin=3-loglin
     go to 20
  endif
  zmax=r8dcod(iert)
  if(iert.ne.0) go to 10
  !
  xmin=min(zmin,zmax)
  xmax=max(zmin,zmax)
  !
  if((xmin.lt.xminmin).or.(xmax.gt.xmaxmax)) then
     call uermsg('?psmmx:  hard limits exceeded.',' ',0)
     go to 5
  endif
  !
  !------------------------------------
  !  get no. of pts.
  !
  nx = nmax
  !
  !-------------------------------------
  !  build x vector
  !
  if(loglin.eq.1) then
     !
     do ix=1,nx
        x(ix)=xmin+(ix-1)*(xmax-xmin)/(nx-1)
     enddo
     !
  else
     !
     x(1)=xmin
     xrat=xmax/xmin
     do ix=2,nx
        x(ix)=xmin*xrat**((ix-1)/(nx-1))
     enddo
     !
  endif
  !
  return
end subroutine psmmx

