subroutine plot_fp_fs(n1,n2,evec1,tvec1,fvec1,evec2,tvec2,wkvec,farr)

  ! plot FS data from fpreact

  use iso_c_binding, only: fp => c_double
  use fpreact_parameters

  implicit NONE

  ! data buffers -- uninitialized!

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

  real(fp) :: evec1(n1)             ! E-vector for f(E) plot
  real(fp) :: tvec1(n1)             ! T-vector for f(T) plot
  real(fp) :: fvec1(n1)             ! for f(E) plot or f(T) plot
  real(fp), dimension(:), allocatable :: fvec1_dpc
  real(fp) :: evec2(n2),tvec2(n2)   ! E,T for f(E,T) plot
  real(fp) :: wkvec(max(n1,n2))
  real(fp) :: farr(n2,n2)           ! for f(E,T) plot

  !----------------------------------
  real(fp) :: xvec2(n2)             ! pitch grid for gyro-avg fusn rate coeff plots

  integer luntrm,lnout
  logical lxout,lchar

  integer ifusn,ihandle,idum1,idum2,iopt,i

  real(fp) erange1,erange2,trange1,trange2,xrange1,xrange2

  character*60 zlbl1,zlbl2,zlbl3

  character*30 flbl
  character*15 funs
  character*10 zbzi

  character*6 rlbl
  real(fp) zamu,zv
  CHARACTER*6 ckxtyp ! log/linear
  integer:: kxtyp,idcod,iert
  real(fp)::zxmin,zxmax,efac
  real*4 :: z_xmin, z_xmax ! do not change real*4 to real(fp)
!----------------------------------

  luntrm=lnout(0)

  zlbl1='preact/fpreact "FS" database'

  luntrm=lnout(0)
  
  !------------------------------
10 continue

  if(lxout(0)) write(luntrm,1001)
1001 format(/ &
          'plot of fusion rate coefficients for select fusion reactions:'/ &
          '  1) DDp -- DD proton branch'/ &
          '  2) DDn -- DD neutron branch'/ &
          '  3) D->T -- DT, D -> T target'/ &
          '  4) T->D -- DT, T -> D target'/ &
          '  5) TT -- TT fusion'/ &
          '  12) TT -- TT fusionm DPC fit 06/2018'/ &
          '  6) D->3 -- D-He3, D -> He3 target'/ &
          '  7) 3->D -- D-He3, He3 -> D target'// &
          '[sigma*v] vs. energy -> cold target'/ &
          'beam-target <sigma*V>(Eb,Ti) table'/ &
          'beam-beam <sigma*V>(Eb,x) table'/ &
          'thermonuclear <<sigma*V>>(Ti) table')

  ifusn=0
  call ureadi('select fusion reaction to look at (1-7) or 12; 0 to quit:$',ifusn)
  if((ifusn.lt.0).or.(ifusn.gt.7.and.ifusn.ne.12)) then
     call uermsi('?plot_fp_fs.f90: unrecognized reaction code.',ifusn,0)
     go to 10
  endif
  if(ifusn.eq.0) then
     return
  else if(ifusn.eq.1) then
     call fusn_handle_ddp(ihandle)
     rlbl='DDp '
     zamu=2  ! AMU of projectile
  else if(ifusn.eq.2) then
     call fusn_handle_ddn(ihandle)
     rlbl='DDn '
     zamu=2  ! AMU of projectile
  else if(ifusn.eq.3) then
     call fusn_handle_dt(ihandle)
     rlbl='D->T'
     zamu=2  ! AMU of projectile
  else if(ifusn.eq.4) then
     call fusn_handle_td(ihandle)
     rlbl='T->D'
     zamu=3  ! AMU of projectile
  else if(ifusn.eq.5) then
     call fusn_handle_tt(ihandle)
     rlbl=' TT '
     zamu=3  ! AMU of projectile
  else if(ifusn.eq.12) then
     call fusn_handle_dpctt(ihandle)
     rlbl='dpcTT '
     zamu=3  ! AMU of projectile
  else if(ifusn.eq.6) then
     call fusn_handle_d3(ihandle)
     rlbl='D->He3'
     zamu=2  ! AMU of projectile 
  else if(ifusn.eq.7) then
     call fusn_handle_3d(ihandle)
     rlbl='He3->D'
     zamu=3  ! AMU of projectile
  endif

  do
     if(lxout(0)) write(luntrm,*) ' "Q" to quit;'
     if(lxout(0)) write(luntrm,*) ' ..."C" for cross-section;'
     if(lxout(0)) write(luntrm,*) ' ..."0" for cold target sigma*v;'
     if(lxout(0)) write(luntrm,*) ' ..."1" for beam-target table;'
     if(lxout(0)) write(luntrm,*) ' ..."2" for beam-beam table;'
     if(lxout(0)) write(luntrm,*) ' ..."3" for thermonuclear table;'
     call uread('enter "0" for cold target plot; "1" for beam-target table:$')

     if(lchar('Q')) then
        exit
     else if(lchar('C')) then
        iopt=-1
     else if(lchar('0')) then
        iopt=0
     else if(lchar('1')) then
        iopt=1
     else if(lchar('2')) then
        iopt=2
     else if(lchar('3')) then
        iopt=3
     else
        call uermsg('plot_fp_fs: invalid option.',' ',0)
        cycle
     endif

     if(iopt.le.0) then
        if(iopt.eq.0) then
           zlbl2='[sigma*v](E) fusion rate coefficient'
           zlbl3 = rlbl//' fusion, cold target, vs. projectile energy'
           funs='m**3/sec'
        else
           zlbl2='[sigma](E) fusion cross section'
           zlbl3 = rlbl//' fusion cross section vs. projectile energy'
           funs='m**2'
        endif

        !  get [sigma*v] table range
        call fs_coldtarget_erange(ihandle,erange1,erange2,idum1,idum2)
        ckxtyp='LOG'
        kxtyp=1
102     CONTINUE        
        IF(LXOUT(0)) WRITE(LUNTRM,1002) erange1,erange2,ckxtyp
        CALL UREAD('plot_fpreact: enter CONTROL OPTION:$$')
        IF(LCHAR('X')) THEN
           Z_XMIN= real(erange1)
           CALL UREADF('plot_fpreact:  ENTER NEW XMIN:$$',Z_XMIN)
           zxmin=z_xmin*1.0_fp
           Z_XMAX= real(erange2)
           CALL UREADF('plot_fpreact:  ENTER NEW XMAX:$$',Z_XMAX)
           zxmax=z_xmax*1.0_fp
           erange1=AMAX1(0.001,AMIN1(ZXMIN,ZXMAX))
           erange2=AMAX1(0.001,ZXMIN,ZXMAX)
           IF(erange2.LE.erange1) erange2=1.1*erange1
           CALL UREAD('plot_fpreact:  ENTER 1 for LOG or 2 for LINEAR:$$')
           kxtyp=idcod(iert)
           if(kxtyp.eq.2) then
              ckxtyp='LINEAR'
           endif
           if(kxtyp.eq.1) then
              ckxtyp='LOG'
           endif
           GO TO 102
        endif
        call plot_fp_mkvec(erange1,erange2,n1,evec1)

        if(ifusn.eq.1) then
           call fusn_coldtarget_DDn(evec1,fvec1,n1)
        else if(ifusn.eq.2) then
           call fusn_coldtarget_DDp(evec1,fvec1,n1)
        else if(ifusn.eq.3) then
           call fusn_coldtarget_DT(evec1,fvec1,n1)
        else if(ifusn.eq.4) then
           call fusn_coldtarget_TD(evec1,fvec1,n1)
        else if(ifusn.eq.5) then
           call fusn_coldtarget_TT(evec1,fvec1,n1)
        else if(ifusn.eq.12) then
           if(allocated(fvec1_dpc)) deallocate(fvec1_dpc)
           allocate(fvec1_dpc(n1))
           fvec1_dpc=0.0
           fvec1=0.0
           if(iopt.lt.0) then
              zlbl2='<<sigma>>,TT--fusn cross section: DPC--solid, old--dashed'
              zlbl3 = ' TT fusion, fusn cross section, vs. projectile energy'
          else
              zlbl2='<<sigma*v>>,TT--fusn rate coeff: DPC--solid, old--dashed'
              zlbl3 = ' TT fusion, cold target, vs. projectile energy'
           endif
           call fusn_coldtarget_dpcTT(evec1,fvec1_dpc,n1)
           call fusn_coldtarget_TT(evec1,fvec1,n1)
        else if(ifusn.eq.6) then
           call fusn_coldtarget_D3(evec1,fvec1,n1)
        else if(ifusn.eq.7) then
           call fusn_coldtarget_3D(evec1,fvec1,n1)
        endif
        efac=1.0
        if(iopt.lt.0) then
           do i=1,n1
              efac=zamu/(zamu+zamu)
              zv=sqrt(1000.0*evec1(i)*efac/zamu)*1.384e4  ! m/sec
              fvec1(i)=fvec1(i)/zv  ! convert to sigma (m**2)
              if(ifusn.eq.12) then
                 fvec1_dpc(i)=fvec1_dpc(i)/zv  ! convert to sigma (m**2)
              endif
           enddo
        endif
        if(ifusn.eq.12) then
           if(kxtyp.eq.1) then
              call gaxspc(3) ! log-log
           else if(kxtyp.eq.2) then
              call gaxspc(2) ! lin-log
           endif
           CALL r8_GRAFX2(evec1,fvec1_dpc,fvec1,n1,'KeV',funs,zlbl1,zlbl2,zlbl3)
        else
           call gaxspc(3) ! log-log
           call r8_grafx1(evec1,fvec1,n1,'KeV',funs,zlbl1,zlbl2,zlbl3)
        endif
        call gaxspc(1) ! restore default

     else if(iopt.eq.1) then
        ! get table range information
        call fs_warmtarget_erange(ihandle,erange1,erange2,idum1,idum2)
        call fs_warmtarget_trange(ihandle,trange1,trange2,idum1,idum2)
        call plot_fp_mkvec(erange1,erange2,n2,evec2)
        call plot_fp_mkvec(trange1,trange2,n2,tvec2)

        flbl=rlbl//' beam-target <sigma*v>'
        funs='m**3/sec'

        do i=1,n2
           wkvec(1:n2)=tvec2(i)
           if(ifusn.eq.1) then
              call fusn_btsigv_ddp(evec2,wkvec(1:n2),farr(1:n2,i),n2)
           else if(ifusn.eq.2) then
              call fusn_btsigv_ddn(evec2,wkvec(1:n2),farr(1:n2,i),n2)
           else if(ifusn.eq.3) then
              call fusn_btsigv_dt(evec2,wkvec(1:n2),farr(1:n2,i),n2)
           else if(ifusn.eq.4) then
              call fusn_btsigv_td(evec2,wkvec(1:n2),farr(1:n2,i),n2)
           else if(ifusn.eq.5) then
              call fusn_btsigv_tt(evec2,wkvec(1:n2),farr(1:n2,i),n2)
           else if(ifusn.eq.12) then
              call fusn_btsigv_dpctt(evec2,wkvec(1:n2),farr(1:n2,i),n2)
           else if(ifusn.eq.6) then
              call fusn_btsigv_d3(evec2,wkvec(1:n2),farr(1:n2,i),n2)
           else if(ifusn.eq.7) then
              call fusn_btsigv_3d(evec2,wkvec(1:n2),farr(1:n2,i),n2)
           endif
        enddo

        wkvec=0
        call r8_grf3f1(evec2,farr,tvec2,wkvec,n2,n2,n2, &
             'beam Eb',flbl,'target Ti', &
             'KeV(Eb)',funs,'KeV(Ti)',zlbl1,'beam-target',0)

     else if(iopt.eq.2) then
        if(ifusn.eq.4) then
           call uermsg(' %use D->T for all DT beam-beam data.',' ',0)
           cycle
        else if(ifusn.eq.7) then
           call uermsg(' %use D->3 for all D-He3 beam-beam data.',' ',0)
           cycle
        endif
        ! get table range information
        call fs_gyroavg_erange(ihandle,erange1,erange2,idum1,idum2)
        call fs_gyroavg_varrange(ihandle,trange1,trange2,idum1,idum2)
        call plot_fp_mkvec(erange1,erange2,n2,evec2)
        do i=1,n2-1
           tvec2(i)=trange1+(i-1)*(trange2-trange1)/(n2-1)
        enddo
        tvec2(n2)=trange2

        flbl=rlbl//' beam-beam <sigma*v>'
        funs='m**3/sec'

        do i=1,n2
           wkvec(1:n2)=tvec2(i)
           if(ifusn.eq.1) then
              call fusn_bbsigv_ddp(evec2,wkvec(1:n2),farr(1:n2,i),n2)
           else if(ifusn.eq.2) then
              call fusn_bbsigv_ddn(evec2,wkvec(1:n2),farr(1:n2,i),n2)
           else if(ifusn.eq.3) then
              call fusn_bbsigv_dt(evec2,wkvec(1:n2),farr(1:n2,i),n2)
           else if(ifusn.eq.5) then
              call fusn_bbsigv_tt(evec2,wkvec(1:n2),farr(1:n2,i),n2)
           else if(ifusn.eq.12) then
              call fusn_bbsigv_dpctt(evec2,wkvec(1:n2),farr(1:n2,i),n2)
           else if(ifusn.eq.6) then
              call fusn_bbsigv_d3(evec2,wkvec(1:n2),farr(1:n2,i),n2)
           endif
        enddo

        wkvec=0
        call r8_grf3f1(evec2,farr,tvec2,wkvec,n2,n2,n2, &
             'beam Eb',flbl,'variance', &
             'KeV(Eb)',funs,'fraction',zlbl1,'beam-beam',0)

     else if(iopt.eq.3) then

        zlbl2='<<sigma*v>>(Ti) fusion rate coefficient'
        zlbl3 = rlbl//' thermonuclear fusion vs. Ti'
        funs='m**3/sec'

        !  get [sigma*v] table range
        call fs_thermonuclear_trange(ihandle,trange1,trange2,idum1,idum2)
        ckxtyp='LOG'
        kxtyp=1
101     CONTINUE        
        IF(LXOUT(0)) WRITE(LUNTRM,1002) trange1,trange2,ckxtyp
1002    FORMAT(/&
             &'  A -- except settings'/&
             &'  X -- TO SET ENERGY RANGE (KEV) OF PLOT, CURRENTLY'/&
             &'       XMIN,XMAX=',2(1X,1PE11.4),' TYPE =',A6/&
             &)
        CALL UREAD('plot_fpreact:  CONTROL OPTION:$$')
        IF(LCHAR('X')) THEN
           Z_XMIN= real(trange1)
           CALL UREADF('plot_fpreact:  ENTER NEW XMIN:$$',Z_XMIN)
           zxmin=z_xmin*1.0_fp
           ZXMAX= real(trange2)
           CALL UREADF('plot_fpreact:  ENTER NEW XMAX:$$',Z_XMAX)
           zxmax=z_xmax*1.0_fp
           trange1=AMAX1(0.001,AMIN1(ZXMIN,ZXMAX))
           trange2=AMAX1(0.001,ZXMIN,ZXMAX)
           IF(trange2.LE.trange1) trange2=1.1*trange1
           CALL UREAD('plot_fpreact:  ENTER 1 for LOG or 2 for LINEAR:$$')
           kxtyp=idcod(iert)
           if(kxtyp.eq.2) then
              ckxtyp='LINEAR'
           endif
           if(kxtyp.eq.1) then
              ckxtyp='LOG'
           endif
           GO TO 101
        endif
        call plot_fp_mkvec(trange1,trange2,n1,tvec1)

        if(ifusn.eq.1) then
           call fusn_thermo_DDn(tvec1,fvec1,n1)
        else if(ifusn.eq.2) then
           call fusn_thermo_DDp(tvec1,fvec1,n1)
        else if(ifusn.eq.3) then
           call fusn_thermo_DT(tvec1,fvec1,n1)
        else if(ifusn.eq.4) then
           call fusn_thermo_TD(tvec1,fvec1,n1)
        else if(ifusn.eq.5) then
           call fusn_thermo_TT(tvec1,fvec1,n1)
        else if(ifusn.eq.12) then
           if(allocated(fvec1_dpc)) deallocate(fvec1_dpc)
           allocate(fvec1_dpc(n1))
           fvec1_dpc=0.0
           fvec1=0.0
           zlbl2='<<sigma*v>>,TT--fusn rate coeff: DPC--solid, old--dashed'
           zlbl3 = ' TT thermonuclear fusion vs. Ti'
           call fusn_thermo_dpcTT(tvec1,fvec1_dpc,n1)
           call fusn_thermo_TT(tvec1,fvec1,n1)
        else if(ifusn.eq.6) then
           call fusn_thermo_D3(tvec1,fvec1,n1)
        else if(ifusn.eq.7) then
           call fusn_thermo_3D(tvec1,fvec1,n1)
        endif
        if(ifusn.eq.12) then
           if(kxtyp.eq.1) then
              call gaxspc(3) ! log-log
           else if(kxtyp.eq.2) then
              call gaxspc(2) ! lin-log
           endif
           CALL r8_GRAFX2(tvec1,fvec1_dpc,fvec1,n1,'KeV',funs,zlbl1,zlbl2,zlbl3)
        else
           call gaxspc(3) ! log-log
           call r8_grafx1(tvec1,fvec1,n1,'KeV',funs,zlbl1,zlbl2,zlbl3)
        endif
        call gaxspc(1) ! restore default
     endif
     
  enddo
  go to 10

end subroutine plot_fp_fs
