!---------------------------------------------------------------------
! adas_mog.f90: by M.Gorelenkova                                      
!               created 07/2009                                       
!               based on Michael Kraus routines                       
!                                                                     
!  Module which computes reaction rate coefficient tables once and stores these as files;
!  once a table is computed, it is not recomputed, but simply read in
!  for interpolation.  
!  All energies & temperatures in KeV/amu
!  All rate coefficients <sigma*v> in m**3/sec.
!
! subroutine adas_btsigv -- calculates beam-target maxwellian average <sig*v> (Eb/Ab,Ti/Ai)
!                           for neutralizing CX and II reactions, available for H and He. 

!
! subroutine adas_adas_sigvte_ioniz  --  calculates ionization of neutrals by electron impact
!                                        rate coefficients <sigma*v> averaged over Maxwellian electron
!                                        distribution characterized by temperature Te (KeV),
!                                        available only for H. 
!
! subroutine adas_zstop_sigvz -- calculates sig*v tables of neutral stopping   
!                                on fully stripped light impurities (vs. Erel only); 
!                                as a sum of sig*v for ionization (includes non-neutralazing CX). 
!                                Data for H and He neutral atoms are available.
!
! subroutine adas_sigv -- calculates sig*v(Eb/Ab) for neutralizing charge-exchange reaction 
!                         and impact ionization which includes  non-neutralizing 
!                         charge-exchange reaction. Data for H and He neutral atoms are available.
!
! subroutine adas_sigv --  creates tables for  CX and ionization cross section sig(Eb/Ab). 
!                          Data for H and He neutral atoms are available. 
!
! subroutine adas_bms  -- computes beam stopping rate coefficient on impurities for H - beam.
!                         Routine uses  EQUIVALENT of  Electron Density [cm**-3]
!                         N_el*SUM(Z_imp^2* N_imp)/SUM(Z_imp * N_imp)/Z_imp, where
!                         N_el -- electron density and impurity density 
!                         N_imp -- impurity density 
!                         for details see [1],p.794
!
! All routines try to open pre-computed tables for an asking reaction in $ADASDIR/tables/...
! directory. If these tables had been created early then data will be read and interpolated, if
! not then table will be computed and wrote to the $ADASDIR/tables/... first.
!
! References:                                                         
!                                                                     
!    1. H. Anderson et al. (2000)                                     
!       "Neutral beam stopping and emission in fusion plasmas I"      
!       Plasma Physics and Controlled Fusion Vol. 42, pp 781-806      
!                                                                     
!    2. H. P. Summers (2004)                                          
!       "The ADAS User Manual v2.6"                                   
!       http://www.adas.ac.uk/manual.php                              
!                                                                     
!---------------------------------------------------------------------
Module adas_mod

  use iso_c_binding, only: fp => c_double
  use ezcdf
  implicit none
! 
  character*140  :: adas_tables_file            !file name for table
  character*9 :: cizneut, cizion                !character izneut and izion
  character*8 nctype                            !for ezcdf
  integer IDIMS(10)                             !for ezcdf
  real(fp), dimension(8) :: axis_param_warmTarget !axis parameters(E[KeV/amu],T[KeV/amu]) for table: 
                                                !min, max values, number of points,
                                                !specification 0 for LOG, 1 for LIN
!
  real(fp),SAVE,dimension(4) :: axis_param_coldTarget !axis parameters(E[KeV/amu]) for table: 
                                                !min, max values, number of points,
                                                !specification 0 for LOG, 1 for LIN
  integer,SAVE :: npts                               ! number of points for table
  real(fp),SAVE, dimension(:,:),allocatable :: sigv_table_prev ! tabulated sig*v  
  character*240, SAVE :: filename_prev(2)=(/'NONE','NONE'/)   ! filename from prev call
  integer, SAVE :: npts_prev(2)
  real(fp) :: xlr                                 ! If XLR>0, then the X grid is equally spaced on a logarithmic scale:
                                                ! LINEAR IF XLR .LE. 0.0
  integer :: fadas_CX, fadas_II                 !reaction type, convetrted to adas routine: 3,4  ='CX', 1,2 = 'II'
  integer :: iwarn_adas, fErr, icdf, ilen, iopen_file
!
  PUBLIC :: check_data_react
  PUBLIC :: adas_btsigv
  PUBLIC :: adas_sigvte_ioniz
  PUBLIC :: adas_zstop_sigvz
  PUBLIC :: adas_sigv
  PUBLIC :: adas_sig
  PUBLIC :: adas_bms
!
  interface adas_btsigv
     module procedure adas_btsigv_int_int,adas_btsigv_int_r8,adas_btsigv_r8_r8,adas_btsigv_r8_int
  end interface
!
  interface adas_sigvte_ioniz
     module procedure adas_sigvte_ioniz_r8,adas_sigvte_ioniz_int
  end interface
!
  interface adas_zstop_sigvz
     module procedure adas_zstop_sigvz_int_int,adas_zstop_sigvz_int_r8,adas_zstop_sigvz_r8_int,adas_zstop_sigvz_r8_r8
  end interface
!
  interface adas_sigv
     module procedure adas_sigv_int_int,adas_sigv_int_r8,adas_sigv_r8_int,adas_sigv_r8_r8
  end interface
!
  interface adas_sig
     module procedure adas_sig_int_int,adas_sig_int_r8,adas_sig_r8_int,adas_sig_r8_r8
  end interface
!
  interface adas_bms
     module procedure adas_bms3d_int_int,adas_bms3d_int_r8,adas_bms3d_r8_int,adas_bms3d_r8_r8
     module procedure adas_bms1d_int_int,adas_bms1d_int_r8,adas_bms1d_r8_int,adas_bms1d_r8_r8
     module procedure adas_bms2d_int_int,adas_bms2d_int_r8,adas_bms2d_r8_int,adas_bms2d_r8_r8
  end interface

contains
!
!---------------------------------------------------------------------
!
  subroutine adas_bms3d_int_r8(EB, Nevec, ZB, CONC, TI,Ntvec, ZI_r8, NE, Ndvec, &
      &            SIGVI, iERR)
      
    use adas_bms_splines

    implicit none
!
!Compute beam stopping rate coefficient on impurity
!
! Function Parameters
!
!     EB(nvec) : Beam Energy                                     [KeV/amu]
!     nevec     : energy vector size
!     ZB       : Beam Particle Nuclear Charge Number             
!   CONC(ndvec): target species fraction
!              : Z_imp * N_imp/SUM(Z_imp*N_imp) (0 < conc(i) <= 1)
!              : where,
!              : Z_imp -- Particle Nuclear Charge Number 
!              : N_imp -- impurity density
!     TI    : Target Temperatures                             [KeV/amu]
!     ntvec     : Temperature vector size
!     ZI_r8    : Target Nuclear Charge Number                    
!     NE    : EQUIVALENT of  Electron Density                         [cm**-3]
!                N_el*SUM(Z_imp^2* N_imp)/SUM(Z_imp * N_imp)/Z_imp
!     ndvec     : Density  vector size
!     SIGVI(nvec,ndvec,ntvec) : Beam Stopping Rate Coefficient     [m**3 / s]
!     iERR     : Error Code (0 = OK,                             
!                            1 = unsupported beam species
!                            2 = unsupported target species
!                            3 = input data corrupted (negative beam energy, densities or temperatures)
!                            4 = input data out of range
!                            5 = adas file reading error
!                            6 = spline output data invalid (negative)
!                            7 = spline error
!                            8 = array allocation error
!                            9 = array initialisation error)
!
    real(fp),intent(in)  :: EB(nevec)
    integer,intent(in) :: ZB
    integer,intent(in) :: nevec,ndvec,ntvec
    real(fp),intent(in)  :: TI(ntvec), NE(ndvec)
    real(fp),intent(in)  ::  ZI_r8(1)
    real(fp),intent(out)  :: SIGVI(nevec,ndvec,ntvec)
    real(fp),intent(in) :: conc(ndvec)
    
    integer :: iERR
    real(fp) ::   SIGVI_wrk
    !
    !local
    integer i,ii,ij,iz 
    integer :: npts_e, npts_d, npts_t ! number of points for table
    real(fp), dimension(:,:,:),allocatable :: sigv_table ! tabulated sig*v  
    real(fp), dimension(:),allocatable :: e_vec, d_vec, t_vec
    real(fp), dimension(12) :: axis_param_excite !axis parameters (E[KeV/amu],Ne[cm-3],T[KeV/amu])
                                               !for table: min, max values, 
                                               !number of points,specification 0 for LOG, 1 for LIN
    real(fp) conc_dummy(1)
    INTEGER :: istat ! completion code; 0 = normal
                                !  istat = 2:  irtype argument invalid
                                !  istat = 3:  izneut or izchrg invalid
                                !  istat = 10:  ADAS data is requested but not found
    integer :: iZI(2),n_use !iZi - integer Zimp used to calculate sigv, n_use - 
                           !number of tables to be used, could be 1 or 2
    character*240 :: filename, filename_param    ! filename
!
    integer, parameter :: nspec = 10 ! nspec : number of plasma species in adas archive
    integer, parameter :: npts_e_param = 73, npts_d_param = 49 , npts_t_param = 73 ! number of points for table, 
                                                                                   !set by Michael Kraus, 09/14/09
    logical :: il_extrp=.true.
    integer:: npts_e_min
    character (len=4)  :: species_list(nspec)
	
    data species_list / 'h1', 'he2', 'li3', 'be4', 'b5', 'c6', 'n7', 'o8', 'f9', 'ne10' /
!

    ierr=0
    SIGVI=0.0_fp
    if(zb.gt.1) then !only H abailable
       ierr=3
       return
    endif
    call check_data_react(3,1,ZB,ZI_r8(1),iZI,n_use,ierr)!'SV' excited
    SIGVI=0.0_fp
    if(ierr.gt.0) then !error input data
       return
    endif
!
    npts_e=npts_e_param
    npts_d=npts_d_param
    npts_t=npts_t_param
!    
    write(cizneut,'(i5)') ZB
    do iz=1,n_use
       write(cizion,'(i5)') izi(iz)
       
       adas_tables_file=trim('tables/sv/ex')//'_'//&
            & trim(adjustl(cizneut))//'_'//trim(adjustl(cizion))//'.cdf'
       !
       call UFILNAM('ADASDIR',trim(adjustl(adas_tables_file)),filename)
       !
       ! try to open filename in tables directory
       call cdf_open(icdf,trim(filename),'r',fErr)
       if (fErr.ne.0) then !no table has been created
          write(6,*)' ?adas_bms3d: no lookup tables found'
          write(6,*)' ?adas_bms3d: create tables first'
          ierr=1
          return
       endif
       !tables already computed, read data 
       call cdfInqVar(icdf,'sigv_excite',idims,nctype)
       npts_e=idims(1)
       npts_d=idims(2)
       npts_t=idims(3)
       if(allocated(sigv_table))deallocate(sigv_table)
       allocate(sigv_table(npts_e,npts_d,npts_t))
       ! allocate  energy, density and temperature  vectors
       if(allocated(e_vec)) deallocate(e_vec)
       allocate(e_vec(npts_e))
       if(allocated(d_vec)) deallocate(d_vec)
       allocate(d_vec(npts_d))
       if(allocated(t_vec)) deallocate(t_vec)
       allocate(t_vec(npts_t))
       !
       call cdf_read(icdf,'sigv_excite',sigv_table(1:npts_e,1:npts_d,1:npts_t)) 
       call cdfInqVar(icdf,'energy_vec',idims,nctype)
       call cdf_read(icdf,'energy_vec',e_vec(1: npts_e))
       call cdfInqVar(icdf,'density_vec',idims,nctype)
       call cdf_read(icdf,'density_vec',d_vec(1: npts_d))
       call cdfInqVar(icdf,'temp_vec',idims,nctype)
       call cdf_read(icdf,'temp_vec',t_vec(1: npts_t))
       call cdf_close(icdf)

       !interpolate 3D table
       call adas_setSplineData3(npts_e,npts_d,npts_t,e_vec,d_vec,t_vec,sigv_table,iErr)
       do ij=1,ntvec
          do ii=1,ndvec
             do i=1,nevec
                sigvi_wrk=0.0_fp
                
                if((conc(ii).eq.0.0_fp).or.(eb(i).eq.0.0_fp).or.(ne(ii).eq.0.0_fp).or.(ti(ij).eq.0.0_fp)) cycle
                
                call adas_evalSpline3(eb(i),ne(ii),ti(ij),sigvi_wrk,il_extrp,ierr) 
                sigvi_wrk=sigvi_wrk*conc(ii) !take into accoutnt impurity fraction
                
                if(n_use.eq.2) then
                   sigvi(i,ii,ij)=sigvi(i,ii,ij)+abs(zi_r8(1)-izi(n_use-iz+1))*sigvi_wrk/2.
                elseif(n_use.eq.1) then
                   sigvi(i,ii,ij)=zi_r8(1)/izi(1)*sigvi_wrk  
                   !scale to Zimp >10 (for H beam) or to Zimp >8 (for He beam)
                endif
                
             enddo
          enddo
       enddo
    enddo !iz
    
  end subroutine adas_bms3d_int_r8

!
!---------------------------------------------------------------------
!
  subroutine adas_bms1d_int_r8(EB, Nevec, ZB, CONC, TI, ZI_r8, NE, &
      &            SIGVI,iERR)
      
    use adas_bms_splines

    implicit none
!
!  same as  adas_bms3d_int_r8 but nvec = ntvec = ndvec, SIGVI(nevec)
!
!Compute beam stopping rate coefficient on impurity
!
! Function Parameters
!
!     EB(nvec) : Beam Energy                                     [KeV/amu]
!     nevec     : energy vector size
!     ZB       : Beam Particle Nuclear Charge Number             
!   CONC(ndvec): target species fraction
!              : Z_imp * N_imp/SUM(Z_imp*N_imp) (0 < conc(i) <= 1)
!              : where,
!              : Z_imp -- Particle Nuclear Charge Number 
!              : N_imp -- impurity density
!     TI    : Target Temperatures                             [KeV/amu]
!     ntvec     : Temperature vector size
!     ZI_r8    : Target Nuclear Charge Number                    
!     NE    : EQUIVALENT of  Electron Density                         [cm**-3]
!                N_el*SUM(Z_imp^2* N_imp)/SUM(Z_imp * N_imp)/Z_imp
!     ndvec     : Density  vector size
!     SIGVI(nvec) : Beam Stopping Rate Coefficient     [m**3 / s]
!     iERR     : Error Code (0 = OK,                             
!                            1 = unsupported beam species
!                            2 = unsupported target species
!                            3 = input data corrupted (negative beam energy, densities or temperatures)
!                            4 = input data out of range
!                            5 = adas file reading error
!                            6 = spline output data invalid (negative)
!                            7 = spline error
!                            8 = array allocation error
!                            9 = array initialisation error)
!
    real(fp),intent(in)  :: EB(nevec)
    integer,intent(in) :: ZB
    integer,intent(in) :: nevec
    real(fp),intent(in)  :: TI(nevec), NE(nevec)
    real(fp),intent(in)  ::  ZI_r8(1)
    real(fp),intent(out)  :: SIGVI(nevec)
    real(fp),intent(in) :: conc(nevec)
    integer :: iERR
    real(fp) ::   SIGVI_wrk
    !
    !local
    integer i,ii,ij,iz
    integer :: npts_e, npts_d, npts_t ! number of points for table
    real(fp), dimension(:,:,:),allocatable :: sigv_table ! tabulated sig*v  
    real(fp), dimension(:),allocatable :: e_vec, d_vec, t_vec
    real(fp), dimension(12) :: axis_param_excite !axis parameters (E[KeV/amu],Ne[cm-3],T[KeV/amu])
                                               !for table: min, max values, 
                                               !number of points,specification 0 for LOG, 1 for LIN
    real(fp) conc_dummy(1)
    INTEGER :: istat ! completion code; 0 = normal
                                !  istat = 2:  irtype argument invalid
                                !  istat = 3:  izneut or izchrg invalid
                                !  istat = 10:  ADAS data is requested but not found
    integer :: iZI(2),n_use !iZi - integer Zimp used to calculate sigv, n_use - 
                           !number of tables to be used, could be 1 or 2
    character*240 :: filename, filename_param    ! filename
!
    integer, parameter :: nspec = 10 ! nspec : number of plasma species in adas archive
    integer, parameter :: npts_e_param = 73, npts_d_param = 49 , npts_t_param = 73 ! number of points for table, 
                                                                                   !set by Michael Kraus, 09/14/09
    logical :: il_extrp=.true.
    integer:: npts_e_min
    character (len=4)  :: species_list(nspec)

	
    data species_list / 'h1', 'he2', 'li3', 'be4', 'b5', 'c6', 'n7', 'o8', 'f9', 'ne10' /
!

    ierr=0
    SIGVI=0.0_fp
    if(zb.gt.1) then !only H abailable
       ierr=3
       return
    endif
    call check_data_react(3,1,ZB,ZI_r8(1),iZI,n_use,ierr)!'SV' excited
    SIGVI=0.0_fp
    if(ierr.gt.0) then !error input data
       return
    endif
!
    npts_e=npts_e_param
    npts_d=npts_d_param
    npts_t=npts_t_param
!    
    write(cizneut,'(i5)') ZB
    do iz=1,n_use
       write(cizion,'(i5)') izi(iz)
       
       adas_tables_file=trim('tables/sv/ex')//'_'//&
            & trim(adjustl(cizneut))//'_'//trim(adjustl(cizion))//'.cdf'
       !
       call UFILNAM('ADASDIR',trim(adjustl(adas_tables_file)),filename)
       !
       ! try to open filename in tables directory
       call cdf_open(icdf,trim(filename),'r',fErr)
       if (fErr.ne.0) then !no table has been created
          write(6,*)' ?adas_bms1d: no lookup tables found'
          write(6,*)' ?adas_bms1d: create tables first'
          ierr=1
          return
       endif
       !tables already computed, read data 
       call cdfInqVar(icdf,'sigv_excite',idims,nctype)
       npts_e=idims(1)
       npts_d=idims(2)
       npts_t=idims(3)
       if(allocated(sigv_table))deallocate(sigv_table)
       allocate(sigv_table(npts_e,npts_d,npts_t))
       ! allocate  energy, density and temperature  vectors
       if(allocated(e_vec)) deallocate(e_vec)
       allocate(e_vec(npts_e))
       if(allocated(d_vec)) deallocate(d_vec)
       allocate(d_vec(npts_d))
       if(allocated(t_vec)) deallocate(t_vec)
       allocate(t_vec(npts_t))
       !
       call cdf_read(icdf,'sigv_excite',sigv_table(1:npts_e,1:npts_d,1:npts_t)) 
       call cdfInqVar(icdf,'energy_vec',idims,nctype)
       call cdf_read(icdf,'energy_vec',e_vec(1: npts_e))
       call cdfInqVar(icdf,'density_vec',idims,nctype)
       call cdf_read(icdf,'density_vec',d_vec(1: npts_d))
       call cdfInqVar(icdf,'temp_vec',idims,nctype)
       call cdf_read(icdf,'temp_vec',t_vec(1: npts_t))
       call cdf_close(icdf)

       !interpolate 3D table
       call adas_setSplineData3(npts_e,npts_d,npts_t,e_vec,d_vec,t_vec,sigv_table,iErr)
       do i=1,nevec
          sigvi_wrk=0.0_fp
          if((conc(i).eq.0.0_fp).or.(eb(i).eq.0.0_fp).or.(ne(i).eq.0.0_fp).or.(ti(i).eq.0.0_fp)) cycle
          
          call adas_evalSpline3(eb(i),ne(i),ti(i),sigvi_wrk,il_extrp,ierr) 
          sigvi_wrk=sigvi_wrk*conc(i) !take into accoutnt impurity fraction
          
          if(n_use.eq.2) then
             sigvi(i)=sigvi(i)+abs(zi_r8(1)-izi(n_use-iz+1))*sigvi_wrk/2.
          elseif(n_use.eq.1) then
             sigvi(i)=zi_r8(1)/izi(1)*sigvi_wrk  !scale to Zimp >10 (for H beam) or to Zimp >8 (for He beam)
          endif
          
       enddo
    enddo !iz
    
  end subroutine adas_bms1d_int_r8
!
!---------------------------------------------------------------------
!
  subroutine adas_bms2d_int_r8(EB, Nevec, ZB, CONC, TI,Ntvec, ZI_r8, NE,  &
      &            SIGVI, iERR)
      
    use adas_bms_splines

    implicit none
!
!  same as  adas_bms3d_int_r8 but ntvec = ndvec, SIGVI(nevec,ntvec)
!
!Compute beam stopping rate coefficient on impurity
!
! Function Parameters
!
!     EB(nvec) : Beam Energy                                     [KeV/amu]
!     nevec     : energy vector size
!     ZB       : Beam Particle Nuclear Charge Number             
!   CONC(ntvec): target species fraction
!              : Z_imp * N_imp/SUM(Z_imp*N_imp) (0 < conc(i) <= 1)
!              : where,
!              : Z_imp -- Particle Nuclear Charge Number 
!              : N_imp -- impurity density
!     TI    : Target Temperatures                             [KeV/amu]
!     ntvec     : Temperature vector size
!     ZI_r8    : Target Nuclear Charge Number                    
!     NE    : EQUIVALENT of  Electron Density                         [cm**-3]
!                N_el*SUM(Z_imp^2* N_imp)/SUM(Z_imp * N_imp)/Z_imp
!     ntvec     : Density  vector size
!     SIGVI(nvec,ntvec) : Beam Stopping Rate Coefficient     [m**3 / s]
!     iERR     : Error Code (0 = OK,                             
!                            1 = unsupported beam species
!                            2 = unsupported target species
!                            3 = input data corrupted (negative beam energy, densities or temperatures)
!                            4 = input data out of range
!                            5 = adas file reading error
!                            6 = spline output data invalid (negative)
!                            7 = spline error
!                            8 = array allocation error
!                            9 = array initialisation error)
!
    real(fp),intent(in)  :: EB(nevec)
    integer,intent(in) :: ZB
    integer,intent(in) :: nevec,ntvec
    real(fp),intent(in)  :: TI(ntvec), NE(ntvec)
    real(fp),intent(in)  ::  ZI_r8(1)
    real(fp),intent(out)  :: SIGVI(nevec,ntvec)
    real(fp),intent(in) :: conc(ntvec)
    integer :: iERR
    real(fp) ::   SIGVI_wrk
    !
    !local
    integer i,ii,ij,iz 
    integer :: npts_e, npts_d, npts_t ! number of points for table
    real(fp), dimension(:,:,:),allocatable :: sigv_table ! tabulated sig*v  
    real(fp), dimension(:),allocatable :: e_vec, d_vec, t_vec
    real(fp), dimension(12) :: axis_param_excite !axis parameters (E[KeV/amu],Ne[cm-3],T[KeV/amu])
                                               !for table: min, max values, 
                                               !number of points,specification 0 for LOG, 1 for LIN
    real(fp) conc_dummy(1)
    INTEGER :: istat ! completion code; 0 = normal
                                !  istat = 2:  irtype argument invalid
                                !  istat = 3:  izneut or izchrg invalid
                                !  istat = 10:  ADAS data is requested but not found
    integer :: iZI(2),n_use !iZi - integer Zimp used to calculate sigv, n_use - 
                           !number of tables to be used, could be 1 or 2
    character*240 :: filename, filename_param    ! filename
!
    integer, parameter :: nspec = 10 ! nspec : number of plasma species in adas archive   x1r8=dble(x1)

    integer, parameter :: npts_e_param = 73, npts_d_param = 49 , npts_t_param = 73 ! number of points for table, 
                                                                                   !set by Michael Kraus, 09/14/09
    logical :: il_extrp=.true.
    integer:: npts_e_min
    character (len=4)  :: species_list(nspec)
	
    data species_list / 'h1', 'he2', 'li3', 'be4', 'b5', 'c6', 'n7', 'o8', 'f9', 'ne10' /
!

    ierr=0
    SIGVI=0.0_fp
    if(zb.gt.1) then !only H abailable
       ierr=3
       return
    endif
    call check_data_react(3,1,ZB,ZI_r8(1),iZI,n_use,ierr)!'SV' excited
    SIGVI=0.0_fp
    if(ierr.gt.0) then !error input data
       return
    endif
!
    npts_e=npts_e_param
    npts_d=npts_d_param
    npts_t=npts_t_param
!    
    write(cizneut,'(i5)') ZB
    do iz=1,n_use
       write(cizion,'(i5)') izi(iz)
       
       adas_tables_file=trim('tables/sv/ex')//'_'//&
            & trim(adjustl(cizneut))//'_'//trim(adjustl(cizion))//'.cdf'
       !
       call UFILNAM('ADASDIR',trim(adjustl(adas_tables_file)),filename)
       !
       ! try to open filename in tables directory
       call cdf_open(icdf,trim(filename),'r',fErr)
       if (fErr.ne.0) then !no table has been created
          write(6,*)' ?adas_bms2d: no lookup tables found'
          write(6,*)' ?adas_bms2d: create tables first'
          ierr=1
          return
       endif
       !tables already computed, read data 
       call cdfInqVar(icdf,'sigv_excite',idims,nctype)
       npts_e=idims(1)
       npts_d=idims(2)
       npts_t=idims(3)
       if(allocated(sigv_table))deallocate(sigv_table)
       allocate(sigv_table(npts_e,npts_d,npts_t))
       ! allocate  energy, density and temperature  vectors
       if(allocated(e_vec)) deallocate(e_vec)
       allocate(e_vec(npts_e))
       if(allocated(d_vec)) deallocate(d_vec)
       allocate(d_vec(npts_d))
       if(allocated(t_vec)) deallocate(t_vec)
       allocate(t_vec(npts_t))
       !
       call cdf_read(icdf,'sigv_excite',sigv_table(1:npts_e,1:npts_d,1:npts_t)) 
       call cdfInqVar(icdf,'energy_vec',idims,nctype)
       call cdf_read(icdf,'energy_vec',e_vec(1: npts_e))
       call cdfInqVar(icdf,'density_vec',idims,nctype)
       call cdf_read(icdf,'density_vec',d_vec(1: npts_d))
       call cdfInqVar(icdf,'temp_vec',idims,nctype)
       call cdf_read(icdf,'temp_vec',t_vec(1: npts_t))
       call cdf_close(icdf)

       !interpolate 3D table
       call adas_setSplineData3(npts_e,npts_d,npts_t,e_vec,d_vec,t_vec,sigv_table,iErr)
       do ij=1,ntvec
          do i=1,nevec
             sigvi_wrk=0.0_fp
             
             if((conc(ij).eq.0.0_fp).or.(eb(i).eq.0.0_fp).or.(ne(ij).eq.0.0_fp).or.(ti(ij).eq.0.0_fp)) cycle
             
             call adas_evalSpline3(eb(i),ne(ij),ti(ij),sigvi_wrk,il_extrp,ierr) 
             sigvi_wrk=sigvi_wrk*conc(ij) !take into accoutnt impurity fraction
             
             if(n_use.eq.2) then
                sigvi(i,ij)=sigvi(i,ij)+abs(zi_r8(1)-izi(n_use-iz+1))*sigvi_wrk/2.
             elseif(n_use.eq.1) then
                sigvi(i,ij)=zi_r8(1)/izi(1)*sigvi_wrk  
                !scale to Zimp >10 (for H beam) or to Zimp >8 (for He beam)
             endif
             
          enddo
       enddo
    enddo !iz
    
  end subroutine adas_bms2d_int_r8

!
!---------------------------------------------------------------------
!
  subroutine adas_bms3d_int_int(EB, Nevec, ZB, CONC, TI,Ntvec, ZI, NE, Ndvec, &
      &            SIGVI, iERR)
      
    real(fp),intent(in)  :: EB(nevec)
    integer,intent(in) :: ZB
    integer,intent(in) :: nevec,ndvec,ntvec
    real(fp),intent(in)  :: TI(ntvec), NE(ndvec)
    integer,intent(in)  ::  ZI(1)
    real(fp),intent(out)  :: SIGVI(nevec,ndvec,ntvec)
    real(fp),intent(in) :: conc(ndvec)
    
    integer :: iERR
    real(fp)  ::  ZI_r8(1)
    ZI_r8=dble(zi)
    call adas_bms3d_int_r8(EB, Nevec, ZB, CONC, TI,Ntvec, ZI_r8, NE, Ndvec, &
      &            SIGVI, iERR)
  end subroutine adas_bms3d_int_int
!
!---------------------------------------------------------------------
!
  subroutine adas_bms3d_r8_int(EB, Nevec, ZB_r8, CONC, TI,Ntvec, ZI, NE, Ndvec, &
      &            SIGVI, iERR)
      
    real(fp),intent(in)  :: EB(nevec)
    real(fp),intent(in) :: ZB_r8
    integer,intent(in) :: nevec,ndvec,ntvec
    real(fp),intent(in)  :: TI(ntvec), NE(ndvec)
    integer ,intent(in)  ::  ZI(1)
    real(fp),intent(out)  :: SIGVI(nevec,ndvec,ntvec)
    real(fp),intent(in) :: conc(ndvec)
    
    integer :: iERR
    integer :: ZB
    real(fp)  ::  ZI_r8(1)
    zi_r8=dble(zi)
    zb=zb_r8
    call adas_bms3d_int_r8(EB, Nevec, ZB, CONC, TI,Ntvec, ZI_r8, NE, Ndvec, &
         &            SIGVI, iERR)
  end subroutine adas_bms3d_r8_int
!
!---------------------------------------------------------------------
!
  subroutine adas_bms3d_r8_r8(EB, Nevec, ZB_r8, CONC, TI,Ntvec, ZI_r8, NE, Ndvec, &
      &            SIGVI, iERR)
      
    real(fp),intent(in)  :: EB(nevec)
    real(fp),intent(in) :: ZB_r8
    integer,intent(in) :: nevec,ndvec,ntvec
    real(fp),intent(in)  :: TI(ntvec), NE(ndvec)
    real(fp) ,intent(in)  ::  ZI_r8(1)
    real(fp),intent(out)  :: SIGVI(nevec,ndvec,ntvec)
    real(fp),intent(in) :: conc(ndvec)
    
    integer :: iERR
    integer :: ZB
    zb=zb_r8
    call adas_bms3d_int_r8(EB, Nevec, ZB, CONC, TI,Ntvec, ZI_r8, NE, Ndvec, &
         &            SIGVI, iERR)
  end subroutine adas_bms3d_r8_r8
!
!---------------------------------------------------------------------
!
!---------------------------------------------------------------------
!
  subroutine adas_bms1d_int_int(EB, Nevec, ZB, CONC, TI, ZI, NE, &
      &            SIGVI, iERR)
      
    real(fp),intent(in)  :: EB(nevec)
    integer,intent(in) :: ZB
    integer,intent(in) :: nevec
    real(fp),intent(in)  :: TI(nevec), NE(nevec)
    integer,intent(in)  ::  ZI(1)
    real(fp),intent(out)  :: SIGVI(nevec)
    real(fp),intent(in) :: conc(nevec)
    
    integer :: iERR
    real(fp)  ::  ZI_r8(1)
    ZI_r8=dble(zi)
    call adas_bms1d_int_r8(EB, Nevec, ZB, CONC, TI,ZI_r8, NE,  &
      &            SIGVI, iERR)
  end subroutine adas_bms1d_int_int
!
!---------------------------------------------------------------------
!
  subroutine adas_bms1d_r8_int(EB, Nevec, ZB_r8, CONC, TI, ZI, NE, &
      &            SIGVI, iERR)
      
    real(fp),intent(in)  :: EB(nevec)
    real(fp),intent(in) :: ZB_r8
    integer,intent(in) :: nevec
    real(fp),intent(in)  :: TI(nevec), NE(nevec)
    integer ,intent(in)  ::  ZI(1)
    real(fp),intent(out)  :: SIGVI(nevec)
    real(fp),intent(in) :: conc(nevec)
    
    integer :: iERR
    integer :: ZB
    real(fp)  ::  ZI_r8(1)
    zi_r8=dble(zi)
    zb=zb_r8
    call adas_bms1d_int_r8(EB, Nevec, ZB, CONC, TI, ZI_r8, NE,  &
         &            SIGVI, iERR)
  end subroutine adas_bms1d_r8_int
!
!---------------------------------------------------------------------
!
  subroutine adas_bms1d_r8_r8(EB, Nevec, ZB_r8, CONC, TI, ZI_r8, NE,  &
      &            SIGVI, iERR)
      
    real(fp),intent(in)  :: EB(nevec)
    real(fp),intent(in) :: ZB_r8
    integer,intent(in) :: nevec
    real(fp),intent(in)  :: TI(nevec), NE(nevec)
    real(fp) ,intent(in)  ::  ZI_r8(1)
    real(fp),intent(out)  :: SIGVI(nevec)
    real(fp),intent(in) :: conc(nevec)
    
    integer :: iERR
    integer :: ZB
    zb=zb_r8
    call adas_bms1d_int_r8(EB, Nevec, ZB, CONC, TI, ZI_r8, NE,  &
         &            SIGVI, iERR)
  end subroutine adas_bms1d_r8_r8
!
!---------------------------------------------------------------------
!
!---------------------------------------------------------------------
!
  subroutine adas_bms2d_int_int(EB, Nevec, ZB, CONC, TI,Ntvec, ZI, NE,  &
      &            SIGVI, iERR)
      
    real(fp),intent(in)  :: EB(nevec)
    integer,intent(in) :: ZB
    integer,intent(in) :: nevec,ntvec
    real(fp),intent(in)  :: TI(ntvec), NE(nevec)
    integer,intent(in)  ::  ZI(1)
    real(fp),intent(out)  :: SIGVI(nevec,ntvec)
    real(fp),intent(in) :: conc(nevec)
    
    integer :: iERR
    real(fp)  ::  ZI_r8(1)
    ZI_r8=dble(zi)
    call adas_bms2d_int_r8(EB, Nevec, ZB, CONC, TI,Ntvec, ZI_r8, NE,  &
      &            SIGVI, iERR)
  end subroutine adas_bms2d_int_int
!
!---------------------------------------------------------------------
!
  subroutine adas_bms2d_r8_int(EB, Nevec, ZB_r8, CONC, TI,Ntvec, ZI, NE,  &
      &            SIGVI, iERR)
      
    real(fp),intent(in)  :: EB(nevec)
    real(fp),intent(in) :: ZB_r8
    integer,intent(in) :: nevec,ntvec
    real(fp),intent(in)  :: TI(ntvec), NE(nevec)
    integer ,intent(in)  ::  ZI(1)
    real(fp),intent(out)  :: SIGVI(nevec,ntvec)
    real(fp),intent(in) :: conc(nevec)
    
    integer :: iERR
    integer :: ZB
    real(fp)  ::  ZI_r8(1)
    zi_r8=dble(zi)
    zb=zb_r8
    call adas_bms2d_int_r8(EB, Nevec, ZB, CONC, TI,Ntvec, ZI_r8, NE, &
         &            SIGVI, iERR)
  end subroutine adas_bms2d_r8_int
!
!---------------------------------------------------------------------
!
  subroutine adas_bms2d_r8_r8(EB, Nevec, ZB_r8, CONC, TI,Ntvec, ZI_r8, NE,  &
      &            SIGVI, iERR)
      
    real(fp),intent(in)  :: EB(nevec)
    real(fp),intent(in) :: ZB_r8
    integer,intent(in) :: nevec,ntvec
    real(fp),intent(in)  :: TI(ntvec), NE(nevec)
    real(fp) ,intent(in)  ::  ZI_r8(1)
    real(fp),intent(out)  :: SIGVI(nevec,ntvec)
    real(fp),intent(in) :: conc(nevec)
    
    integer :: iERR
    integer :: ZB
    zb=zb_r8
    call adas_bms2d_int_r8(EB, Nevec, ZB, CONC, TI,Ntvec, ZI_r8, NE,  &
         &            SIGVI, iERR)
  end subroutine adas_bms2d_r8_r8
!
!---------------------------------------------------------------------
!
!---------------------------------------------------------------------!
! adas_ion.f90:                                                       !
!     by Michael Kraus (michael.kraus@ipp.mpg.de)                     !
!     created 2009/06/24                                              !
!                                                                     !
!     reads ion collision cross sections from adas adf02 data tables  !
!     applies spline interpolation within the data range and          !
!     logarithmic extrapolation beyond                                !
!                                                                     !
!                                                                     !
! References:                                                         !
!                                                                     !
!    1. H. P. Summers (2004)                                          !
!       "The ADAS User Manual v2.6"                                   !
!       http://www.adas.ac.uk/manual.php                              !
!                                                                     !
!    2. NTCC PSPLINE Module                                           !
!       http://w3.pppl.gov/ntcc/PSPLINE/                              !
!                                                                     !
!---------------------------------------------------------------------!

 subroutine adas_ion(Erel_KeV, N, Z1, Z2, react, SIG, iErr)
      use EZspline_obj
      use EZspline
      
      implicit none

! Function Parameters
!
!     Erel_Kev(N)  : collision energies                              [KeV/amu]
!     N        : number of energy values
!     Z1       : atomic charge of primary   particle {1, 2}
!     Z2       : atomic charge of secondary particle {1, ..., 10}
!     react    : reaction type (
!                               1 = single ion impact ionisation (e.g. H +0 + H +1 => H +1 + H +1 + e)
!                               2 = full   ion impact ionisation (e.g. He+0 + H +1 => He+2 + H +1 + 2e)
!                               3 = single charge exchang        (e.g. He+0 + H +1 => He+1 + H +0)
!                               4 = full   charge exchang        (e.g. He+0 + He+2 => He+2 + He+0)
!                              )
!     SIG(N)   : requested cross sections                        [cm**2]
!     iErr     : error code    (0 = OK,                          
!                               1 = energy invalid
!                               2 = unsupported primary   species
!                               3 = unsupported secondary species
!                               4 = unsupported reaction type
!                               5 = reaction data unavailable
!                               6 = adas file reading error
!                               7 = spline error
!                               8 = 
!                              )
!
      integer,intent(in) :: N
      real(fp) ,intent(in) :: Erel_Kev(N)
      integer,intent(in) :: Z1, Z2, react 
      integer,intent(out) ::iErr
      real(fp) ,intent(out) ::sig(n)      
! Local Parameters
!
! nReact   : number of supported reactions
! nZ1      : number of supported primary   species
! nZ2      : number of supported secondary species
! maxn     : max number of entries per data table
!
! csIndex  : cross section table index in data file (0 means data not available)
! csi      : selected cross section index
!
! ferel(maxn) : Erel  from file
! fsig(maxn)  : sigma from file
! fn          : size of data table in file
! i, ie, is   : loop indices
!
! sig_ezspl   : EzSpline object for sigma
! bcs_sig     : boundary conditions for sigma spline
! serr        : spline error code
!
! tape             : data file identifier adas archive file
! outdbg           : data file identifier debug output
! fErr             : file reading error code
! nsel             : number of reactions in file
! adas_ion_data(2) : atomic data archive file names (adf02)
! filename         : complete path of adas archive file
! line             : temporary string for file input
!
      real(fp) :: Erel(N)
      integer, parameter :: nReact = 4
      integer, parameter :: nZ1  = 2
      integer, parameter :: nZ2  = 10
      integer, parameter :: maxn = 25
      
      integer :: csIndex(nReact, nZ1, nZ2)
      integer :: csi
      
      real(fp)  :: ferel(maxn), fsigma(maxn)
      real(fp)  :: logferel(maxn), logfsigma(maxn), logSIG(N)
      integer :: fn
      integer :: i, ie, is,ierr_extrapol
      
      type(EZspline1)    :: sig_ezspl
      integer            :: bcs_sig(2)
      integer            :: sErr
      
      integer, parameter :: tape   = 74
      integer, parameter :: outdbg = 75
      integer            :: fErr
      integer            :: nsel
      
      character*40  :: adas_ion_data(2)
      character*240 :: filename
      character*80  :: line
      real(fp)  :: x_tables(3),f_tables(3)

      csIndex(1,1,:)=(/11, 12, 13, 14, 15, 16, 17, 18, 19, 20/)   !   react = 1 (II), Z1 = 1 (H),  Z2 = {1, ..., 10}  (H +0 + X+Z2 => H +1  + X+Z2 + e)
      csIndex(1,2,:)=(/24, 28,  0, 31,  0, 34,  0, 37,  0,  0/)   !   react = 1 (II), Z1 = 2 (He), Z2 = {1, ..., 10}  (He+0 + X+Z2 => He+1  + X+Z2 + e)
      csIndex(2,1,:)=(/11, 12, 13, 14, 15, 16, 17, 18, 19, 20/)   !   react = 2 (II), Z1 = 1 (H),  Z2 = {1, ..., 10}  (H +0 + X+Z2 => H +Z1 + X+Z2 + Z1*e)
      csIndex(2,2,:)=(/43, 46,  0, 48,  0, 50,  0, 52,  0,  0/)   !   react = 2 (II), Z1 = 2 (He), Z2 = {1, ..., 10}  (He+0 + X+Z2 => He+Z1 + X+Z2 + Z1*e)
      csIndex(3,1,:)=(/ 1,  2,  3,  4,  5,  6,  7,  8,  9, 10/)   !   react = 3 (CX), Z1 = 1 (H),  Z2 = {1, ..., 10}  (H +0 + X+Z2 => H +1  + X+Z2-1 )
      csIndex(3,2,:)=(/ 1,  5,  0,  8, 11, 12, 15, 16,  0, 19/)   !   react = 3 (CX), Z1 = 2 (He), Z2 = {1, ..., 10}  (He+0 + X+Z2 => He+1  + X+Z2-1 )
      csIndex(4,1,:)=(/ 1,  2,  3,  4,  5,  6,  7,  8,  9, 10/)   !   react = 4 (CX), Z1 = 1 (H),  Z2 = {1, ..., 10}  (H +0 + X+Z2 => H +Z1 + X+Z2-Z1)
      csIndex(4,2,:)=(/ 1, 20,  0, 21,  0, 22,  0, 23,  0,  0/)   !   react = 4 (CX), Z1 = 2 (He), Z2 = {1, ..., 10}  (He+0 + X+Z2 => He+Z1 + X+Z2-Z1)
      
      adas_ion_data(1)='data/adf02/sia#h/sia#h_j99#h.dat'        ! H  data archive
      adas_ion_data(2)='data/adf02/sia#he/sia#he_j91#he.dat'     ! He data archive
      
      iErr = 0
      Erel=Erel_KeV*1e+3_fp !convert to [eV/amu]
      
! check if input data meets requirements and is valid
      ! check if collision energy is positive
      do i=1,N
         if (Erel(i) .le. 0.0) then
            iErr = 1
            return
         endif
      enddo
      
      ! check if primary species is in {H, He}
      if (Z1 .lt. 1 .AND. Z1 .gt. nZ1) then
         iErr = 2
         return
      endif
      
      ! check if secondary species Z in {1, ..., 10}
      if (Z2 .lt. 1 .OR. Z2 .gt. nZ2) then
         iErr = 3
         return
      endif
      
      ! check if reaction type is valid
      if (react .lt. 1 .OR. react .gt. nReact) then
         iErr = 4
         return
      endif
      
      ! check if requested cross section is available
      csi = csIndex(react, Z1, Z2)
      if (csi .eq. 0) then
         iErr = 5
         return
      endif

      
! read data from archive (refer to ADAS adf21 file format documentation at [2])
      call UFILNAM('ADASDIR',adas_ion_data(Z1),filename)
      open(unit=tape,file=filename,action='read', iostat=fErr)
      if (fErr .ne. 0) then                       ! check if file could be opened
         iErr = 6
         return
      endif
      read(tape,1000) nsel
      do i = 1,nsel
         read(tape,1001) fn
         read(tape,1002) (ferel(ie), ie=1,fn)
         read(tape,1002) (fsigma(is),is=1,fn)
         if (i .eq. csi) exit
      enddo
      close(tape) 
      
      if (i .gt. nsel) then
         iErr = 6
         return
      endif
      
      if (fn .lt. 3) then
         iErr = 6
         return
      endif
      
1000  format(i5)
1001  format(13x,i2)
1002  format(6(1x,E9.3E2),/,6(1x,E9.3E2))
      
      
! output adas data for debugging
   
!      if (react .eq. 1 .OR. react .eq. 2) filename = 'ii'
!      if (react .eq. 3 .OR. react .eq. 4) filename = 'cx'
      
!      filename = "adas_ion_" // trim(filename) // "_dbg.dat"
      
!      open(unit = outdbg, file = filename)
!      do i=1,fn
!         write(outdbg,'(5g20.10,5g20.10)') ferel(i), fsigma(i)
!      enddo
!      close(unit = outdbg)
      
      
      
! apply log on data
      
      do i=1,fn
         logferel(i)  = log(ferel(i))
         logfsigma(i) = log(fsigma(i))
      enddo
      
      
! create EzSpline object and put data into it
      
      bcs_sig = (/0, 0/)     ! not-a-knot boundary conditions
      
      call EZspline_init(sig_ezspl, fn, bcs_sig, sErr)      ! initialise spline object grid and boundary conditions
      call EZspline_error(sErr)                             ! print error message
      if (sErr .ne. 0) then                                 ! interrupt routine in case of error
         iERR = 7
         return
      endif
      sig_ezspl%x1 = logferel(1:fn)                         ! set grid points
      call EZspline_setup(sig_ezspl, logfsigma(1:fn), sErr) ! initialise spline data
      call EZspline_error(sErr)                             ! print error message
      if (sErr .ne. 0) then                                 ! interrupt routine in case of error
         iERR = 7
         return
      endif
      
      
! evaluate spline object with Erel values
      do i=1,N
         ! check if requested collision energy is within the available domain
         call EZspline_isInDomain(sig_ezspl, log(Erel(i)), sErr)
!         call EZspline_error(sErr)
         if (sErr .eq. 0) then
            ! requested value in range, evaluate spline
            call EZspline_interp(sig_ezspl, log(Erel(i)), logSIG(i), sErr)
            call EZspline_error(sErr)
            if (sErr .ne. 0) then
               iErr = 7
               return
            endif
            SIG(i) = exp(logSIG(i))
         else
            ! requested value out of range, extrapolate
            if (log(Erel(i)) .le. sig_ezspl%x1min) then

               call linear_interp(log(erel(i)),logferel(1:2),logfsigma(1:2),logSIG(i),ierr_extrapol)

               if(ierr_extrapol.ne.0) then !extrapolation error
                  iErr = 7
                  return
               endif
                 
               SIG(i) = exp(logSIG(i))
            else if (log(Erel(i)) .ge. sig_ezspl%x1max) then
               do ie=1,3
                  x_tables(ie)=logferel(fn-ie+1)
                  f_tables(ie)=logfsigma(fn-ie+1)
               enddo

               call linear_interp (log(erel(i)),x_tables(1:2),f_tables(1:2),logSIG(i),ierr_extrapol)            

                if(ierr_extrapol.ne.0) then !extrapolation error
                  iErr = 7
                  return
               endif
 
              SIG(i) = exp(logSIG(i))
            else
               iErr = 7
               return
            endif
         endif
      enddo
!mg      call r8_grafxf(erel(42:79),sig(42:79),38,ferel,fsigma,fn,' ',' ',' ',' ',' ')
      
      
      return
    end subroutine adas_ion
!
!-----------------------------------------------------------------------------------------
!
subroutine adas_sig_int_int(evec,n1,izneut,izion,fadas_type,sig_adas,istat)
!
! creates tables for  CX and ionization cross section sig using  ADAS data
!
  integer, intent(in) :: fadas_type    !marks reaction type used in adas_ion
!                               1 = single ion impact ionisation (e.g. H +0 + H +1 => H +1 + H +1 + e)
!                               2 = full   ion impact ionisation (e.g. He+0 + H +1 => He+2 + H +1 + 2e)
!                               3 = single charge exchange        (e.g. He+0 + H +1 => He+1 + H +0)
!                               4 = full   charge exchange        (e.g. He+0 + He+2 => He+2 + He+0)
!                               5 = Impact ionization = single II + full II + non-neutralaizing CX
  real(fp), dimension(n1), intent(in) :: evec !vector energy [KeV/amu]
  integer, intent(in) :: n1 !vector's size
  integer, intent(in) :: izneut  !atomic charge of primary   particle {1, 2}
  integer, intent(in) :: izion  !atomic charge of secondary particle {1, ..., 10}
  INTEGER :: istat ! completion code; 0 = normal
                                !  istat = 2:  irtype argument invalid
                                !  istat = 3:  izneut or izchrg invalid
                                !  istat = 10:  ADAS data is requested but not found
  real(fp), dimension(n1), intent(out) :: sig_adas !sigma*v [m**2]
  real(fp) :: zion  !atomic charge of secondary particle {1, ..., 10}
  zion=dble(izion)
  call adas_sig_int_r8(evec,n1,izneut,zion,fadas_type,sig_adas,istat)
end subroutine adas_sig_int_int
!
!-----------------------------------------------------------------------------------------
!
subroutine adas_sig_r8_int(evec,n1,zneut,izion,fadas_type,sig_adas,istat)
! creates tables for  CX and ionization cross section sig using  ADAS data
  integer, intent(in) :: fadas_type    !marks reaction type used in adas_ion
!                               1 = single ion impact ionisation (e.g. H +0 + H +1 => H +1 + H +1 + e)
!                               2 = full   ion impact ionisation (e.g. He+0 + H +1 => He+2 + H +1 + 2e)
!                               3 = single charge exchang        (e.g. He+0 + H +1 => He+1 + H +0)
!                               4 = full   charge exchang        (e.g. He+0 + He+2 => He+2 + He+0)
!                               5 = Impact ionization = single II + full II + non-neutralaizing CX
  real(fp), dimension(n1), intent(in) :: evec !vector energy [KeV/amu]
  integer, intent(in) :: n1 !vector's size
  real(fp), intent(in) :: zneut  !atomic charge of primary   particle {1, 2}
  integer, intent(in) :: izion  !atomic charge of secondary particle {1, ..., 10}
  INTEGER :: istat ! completion code; 0 = normal
                                !  istat = 2:  irtype argument invalid
                                !  istat = 3:  izneut or izchrg invalid
                                !  istat = 10:  ADAS data is requested but not found
  real(fp), dimension(n1), intent(out) :: sig_adas !sigma*v [m**2]
  real(fp) :: zion  !atomic charge of secondary particle {1, ..., 10}
  integer :: izneut  !atomic charge of primary   particle {1, 2}
  izneut=zneut
  zion=dble(izion)
  call adas_sig_int_r8(evec,n1,izneut,zion,fadas_type,sig_adas,istat)
end subroutine adas_sig_r8_int
!
!-----------------------------------------------------------------------------------------
!
subroutine adas_sig_r8_r8(evec,n1,zneut,zion,fadas_type,sig_adas,istat)
! creates tables for  CX and ionization cross section sig using  ADAS data
  integer, intent(in) :: fadas_type    !marks reaction type used in adas_ion
!                               1 = single ion impact ionisation (e.g. H +0 + H +1 => H +1 + H +1 + e)
!                               2 = full   ion impact ionisation (e.g. He+0 + H +1 => He+2 + H +1 + 2e)
!                               3 = single charge exchang        (e.g. He+0 + H +1 => He+1 + H +0)
!                               4 = full   charge exchang        (e.g. He+0 + He+2 => He+2 + He+0)
!                               5 = Impact ionization = single II + full II + non-neutralaizing CX
  real(fp), dimension(n1), intent(in) :: evec !vector energy [KeV/amu]
  integer, intent(in) :: n1 !vector's size
  real(fp), intent(in) :: zneut  !atomic charge of primary   particle {1, 2}
  real(fp), intent(in) :: zion  !atomic charge of secondary particle {1, ..., 10}
  INTEGER :: istat ! completion code; 0 = normal
                                !  istat = 2:  irtype argument invalid
                                !  istat = 3:  izneut or izchrg invalid
                                !  istat = 10:  ADAS data is requested but not found
  real(fp), dimension(n1), intent(out) :: sig_adas !sigma*v [m**2]
  integer :: izneut  !atomic charge of primary   particle {1, 2}
  izneut=zneut
  call adas_sig_int_r8(evec,n1,izneut,zion,fadas_type,sig_adas,istat)
end subroutine adas_sig_r8_r8
!
!-----------------------------------------------------------------------------------------
!
subroutine adas_sig_int_r8(evec,n1,izneut,zion,fadas_type,sig_adas,istat)
! creates tables for  CX and ionization cross section sig using  ADAS data
  integer, intent(in) :: fadas_type    !marks reaction type used in adas_ion
!                               1 = single ion impact ionisation (e.g. H +0 + H +1 => H +1 + H +1 + e)
!                               2 = full   ion impact ionisation (e.g. He+0 + H +1 => He+2 + H +1 + 2e)
!                               3 = single charge exchang        (e.g. He+0 + H +1 => He+1 + H +0)
!                               4 = full   charge exchang        (e.g. He+0 + He+2 => He+2 + He+0)
!                               5 = Impact ionization = single II + full II + non-neutralaizing CX
  real(fp), dimension(n1), intent(in) :: evec !vector energy [KeV/amu]
  integer, intent(in) :: n1 !vector's size
  integer, intent(in) :: izneut  !atomic charge of primary   particle {1, 2}
  real(fp), intent(in) :: zion  !atomic charge of secondary particle {1, ..., 10}
  INTEGER :: istat ! completion code; 0 = normal
                                !  istat = 2:  irtype argument invalid
                                !  istat = 3:  izneut or izchrg invalid
                                !  istat = 10:  ADAS data is requested but not found
  real(fp), dimension(n1), intent(out) :: sig_adas !sigma [m**2]
  integer, dimension(5) :: react_type= (/2,2,1,1,2/)   !reaction type: 1  ='CX', 2 = 'II'
  character*2, dimension(5) :: creact_type= (/'ii','ii','cx','cx','ii'/)   
  integer :: iZI(2),n_use !iZi - integer Zimp used to calculate sigv, n_use - 
                         !number of tables to be used, could be 1 or 2
  character*9 :: cfadas_type
  character*240 :: filename, filename_param    ! filename
  real(fp), dimension(:),pointer :: e_axis ! axis grid
  real(fp), dimension(:),allocatable :: sig_table, sig_table_wrk ! tabulated sig*v  
  real(fp), dimension(n1) :: sig_adas_wrk !work array sigma [m**2]
  integer :: iz, ierr
  istat=0
  
  call check_data_react(react_type(fadas_type),1,izneut,zion,iZI,n_use,istat)
  sig_adas=0._fp
  sig_adas_wrk=0._fp
  if(istat.gt.0) then !some error in input data, do not proceed
     return
  endif
  write(cizneut,'(i5)') izneut
  write(cfadas_type,'(i5)') fadas_type
  do iz=1, n_use
     write(cizion,'(i5)') izi(iz)
     ! create table's filename
     !
     adas_tables_file=trim('tables/')//trim(adjustl(creact_type(fadas_type)))//&
          &'/'//trim(adjustl(creact_type(fadas_type)))//trim(adjustl(cfadas_type))//'_'//&
          & trim(adjustl(cizneut))//'_'//trim(adjustl(cizion))//'.cdf'
     call UFILNAM('ADASDIR',trim(adjustl(adas_tables_file)),filename)
     !
     ! try to open filename in tables directory
     call cdf_open(icdf,trim(filename),'r',fErr)
     
     if (fErr.ne.0) then !no table has been created
        write(6,*)' %adas_sig: OK table data being recomputed'
        
        !compute and write table         
        !open file and read axis parameters
        adas_tables_file=trim('tables/')//trim(adjustl(creact_type(fadas_type)))//&
             &'/'//trim(adjustl(creact_type(fadas_type)))//'_'//&
             & trim(adjustl(cizneut))//'_'//trim(adjustl(cizion))//'_'//'tableParameters.cdf'
        call UFILNAM('ADASDIR',trim(adjustl(adas_tables_file)),filename_param)
        call cdf_open(icdf,trim(filename_param),'r',fErr)
        if (fErr.ne.0) then 
           write(6,*)' %adas_sig: OK trying to read dummy data'
           !tables have not been initialized, try to read dummy data
           call UFILNAM('ADASDIR',trim('tables/')//trim(adjustl(creact_type(fadas_type)))//&
                &'/'//'tableParameters.cdf',filename_param)
           call cdf_open(icdf,trim(filename_param),'r',fErr)
           if(ferr.gt.0) then
              write(6,*)' ?adas_sig: faild to read table data'
              istat = 10
              return
           endif
        endif
        call cdfInqVar(icdf,'axis_param_coldTarget',idims,nctype)
        call cdf_read(icdf,'axis_param_coldTarget',axis_param_coldTarget(1:idims(1)))
        call cdf_close(icdf)
        !
!        write(*,*)' %adas_sig computed table'
        call compute_axis(e_axis,axis_param_coldTarget)
        !     
        npts=int(axis_param_coldTarget(3))
        if(allocated(sig_table))deallocate(sig_table)
        allocate(sig_table(npts))
        if(allocated(sig_table_wrk))deallocate(sig_table_wrk)
        allocate(sig_table_wrk(npts))
        sig_table=0.0_fp
        sig_table_wrk=0.0_fp
        if(fadas_type.le.4) then
           call adas_ion(e_axis,npts,izneut,izi(iz),fadas_type,sig_table,ierr)
        elseif(fadas_type.eq.5) then !Impact ionization = single II + full II + non-neutralaizing CX
           fadas_II=1 ! single ionizataion
           sig_table_wrk=0.0_fp
           call adas_ion(e_axis,npts,izneut,izi(iz),fadas_II,sig_table_wrk,ierr)
           sig_table=sig_table+sig_table_wrk
           if(izi(iz).gt.1) then
              fadas_CX=3 ! converted to adas_ion routine for non-neutralizing CX 
              sig_table_wrk=0.0_fp
              call adas_ion(e_axis,npts,izneut,izi(iz),fadas_CX,sig_table_wrk,ierr)
              sig_table=sig_table+sig_table_wrk
              if(izneut.gt.1) then
                 fadas_II=2 ! converted to adas_ion routine  for full ionizataion
                 sig_table_wrk=0.0_fp
                 call adas_ion(e_axis,npts,izneut,izi(iz),fadas_II,sig_table_wrk,ierr)
                 sig_table=sig_table+sig_table_wrk
                 if(izi(iz).gt.izneut) then
                    fadas_CX=4 ! converted to adas_ion routine for non-neutralized CX 
                    sig_table_wrk=0.0_fp
                   call adas_ion(e_axis,npts,izneut,izi(iz),fadas_CX,sig_table_wrk,ierr)
                    sig_table=sig_table+sig_table_wrk
                 endif
              endif
           endif
        endif
        if(ierr.gt.0) return !do not write table
        call cdf_open(icdf,trim(filename),'w',fErr)
        call cdf_define(icdf,'axis_param_coldTarget',axis_param_coldTarget(1:4)) 
        call cdf_define(icdf,'sig',sig_table(1:npts)) 
        call cdf_write(icdf,'axis_param_coldTarget',axis_param_coldTarget(1:4))
        call cdf_write(icdf,'sig',sig_table(1:npts)) 
        call cdf_close(icdf)  
        deallocate(e_axis)
        call cdf_open(icdf,trim(filename),'r',fErr)
     endif
     !tables already computed, read data 
     call cdfInqVar(icdf,'sig',idims,nctype)
     npts=idims(1)
     if(allocated(sig_table))deallocate(sig_table)
     allocate(sig_table(npts))
     call cdf_read(icdf, 'sig',sig_table(1:npts))
     call cdfInqVar(icdf,'axis_param_coldTarget',idims,nctype)
     call cdf_read(icdf,'axis_param_coldTarget',axis_param_coldTarget(1:idims(1))) 
     call cdf_close(icdf)
     !interpolate 1D table
     xlr=log(axis_param_coldTarget(2)/axis_param_coldTarget(1))
     call FLIN1_Z(evec,sig_adas_wrk,n1,sig_table,axis_param_coldTarget(1),axis_param_coldTarget(2),&
          &xlr,npts,iwarn_adas)
     if(n_use.eq.2) then
        sig_adas=sig_adas+abs(zion-izi(n_use-iz+1))*sig_adas_wrk/2.
     elseif(n_use.eq.1) then
        sig_adas=zion/izi(1)*sig_adas_wrk !scale to Zimp >10 (for H beam) or to Zimp >8 (for He beam)
     endif
  enddo !iz

end subroutine adas_sig_int_r8
!
!-----------------------------------------------------------------------------------------
!
subroutine adas_sigv_int_int(freact_type,evec,n1,izneut,izion,sigv_adas,istat)
!
!this subroutine calculates sig*v for neutralizing charge-exchange reaction using ADAS data
!and impact ionization which includes  non-neutralizing charge-exchange reaction using ADAS data
!
  integer, intent(in) :: freact_type    !reaction type: 1  ='CX', 2 = 'II'
  integer, intent(in) :: izneut  !atomic charge of primary   particle {1, 2}
  integer, intent(in) :: izion  !atomic charge of secondary particle {1, ..., 10}
  real(fp), dimension(n1), intent(in) :: evec !vector energy [KeV/amu]
  integer, intent(in) :: n1 !vector's size
  real(fp), dimension(n1), intent(out) :: sigv_adas !sigma*v [m**3/sec]
  INTEGER :: istat ! completion code; 0 = normal
                                !  istat = 2:  irtype argument invalid
                                !  istat = 3:  izneut or izchrg invalid
                                !  istat = 10:  ADAS data is requested but not found
 real(fp) :: zion  !atomic charge of secondary particle {1, ..., 10}
  zion=dble(izion)
  call adas_sigv_int_r8(freact_type,evec,n1,izneut,zion,sigv_adas,istat)
end subroutine adas_sigv_int_int
!
!-----------------------------------------------------------------------------------------
!
subroutine adas_sigv_r8_int(freact_type,evec,n1,zneut,izion,sigv_adas,istat)
!
!this subroutine calculates sig*v for neutralizing charge-exchange reaction using ADAS data
!and impact ionization which inclides  non-neutralizing charge-exchange reaction using ADAS data
!
  integer, intent(in) :: freact_type    !reaction type: 1  ='CX', 2 = 'II'
  real(fp), intent(in) :: zneut  !atomic charge of primary   particle {1, 2}
  integer, intent(in) :: izion  !atomic charge of secondary particle {1, ..., 10}
  real(fp), dimension(n1), intent(in) :: evec !vector energy [KeV/amu]
  integer, intent(in) :: n1 !vector's size
  real(fp), dimension(n1), intent(out) :: sigv_adas !sigma*v [m**3/sec]
  INTEGER :: istat ! completion code; 0 = normal
                                !  istat = 2:  irtype argument invalid
                                !  istat = 3:  izneut or izchrg invalid
                                !  istat = 10:  ADAS data is requested but not found
  integer :: izneut  !atomic charge of primary   particle {1, 2}
  real(fp) ::zion
  zion=dble(izion)
  izneut=zneut
  call adas_sigv_int_r8(freact_type,evec,n1,izneut,zion,sigv_adas,istat)
end subroutine adas_sigv_r8_int
!
!-----------------------------------------------------------------------------------------
!
subroutine adas_sigv_r8_r8(freact_type,evec,n1,zneut,zion,sigv_adas,istat)
!
!this subroutine calculates sig*v for neutralizing charge-exchange reaction using ADAS data
!and impact ionization which inclides  non-neutralizing charge-exchange reaction using ADAS data
!
  integer, intent(in) :: freact_type    !reaction type: 1  ='CX', 2 = 'II'
  real(fp), intent(in) :: zneut  !atomic charge of primary   particle {1, 2}
  real(fp), intent(in) :: zion  !atomic charge of secondary particle {1, ..., 10}
  real(fp), dimension(n1), intent(in) :: evec !vector energy [KeV/amu]
  integer, intent(in) :: n1 !vector's size
  real(fp), dimension(n1), intent(out) :: sigv_adas !sigma*v [m**3/sec]
  INTEGER :: istat ! completion code; 0 = normal
                                !  istat = 2:  irtype argument invalid
                                !  istat = 3:  izneut or izchrg invalid
                                !  istat = 10:  ADAS data is requested but not found
 integer :: izneut  !atomic charge of primary   particle {1, 2}
  izneut=zneut
  call adas_sigv_int_r8(freact_type,evec,n1,izneut,zion,sigv_adas,istat)
end subroutine adas_sigv_r8_r8
!
!-----------------------------------------------------------------------------------------
!
subroutine adas_sigv_int_r8(freact_type,evec,n1,izneut,zion,sigv_adas,istat)
!
!this subroutine calculates sig*v for neutralizing charge-exchange reaction using ADAS data
!and impact ionization which inclides  non-neutralizing charge-exchange reaction using ADAS data
!
!  use sigprep_mod
  integer, intent(in) :: freact_type    !reaction type: 1  ='CX', 2 = 'II'
  integer, intent(in) :: izneut  !atomic charge of primary   particle {1, 2}
  real(fp), intent(in) :: zion  !atomic charge of secondary particle {1, ..., 10}
  real(fp), dimension(n1), intent(in) :: evec !vector energy [KeV/amu]
  integer, intent(in) :: n1 !vector's size
  real(fp), dimension(n1), intent(out) :: sigv_adas !sigma*v [m**3/sec]
  INTEGER :: istat ! completion code; 0 = normal
                                !  istat = 2:  irtype argument invalid
                                !  istat = 3:  izneut or izchrg invalid
                                !  istat = 10:  ADAS data is requested but not found
  INTEGER, parameter :: ikey=1 !key for the
                               ! KEY=1 FOR THERMONUCLEAR <SIGMA*V>
                               ! key  = 2  for FOR BEAM TARGET <sig*v>
                               ! key  = 3 for <E/A>
                               ! key = 4 for <fd>
                               ! key = 5  TRANSP BEAM BEAM GYRO INTEGRALS  See: preact/comptabl_z.for
!
  real(fp) vrel                  ! relative velocity [m/sec]
  real(fp) eevec                 ! energy vector
  real(fp) sigall_z
  integer i,iz
  integer, parameter :: tape   = 74
  character*2, dimension(2)   :: react_type=(/'cx','ii'/)
  real(fp), dimension(:),pointer :: e_axis ! axis grid
  real(fp),dimension(:),allocatable :: sigv_table ! tabulated sig*v  
  integer :: iZI(2),n_use !iZi - integer Zimp used to calculate sigv, n_use - 
                         !number of tables to be used, could be 1 or 2
  real(fp), dimension(n1) :: sigv_adas_wrk !work array sigma*v [m**3/sec]
  character*240 :: filename, filename_param    ! filename
  real(fp),SAVE,dimension(4,2) :: axis_param_coldTarget_prev !axis parameters(E[KeV/amu]) for table: 
                                                !min, max values, number of points,
                                                !specification 0 for LOG, 1 for LIN
!
!checking input data for availability
  istat=0
  call check_data_react(freact_type,1,izneut,zion,iZI,n_use,istat)
  sigv_adas=0._fp
  sigv_adas_wrk=0._fp
  if(istat.gt.0) then !some error in input data, do not proceed
     return
  endif
  
        
  write(cizneut,'(i5)') izneut
  do iz=1, n_use
     write(cizion,'(i5)') izi(iz)
     ! create table's filename
     !
     adas_tables_file=trim('tables/')//trim(react_type(freact_type))//&
          &'/'//trim(react_type(freact_type))//'_'//&
          & trim(adjustl(cizneut))//'_'//trim(adjustl(cizion))//'_'//'coldTarget.cdf'
     !
     call UFILNAM('ADASDIR',trim(adjustl(adas_tables_file)),filename)
     if(trim(adjustl(filename_prev(iz))).ne.trim(adjustl(filename))) then
     !
     ! try to open filename in tables directory
     call cdf_open(icdf,trim(filename),'r',fErr)
     
     if (fErr.ne.0) then !no table has been created
        write(6,*)' %adas_sigv: OK table data being recomputed'
        
        !compute and write table         
        !open file and read axis parameters
        ilen=len(trim(filename))
        filename_param= filename(1:ilen-14)//trim('tableParameters.cdf')
        call cdf_open(icdf,trim(filename_param),'r',fErr)
        if (fErr.ne.0) then 
           write(6,*)' %adas_sigv: OK trying to read dummy data'
           !tables have not been initialized, try to read dummy data
           call UFILNAM('ADASDIR',trim('tables/')//trim(react_type(freact_type))//&
                &'/'//'tableParameters.cdf',filename_param)
           call cdf_open(icdf,trim(filename_param),'r',fErr)
           if(ferr.gt.0) then
              write(6,*)' !adas_sigv: faild to read table data'
              istat = 10
              return
           endif
        endif
        call cdfInqVar(icdf,'axis_param_coldTarget',idims,nctype)
        call cdf_read(icdf,'axis_param_coldTarget',axis_param_coldTarget(1:idims(1)))
        call cdf_close(icdf)
        !
        call compute_axis(e_axis,axis_param_coldTarget)
        !     
        npts=int(axis_param_coldTarget(3))
        if(allocated(sigv_table))deallocate(sigv_table)
        allocate(sigv_table(npts))
        sigv_table=0.0_fp
        ! set reaction key
        if(freact_type.eq.1) then !CX
           fadas_CX=4 ! converted to adas_ion routine for neutralizing CX 
           call sigprep_adas_z(fadas_CX,izneut,izi(iz),ikey)
           do i=1,npts
              eevec=e_axis(i)
              sigv_table(i)=sigall_z(eevec,vrel)*vrel
           enddo
        elseif(freact_type.eq.2) then !II
           fadas_II=5 ! converted to adas_ion routine for total ionizataions
           call sigprep_adas_z(fadas_II,izneut,izi(iz),ikey)
           do i=1,npts
              eevec=e_axis(i)
              sigv_table(i)=sigall_z(eevec,vrel)*vrel
           enddo
        endif
        call cdf_open(icdf,trim(filename),'w',fErr)
        call cdf_define(icdf,'axis_param_coldTarget',axis_param_coldTarget(1:4)) 
        call cdf_define(icdf,'sigv',sigv_table(1:npts)) 
        call cdf_write(icdf,'axis_param_coldTarget',axis_param_coldTarget(1:4))
        call cdf_write(icdf,'sigv',sigv_table(1:npts)) 
        call cdf_close(icdf)  
        deallocate(e_axis)
        call cdf_open(icdf,trim(filename),'r',fErr)
     endif
     
     !tables already computed, read data 
     call cdfInqVar(icdf,'sigv',idims,nctype)
     npts=idims(1)
     if(allocated(sigv_table))deallocate(sigv_table)
     allocate(sigv_table(npts))
     call cdf_read(icdf, 'sigv',sigv_table(1:npts))
     call cdfInqVar(icdf,'axis_param_coldTarget',idims,nctype)
     call cdf_read(icdf,'axis_param_coldTarget',axis_param_coldTarget(1:idims(1))) 
     call cdf_close(icdf)
     filename_prev(iz)=filename
     axis_param_coldTarget_prev(:,iz)=axis_param_coldTarget(:)
     npts_prev(iz)=npts
     
     if(allocated(sigv_table_prev)) then
        if(size(sigv_table_prev,dim=2).ge.iz) then
           if(size(sigv_table_prev(:,iz)).lt.npts) then
              if(iz.eq.1) then
                 deallocate(sigv_table_prev)
                 allocate(sigv_table_prev(npts,n_use))
                 sigv_table_prev=0.0_fp
              else ! extend
                 call extend(iz,n_use)
              endif
           endif
        else
           call extend(iz,n_use)
        endif
     else
        allocate(sigv_table_prev(npts,n_use))
     endif
     sigv_table_prev(1:npts,iz)=sigv_table(1:npts)
  else
     npts=npts_prev(iz)
     if(allocated(sigv_table)) then
        if(size(sigv_table).ne.npts) then
           deallocate(sigv_table)
           allocate(sigv_table(npts))
        endif
     else
        allocate(sigv_table(npts))
     endif
     sigv_table(1:npts)=sigv_table_prev(1:npts,iz)
     axis_param_coldTarget(:)=axis_param_coldTarget_prev(:,iz)
 endif
     !interpolate 1D table
     xlr=log(axis_param_coldTarget(2)/axis_param_coldTarget(1))
     call FLIN1_Z(evec,sigv_adas_wrk,n1,sigv_table,axis_param_coldTarget(1),axis_param_coldTarget(2),&
          &xlr,npts,iwarn_adas)
     if(n_use.eq.2) then
        sigv_adas=sigv_adas+abs(zion-izi(n_use-iz+1))*sigv_adas_wrk/2.
     elseif(n_use.eq.1) then
        sigv_adas=zion/izi(1)*sigv_adas_wrk !scale to Zimp >10 (for H beam) or to Zimp >8 (for He beam)
     endif
  enddo !iz

  
end subroutine adas_sigv_int_r8
!
!---------------------------------------------------------------------
!
subroutine adas_zstop_sigvz_int_int(izneut,izion,evec,n1,sigv_adas,istat)
!
!this subroutine calculates sig*v tables for impurity stopping 
!on fully stripped light impurities (vs. Erel only) using ADAS data
!as a sum of sig*v for ionization (includes non-neutralazing CX) and neuralazing CX reactions.
!
  integer, intent(in) :: izneut  !atomic charge of primary   particle {1, 2} and
  integer, intent(in) :: izion     !atomic charge of secondary particle {1, ..., 10}
  real(fp), dimension(n1), intent(in) :: evec !vector energy [KeV/amu]
  integer, intent(in) :: n1 !vector's size
  real(fp), dimension(n1), intent(out) :: sigv_adas !sigma*v [m**3/sec]
  integer, intent(out) :: istat
  real(fp) :: zion     !atomic charge of secondary particle {1, ..., 10}
  zion=dble(izion)
  call adas_zstop_sigvz_int_r8(izneut,zion,evec,n1,sigv_adas,istat)
end subroutine adas_zstop_sigvz_int_int
!
!---------------------------------------------------------------------
!
subroutine adas_zstop_sigvz_r8_int(zneut,izion,evec,n1,sigv_adas,istat)
!
!this subroutine calculates sig*v tables for for impurity stopping 
!on fully stripped light impurities (vs. Erel only) using ADAS data
!as a sum of sig*v for ionization (includes non-neutralazing CX) and neuralazing CX reactions.
!
  real(fp), intent(in) :: zneut  !atomic charge of primary   particle {1, 2} and
  integer, intent(in) :: izion     !atomic charge of secondary particle {1, ..., 10}
  real(fp), dimension(n1), intent(in) :: evec !vector energy [KeV/amu]
  integer, intent(in) :: n1 !vector's size
  real(fp), dimension(n1), intent(out) :: sigv_adas !sigma*v [m**3/sec]
  integer, intent(out) :: istat
  real(fp) :: zion     !atomic charge of secondary particle {1, ..., 10}
  integer :: izneut  !atomic charge of primary   particle {1, 2} and
  zion=dble(izion)
  izneut=zneut
  call adas_zstop_sigvz_int_r8(izneut,zion,evec,n1,sigv_adas,istat)
end subroutine adas_zstop_sigvz_r8_int
!
!---------------------------------------------------------------------
!
subroutine adas_zstop_sigvz_r8_r8(zneut,zion,evec,n1,sigv_adas,istat)
!
!this subroutine calculates sig*v tables for for impurity stopping 
!on fully stripped light impurities (vs. Erel only) using ADAS data
!as a sum of sig*v for ionization (includes non-neutralazing CX) and neuralazing CX reactions.
!
  real(fp), intent(in) :: zneut  !atomic charge of primary   particle {1, 2} and
  real(fp), intent(in) :: zion     !atomic charge of secondary particle {1, ..., 10}
  real(fp), dimension(n1), intent(in) :: evec !vector energy [KeV/amu]
  integer, intent(in) :: n1 !vector's size
  real(fp), dimension(n1), intent(out) :: sigv_adas !sigma*v [m**3/sec]
  integer, intent(out) :: istat
  integer :: izneut  !atomic charge of primary   particle {1, 2} and
  izneut=zneut
  call adas_zstop_sigvz_int_r8(izneut,zion,evec,n1,sigv_adas,istat)
end subroutine adas_zstop_sigvz_r8_r8
!
!---------------------------------------------------------------------
!
subroutine adas_zstop_sigvz_int_r8(izneut,zion,evec,n1,sigv_adas,istat)
!
!this subroutine calculates sig*v tables for for impurity stopping 
!on fully stripped light impurities (vs. Erel only) using ADAS data
!as a sum of sig*v for ionization (includes non-neutralazing CX) and neuralazing CX reactions.
!
!  use sigprep_mod
  integer, intent(in) :: izneut  !atomic charge of primary   particle {1, 2} and
  real(fp), intent(in) :: zion     !atomic charge of secondary particle {1, ..., 10}
  real(fp), dimension(n1), intent(in) :: evec !vector energy [KeV/amu]
  integer, intent(in) :: n1 !vector's size
  real(fp), dimension(n1), intent(out) :: sigv_adas !sigma*v [m**3/sec]
!
  integer :: freact_type  ! reaction type
  real(fp), dimension(:),pointer :: e_axis ! axis grid
  real(fp), dimension(:),allocatable :: sigv_table ! tabulated sig*v  
  real(fp), dimension(:),allocatable :: sigv_table_wrk ! wrk. tabulated sig*v  
  integer, intent(out) :: istat
  INTEGER ::  iz
                                !  istat = 10:  ADAS data is requested but not found
  integer :: iZI(2),n_use !iZi - integer Zimp used to calculate sigv, n_use - 
                         !number of tables to be used, could be 1 or 2
  real(fp), dimension(n1) :: sigv_adas_wrk !sigma*v [m**3/sec]
  character*240 :: filename, filename_param    ! filename
  real(fp),SAVE,dimension(4,2) :: axis_param_coldTarget_prev !axis parameters(E[KeV/amu]) for table: 
                                                !min, max values, number of points,
                                                !specification 0 for LOG, 1 for LIN
!
!checking input data for availability
  istat=0
  call check_data_react(2,1,izneut,zion,iZI,n_use,istat)
  sigv_adas=0._fp
  sigv_adas_wrk=0._fp
  if(istat.gt.0) then !some error in input data, do not proceed
     return
  endif
  write(cizneut,'(i5)') izneut
  do iz=1,n_use
     write(cizion,'(i5)') izi(iz)
     !
     ! create table's filename
     adas_tables_file=trim('tables/sv/sv')//'_'//&
          & trim(adjustl(cizneut))//'_'//trim(adjustl(cizion))//'_'//'coldTarget.cdf'
     call UFILNAM('ADASDIR',trim(adjustl(adas_tables_file)),filename)
     if(trim(adjustl(filename_prev(iz))).ne.trim(adjustl(filename))) then
     !
     ! try to open filename in tables directory
     call cdf_open(icdf,trim(filename),'r',fErr)
     if (fErr.ne.0) then !no table has been created
        write(6,*)' %adas_zstop_sigvz: OK table data being recomputed'
        ilen=len(trim(filename))
        filename_param= filename(1:ilen-14)//trim('tableParameters.cdf')
        call cdf_open(icdf,trim(filename_param),'r',fErr)
        if (fErr.ne.0) then 
           write(6,*)' %adas_zstop_sigvz: OK trying to read dummy data'
           !tables have not been initialized, try to read dummy data
           call UFILNAM('ADASDIR',trim('tables/sv/tableParameters.cdf'),filename_param)
           call cdf_open(icdf,trim(filename_param),'r',fErr)
           if(ferr.gt.0) then
              write(6,*)' !adas_zstop_sigvz: faild to read table data'
              istat = 10
              return
           endif
        endif
        call cdfInqVar(icdf,'axis_param_coldTarget',idims,nctype)
        call cdf_read(icdf,'axis_param_coldTarget',axis_param_coldTarget(1:idims(1)))
        call cdf_close(icdf)
        
        call compute_axis(e_axis,axis_param_coldTarget)
        
        npts=int(axis_param_coldTarget(3))
        if(allocated(sigv_table))deallocate(sigv_table)
        allocate(sigv_table(npts))
        if(allocated(sigv_table_wrk))deallocate(sigv_table_wrk)
        allocate(sigv_table_wrk(npts))
        sigv_table=0.0_fp
        sigv_table_wrk=0._fp
        freact_type=1 !CX reaction
        iopen_file=0 
        call adas_sigv(freact_type,e_axis,npts,izneut,dble(izi(iz)),sigv_table,istat)
        iopen_file=iopen_file+istat !iopen_file <4 means that tables are opened
        freact_type=2 !II reaction
        call adas_sigv(freact_type,e_axis,npts,izneut,dble(izi(iz)),sigv_table_wrk,istat)
        iopen_file=iopen_file+istat !iopen_file <4 means that tables are opened
        sigv_table=sigv_table+sigv_table_wrk !stopping rate= CX+II
        if(iopen_file.gt.3) then !errors appear in both part: CX and II. => sigv_table=0
           !do not open table
           sigv_adas=0._fp
           return
        endif
        call cdf_open(icdf,trim(filename),'w',fErr)
        call cdf_define(icdf,'axis_param_coldTarget',axis_param_coldTarget(1:4)) 
        call cdf_define(icdf,'sigv',sigv_table(1:npts)) 
        call cdf_write(icdf,'axis_param_coldTarget',axis_param_coldTarget(1:4))
        call cdf_write(icdf,'sigv',sigv_table(1:npts)) 
        call cdf_close(icdf)  
        deallocate(e_axis)
        call cdf_open(icdf,trim(filename),'r',fErr)
     endif
     !tables already computed, read data 
     call cdfInqVar(icdf,'sigv',idims,nctype)
     npts=idims(1)
     if(allocated(sigv_table))deallocate(sigv_table)
     allocate(sigv_table(npts))
     call cdf_read(icdf, 'sigv',sigv_table(1:npts))
     call cdfInqVar(icdf,'axis_param_coldTarget',idims,nctype)
     call cdf_read(icdf,'axis_param_coldTarget',axis_param_coldTarget(1:idims(1))) 
     call cdf_close(icdf)
     filename_prev(iz)=filename
     axis_param_coldTarget_prev(:,iz)=axis_param_coldTarget(:)
     npts_prev(iz)=npts

     if(allocated(sigv_table_prev)) then
        if(size(sigv_table_prev,dim=2).ge.iz) then
           if(size(sigv_table_prev(:,iz)).lt.npts) then
              if(iz.eq.1) then
                 deallocate(sigv_table_prev)
                 allocate(sigv_table_prev(npts,n_use))
                 sigv_table_prev=0.0_fp
              else ! extend
                 call extend(iz,n_use)
              endif
           endif
        else
           call extend(iz,n_use)
        endif
     else
        allocate(sigv_table_prev(npts,n_use))
     endif
     sigv_table_prev(1:npts,iz)=sigv_table(1:npts)
  else
     npts=npts_prev(iz)
     if(allocated(sigv_table)) then
        if(size(sigv_table).ne.npts) then
           deallocate(sigv_table)
           allocate(sigv_table(npts))
        endif
     else
        allocate(sigv_table(npts))
     endif
     sigv_table(1:npts)=sigv_table_prev(1:npts,iz)
     axis_param_coldTarget(:)=axis_param_coldTarget_prev(:,iz)
  endif
     
     !interpolate 1D table
     xlr=log(axis_param_coldTarget(2)/axis_param_coldTarget(1))
     call FLIN1_Z(evec,sigv_adas_wrk,n1,sigv_table,axis_param_coldTarget(1),axis_param_coldTarget(2),&
          &xlr,npts,iwarn_adas)
     if(n_use.eq.2) then
        sigv_adas=sigv_adas+abs(zion-izi(n_use-iz+1))*sigv_adas_wrk/2.
     elseif(n_use.eq.1) then
        sigv_adas=zion/izi(1)*sigv_adas_wrk !scale to Zimp >10 (for H beam) or to Zimp >8 (for He beam)
     endif
  enddo !iz
  
end subroutine adas_zstop_sigvz_int_r8
!
!-----------------------------------------------------------------------------------------
!
subroutine adas_btsigv_int_int(freact_type,beamchrg,evec,tevec,n1,izneut_in,izion_in,sigv_adas,istat)
!this subroutine calculates maxwellian average <sig*v> for CX and II reactions
  integer, intent(in) :: freact_type    !reaction type: 1 -- "CX" and 2  -- 'II'
  integer, intent(in) :: izneut_in        !     izneut       : atomic charge of primary   particle {1, 2}
  integer, intent(in) :: izion_in           !     izion        : atomic charge of secondary particle {1, ..., 10}

  INTEGER :: istat  ! completion code; 0 = normal
                                !  istat = 2:  irtype argument invalid
                                !  istat = 3:  izneut or izchrg invalid
                                !  istat = 10:  ADAS data is requested but not found
  real(fp), dimension(n1), intent(in) :: evec !vector energy [KeV/amu]
  real(fp), dimension(n1), intent(in) :: tevec !vector temperature [KeV]
  integer, intent(in) :: n1  !vector's size
  real(fp), dimension(n1), intent(out) :: sigv_adas !sigma*v [m**3/sec]
  integer, intent(in) :: beamchrg ! beam type: =neutral or =ion
  real(fp) :: zion_in  
  zion_in=dble(izion_in)
  call adas_btsigv_int_r8(freact_type,beamchrg,evec,tevec,n1,izneut_in,zion_in,sigv_adas,istat)
end subroutine adas_btsigv_int_int
!
!-----------------------------------------------------------------------------------------
!
subroutine adas_btsigv_r8_r8(freact_type,beamchrg,evec,tevec,n1,zneut_in,zion_in,sigv_adas,istat)
!this subroutine calculates maxwellian average <sig*v>
  integer, intent(in) :: freact_type    !reaction type: 1 -- "CX" and 2  -- 'II'
  real(fp), intent(in) :: zneut_in        !     izneut       : atomic charge of primary   particle {1, 2}
  real(fp), intent(in) :: zion_in           !     izion        : atomic charge of secondary particle {1, ..., 10}

  INTEGER :: istat  ! completion code; 0 = normal
                                !  istat = 2:  irtype argument invalid
                                !  istat = 3:  izneut or izchrg invalid
                                !  istat = 10:  ADAS data is requested but not found
  real(fp), dimension(n1), intent(in) :: evec !vector energy [KeV/amu]
  real(fp), dimension(n1), intent(in) :: tevec !vector temperature [KeV]
  integer, intent(in) :: n1  !vector's size
  real(fp), dimension(n1), intent(out) :: sigv_adas !sigma*v [m**3/sec]
  integer, intent(in) :: beamchrg ! beam type: =neutral or =ion
  integer :: izneut_in        !     izneut       : atomic charge of primary   particle {1, 2}
  izneut_in=zneut_in
  call adas_btsigv_int_r8(freact_type,beamchrg,evec,tevec,n1,izneut_in,zion_in,sigv_adas,istat)
end subroutine adas_btsigv_r8_r8
!
!-----------------------------------------------------------------------------------------
!
subroutine adas_btsigv_r8_int(freact_type,beamchrg,evec,tevec,n1,zneut_in,izion_in,sigv_adas,istat)
!this subroutine calculates maxwellian average <sig*v>
  integer, intent(in) :: freact_type    !reaction type: 1 -- "CX" and 2  -- 'II'
  real(fp), intent(in) :: zneut_in        !     izneut       : atomic charge of primary   particle {1, 2}
  integer, intent(in) :: izion_in           !     izion        : atomic charge of secondary particle {1, ..., 10}

  INTEGER :: istat  ! completion code; 0 = normal
                                !  istat = 2:  irtype argument invalid
                                !  istat = 3:  izneut or izchrg invalid
                                !  istat = 10:  ADAS data is requested but not found
  real(fp), dimension(n1), intent(in) :: evec !vector energy [KeV/amu]
  real(fp), dimension(n1), intent(in) :: tevec !vector temperature [KeV]
  integer, intent(in) :: n1  !vector's size
  real(fp), dimension(n1), intent(out) :: sigv_adas !sigma*v [m**3/sec]
  integer, intent(in) :: beamchrg ! beam type: =neutral or =ion
  integer :: izneut_in        !     izneut       : atomic charge of primary   particle {1, 2}
  real(fp) :: zion_in
  izneut_in=zneut_in
  zion_in=dble(izion_in)
  call adas_btsigv_int_r8(freact_type,beamchrg,evec,tevec,n1,izneut_in,zion_in,sigv_adas,istat)
end subroutine adas_btsigv_r8_int
!
!
!-----------------------------------------------------------------------------------------
!
subroutine adas_btsigv_int_r8(freact_type,beamchrg,evec,tevec,n1,izneut_in,zion_in,sigv_adas,istat)
!this subroutine calculates maxwellian average <sig*v>
!  use sigprep_mod
  integer, intent(in) :: freact_type    !reaction type: 1 -- "CX" and 2  -- 'II'
  integer, intent(in) :: izneut_in        !     izneut       : atomic charge of primary   particle {1, 2}
  real(fp), intent(in) :: zion_in           !     izion        : atomic charge of secondary particle {1, ..., 10}

  INTEGER :: istat  ! completion code; 0 = normal
                                !  istat = 2:  irtype argument invalid
                                !  istat = 3:  izneut or izchrg invalid
                                !  istat = 10:  ADAS data is requested but not found
  real(fp), dimension(n1), intent(in) :: evec !vector energy [KeV/amu]
  real(fp), dimension(n1), intent(in) :: tevec !vector temperature [KeV]
  integer, intent(in) :: n1  !vector's size
  real(fp), dimension(n1), intent(out) :: sigv_adas !sigma*v [m**3/sec]
  integer, intent(in) :: beamchrg ! beam type: =neutral or =ion
!
  integer, parameter :: NEUTRAL=1, ION=2
  integer :: izneut        !     izneut       : atomic charge of primary   particle {1, 2}
  real(fp)  :: zion          !     izion        : atomic charge of secondary particle {1, ..., 10}
  INTEGER, parameter :: ikey=2 !key for the
                               ! KEY=1 FOR THERMONUCLEAR <SIGMA*V>
                               ! key  = 2  for FOR BEAM TARGET <sig*v>
                               ! key  = 3 for <E/A>
                               ! key = 4 for <fd>
                               ! key = 5  TRANSP BEAM BEAM GYRO INTEGRALS  See: preact/comptabl_z.for
  character*2, dimension(2)   :: react_type=(/'cx','ii'/)
  integer :: npts_e, npts_t ! number of points for table
  real(fp), dimension(:,:),allocatable :: sigv_table     ! tabulated sig*v  
  integer i, ier, iz
  real(fp), dimension(:),pointer :: e_axis,t_axis ! axis grid
  real(fp), dimension(:),allocatable :: wrk ! work array
  real(fp) :: xlr_t ! If XLR>0, then the X grid is equally spaced on a logarithmic scale:
                  ! LINEAR IF XLR .LE. 0.0
  integer :: iZI(2),n_use !iZi - integer Zimp used to calculate sigv, n_use - 
                         !number of tables to be used, could be 1 or 2
  real(fp), dimension(n1) :: sigv_adas_wrk !sigma*v [m**3/sec]
  character*240 :: filename, filename_param    ! filename
!
!checking input data for availability
  istat=0
  sigv_adas=0._fp
  sigv_adas_wrk=0._fp
  if(beamchrg.eq.NEUTRAL) then
     !  ---------> Neutral Beam, charged particle target
     
     izneut = izneut_in
     zion = zion_in
     
  else if(beamchrg.eq.ION) then
     izneut = zion_in
     zion = dble(izneut_in)
     
  else
     
     istat = 1
     return
     
  endif
 
  call check_data_react(freact_type,beamchrg,izneut,zion,iZI,n_use,istat)
  if(istat.gt.0) then !some error in input data, do not proceed
     return
  endif
  write(cizneut,'(i5)') izneut
  do iz=1,n_use
     write(cizion,'(i5)') izi(iz)
     !
     ! create table's filename
     adas_tables_file=trim('tables/')//trim(react_type(freact_type))//&
          &'/'//trim(react_type(freact_type))//'_'//&
          & trim(adjustl(cizneut))//'_'//trim(adjustl(cizion))//'_'//'warmTarget.cdf'
     !
     call UFILNAM('ADASDIR',trim(adjustl(adas_tables_file)),filename)
     !
     ! try to open filename in tables directory
     call cdf_open(icdf,trim(filename),'r',fErr)
     !   
     if (fErr.ne.0) then !no table has been created
        write(6,*)' %adas_btsigv: OK table data being recomputed'
        !compute and write table         
        !open file and read axis parameters
        ilen=len(trim(filename))
        filename_param= filename(1:ilen-14)//trim('tableParameters.cdf')
        call cdf_open(icdf,trim(filename_param),'r',fErr)
        if (fErr.ne.0) then 
           !tables have not been initialized, try to read dummy data
           write(6,*)' %adas_btsigv: OK trying to read dummy data'
           call UFILNAM('ADASDIR',trim('tables/')//trim(react_type(freact_type))//&
                &'/'//'tableParameters.cdf',filename_param)
           call cdf_open(icdf,trim(filename_param),'r',fErr)
           if(ferr.gt.0) then
              write(6,*)' !adas_btsigv: faild to read table data'
              istat = 10
              return
           endif
        endif
        call cdfInqVar(icdf,'axis_param_warmTarget',idims,nctype)
        call cdf_read(icdf,'axis_param_warmTarget',axis_param_warmTarget(1:idims(1)))
        call cdf_close(icdf)
        !compute axis
!        write(*,*)'  %adas_btsigv : computing tables: ',trim(adas_tables_file)
        call compute_axis(e_axis,axis_param_warmTarget(1:4))
        call compute_axis(t_axis,axis_param_warmTarget(5:8))
        !     
        npts_e=int(axis_param_warmTarget(3))
        npts_t=int(axis_param_warmTarget(7))
        if(allocated(sigv_table))deallocate(sigv_table)
        allocate(sigv_table(npts_e,npts_t))
        if(allocated(wrk))deallocate(wrk)
        allocate(wrk(npts_e))
        sigv_table=0.0_fp
        wrk=0.0_fp
        ! set reaction key
        if(freact_type.eq.1) then !CX
           fadas_CX=4 ! converted to adas_ion routine for neutralizing CX 
           call sigprep_adas_z(fadas_CX,izneut,izi(iz),ikey)
           call comptabl_z(wrk,sigv_table,e_axis,t_axis,npts_e,npts_t,ier)
           
        elseif(freact_type.eq.2) then !II
           fadas_II=5 ! converted to adas_ion routine for total ionizataion
           call sigprep_adas_z(fadas_II,izneut,izi(iz),ikey)
           call comptabl_z(wrk,sigv_table,e_axis,t_axis,npts_e,npts_t,ier)
        endif
        call cdf_open(icdf,trim(filename),'w',fErr)
        call cdf_define(icdf,'axis_param_warmTarget',axis_param_warmTarget(1:8)) 
        call cdf_define(icdf,'btsigv',sigv_table(1:npts_e,1:npts_t)) 
        call cdf_write(icdf,'axis_param_warmTarget',axis_param_warmTarget(1:8))
        call cdf_write(icdf,'btsigv',sigv_table(1:npts_e,1:npts_t)) 
        call cdf_close(icdf)  
        deallocate(e_axis,t_axis)
        call cdf_open(icdf,trim(filename),'r',fErr)
     endif
     
     !tables already computed, read data 
     call cdfInqVar(icdf,'btsigv',idims,nctype)
     npts_e=idims(1)
     npts_t=idims(2)
     if(allocated(sigv_table))deallocate(sigv_table)
     allocate(sigv_table(npts_e,npts_t))
     call cdf_read(icdf, 'btsigv',sigv_table(1:npts_e,1:npts_t))
     call cdfInqVar(icdf,'axis_param_warmTarget',idims,nctype)
     call cdf_read(icdf,'axis_param_warmTarget',axis_param_warmTarget(1:idims(1))) 
     call cdf_close(icdf)
     !interpolate 2D table
     xlr=log(axis_param_warmTarget(2)/axis_param_warmTarget(1))
     xlr_t=log(axis_param_warmTarget(6)/axis_param_warmTarget(5))
     call FLINT_Z(evec,tevec,sigv_adas_wrk,n1,sigv_table,axis_param_warmTarget(1),axis_param_warmTarget(2),&
          &xlr,npts_e,axis_param_warmTarget(5),axis_param_warmTarget(6),&
          &xlr_t,npts_t,iwarn_adas)
     if(n_use.eq.2) then
        sigv_adas=sigv_adas+abs(zion-izi(n_use-iz+1))*sigv_adas_wrk/2.
     elseif(n_use.eq.1) then
        sigv_adas=zion/izi(1)*sigv_adas_wrk !scale to Zimp >10 (for H beam) or to Zimp >8 (for He beam)
     endif
  enddo !iz
  
end subroutine adas_btsigv_int_r8
!
!-----------------------------------------------------------------------------------------
!
subroutine adas_sigvte_ioniz_r8(zneut,tevec,n1,sigv_adas,istat)
! calculates <sig*v> electron impact ionization
  real(fp), intent(in) :: zneut                   ! atomic charge of primary   particle {1}, available only for H
  real(fp), dimension(n1), intent(in) :: tevec      ! vector electron temperature [KeV]
  integer, intent(in) :: n1                       ! vector's size
  real(fp), dimension(n1), intent(out) :: sigv_adas !sigma*v [m**3/sec]
  integer, intent(out) :: istat
  integer :: izneut
  izneut=zneut
  call adas_sigvte_ioniz_int(izneut,tevec,n1,sigv_adas,istat)
end subroutine adas_sigvte_ioniz_r8
!
!-----------------------------------------------------------------------------------------
!
subroutine adas_sigvte_ioniz_int(izneut,tevec,n1,sigv_adas,istat)
! calculates <sig*v> electron impact ionization
  integer, intent(in) :: izneut                   ! atomic charge of primary   H and He
  real(fp), dimension(n1), intent(in) :: tevec      ! vector electron temperature [KeV]
  integer, intent(in) :: n1                       ! vector's size
  real(fp), dimension(n1), intent(out) :: sigv_adas !sigma*v [m**3/sec]
!local
  character*2 :: react_type='ei'
  real(fp), dimension(:),pointer :: t_axis ! axis grid
  integer :: ier 
  integer, intent(out) :: istat
  real(fp), dimension(:),allocatable :: sigv_table ! tabulated sig*v  
  character*240 :: filename, filename_param    ! filename
!
!check input data
  istat = 0
  sigv_adas=0._fp
  if(izneut.gt.2) then !error in input data, do not proceed
     istat = 1
     return
  endif
  write(cizneut,'(i5)') izneut
  ! create table's filename
  !
  adas_tables_file=trim('tables/')//trim(react_type)//&
       &'/'//trim(react_type)//'_'//&
       & trim(adjustl(cizneut))//'_'//'coldTarget.cdf'
  !
  call UFILNAM('ADASDIR',trim(adjustl(adas_tables_file)),filename)
  if(trim(adjustl(filename_prev(1))).ne.trim(adjustl(filename))) then
  !
  ! try to open filename in tables directory
  call cdf_open(icdf,trim(filename),'r',fErr)
  
  if (fErr.ne.0) then !no table has been created
     write(6,*)' %adas_sigvte_ioniz: OK table data being recomputed'
     !compute and write table         
     !open file and read axis parameters
     ilen=len(trim(filename))
     filename_param= filename(1:ilen-14)//trim('tableParameters.cdf')
     call cdf_open(icdf,trim(filename_param),'r',fErr)
     if (fErr.ne.0) then 
        write(6,*)' %adas_sigvte_ioniz: trying to read dummy data'
        !tables have not been initialized, try to read dummy data
        call UFILNAM('ADASDIR',trim('tables/')//trim(react_type)//&
             &'/'//'tableParameters.cdf',filename_param)
        call cdf_open(icdf,trim(filename_param),'r',fErr)
        if(ferr.gt.0) then
           write(6,*)' %adas_sigvte_ioniz: faild to read table data'
           istat = 10
           return
        endif
     endif
     call cdfInqVar(icdf,'axis_param_coldTarget',idims,nctype)
     call cdf_read(icdf,'axis_param_coldTarget',axis_param_coldTarget(1:idims(1)))
     call cdf_close(icdf)
     !compute axis
     call compute_axis(t_axis,axis_param_coldTarget)
     !     
     npts=int(axis_param_coldTarget(3))
     if(allocated(sigv_table))deallocate(sigv_table)
     allocate(sigv_table(npts))
     sigv_table=0.0_fp
     if(izneut.eq.1) then
        call adas_ei_h(t_axis,npts,sigv_table,ier)
     elseif(izneut.eq.2) then
        call adas_ei_he(t_axis,npts,sigv_table,ier)
     endif

!write table to file
     call cdf_open(icdf,trim(filename),'w',fErr)
     call cdf_define(icdf,'axis_param_coldTarget',axis_param_coldTarget(1:4)) 
     call cdf_define(icdf,'sigv',sigv_table(1:npts)) 
     call cdf_write(icdf,'axis_param_coldTarget',axis_param_coldTarget(1:4))
     call cdf_write(icdf,'sigv',sigv_table(1:npts)) 
     call cdf_close(icdf)  
     deallocate(t_axis)
     call cdf_open(icdf,trim(filename),'r',fErr)
  endif
  !tables already computed, read data 
  call cdfInqVar(icdf,'sigv',idims,nctype)
  npts=idims(1)
  if(allocated(sigv_table))deallocate(sigv_table)
  allocate(sigv_table(npts))
  call cdf_read(icdf, 'sigv',sigv_table(1:npts))
  call cdfInqVar(icdf,'axis_param_coldTarget',idims,nctype)
  call cdf_read(icdf,'axis_param_coldTarget',axis_param_coldTarget(1:idims(1))) 
  call cdf_close(icdf)
  filename_prev(1)=filename
  
  if(allocated(sigv_table_prev)) then
     if(size(sigv_table_prev(:,1)).ne.npts) then
        deallocate(sigv_table_prev)
        allocate(sigv_table_prev(npts,1))
        sigv_table_prev(:,1)=0.0_fp
     endif
  else
     allocate(sigv_table_prev(npts,1))
     sigv_table_prev(:,1)=0.0_fp
  endif
  sigv_table_prev(1:npts,1)=sigv_table(1:npts)
  else
     if(allocated(sigv_table)) then
        if(size(sigv_table).ne.npts) then
           deallocate(sigv_table)
           allocate(sigv_table(npts))
        endif
     else
        allocate(sigv_table(npts))
     endif
     sigv_table(1:npts)=sigv_table_prev(1:npts,1)
  endif
  
  !interpolate 1D table
  xlr=log(axis_param_coldTarget(2)/axis_param_coldTarget(1))
  call FLIN1_Z(tevec,sigv_adas,n1,sigv_table,axis_param_coldTarget(1),axis_param_coldTarget(2),&
       &xlr,npts,iwarn_adas)
     
end subroutine adas_sigvte_ioniz_int
!---------------------------------------------------------------------!
! adas_ei.f90:                                                        !
!     by Michael Kraus (michael.kraus@ipp.mpg.de)                     !
!     created 2009/06/24                                              !
!                                                                     !
!     reads H0 electron impact ionisation rate coefficients from adas    !
!     adf07 data tables applies spline interpolation within the data  !
!     range and logarithmic extrapolation beyond                      !
!                                                                     !!                                                                     !
!---------------------------------------------------------------------!
subroutine adas_ei_h(Te, N, SIGV, iErr)
      use EZspline_obj
      use EZspline
      
      implicit none

! Function Parameters
!
!     Te(N)    : electron temperature                            [KeV]
!     N        : number of temperature values
!     SIGV(N)  : requested rate coefficients                     [m**3/s]
!     iErr     : error code    (0 = OK,                          
!                               1 = temperature invalid
!                               2 = adas file reading error
!                               3 = spline error
!                               4 = 
!                              )
!
      integer :: N
      real(fp)  :: Te(N), SIGV(N)
      integer :: iErr
      
      
! Local Parameters
!
! maxn         : max number of entries per data table
!
! fte1(maxn)   : Te    from file (low  temperature part)
! fsigv1(maxn) : sigma from file (low  temperature part)
! fte2(maxn)   : Te    from file (high temperature part)
! fsigv2(maxn) : sigma from file (high temperature part)
! fte(2*maxn)  : Te    from file (accumulated data)
! fsigv(2*maxn): sigma from file (accumulated data)
! fn           : size of data table in file
! i, it, is    : loop indices
!
! sigv_ezspl   : EzSpline object for <sigmav>
! bcs_sigv     : boundary conditions for <sigmav> spline
! serr         : spline error code
!
! tape         : data file identifier adas archive file
! outdbg       : data file identifier debug output
! fErr         : file reading error code
! nsel         : number of tables in file
!
! adas_ei_data : atomic data archive file name (adf07)
! filename     : complete path of adas archive file
! line         : temporary string for file input
!
      integer, parameter :: maxn    = 25
      
      real(fp)  :: fte1(maxn),  fsigv1(maxn)
      real(fp)  :: fte2(maxn),  fsigv2(maxn)
      real(fp)  :: fte(2*maxn), fsigv(2*maxn)
      real(fp)  :: logfte(2*maxn), logfsigv(2*maxn)
      real(fp)  :: logSIGV(N)
      integer :: fn1, fn2, fn, fn1stop
      integer :: i, it, is
      
      type(EZspline1)    :: sigv_ezspl
      integer            :: bcs_sigv(2)
      integer            :: sErr
      
      integer, parameter :: tape   = 74
      integer, parameter :: outdbg = 75
      integer            :: fErr
      integer            :: nsel
      
      character*40,  parameter :: adas_ei_data = 'data/adf07/szd93#h/szd93#h_h.dat'
      character*240 :: filename
      character*80  :: line
      
      iErr = 0
      Te=Te*1.e+3_fp !convert to [eV]
      
! check if input data meets requirements and is valid
      ! check if collision energy is positive
      do i=1,N
         if (Te(i) .le. 0.0) then
            iErr = 1
            return
         endif
      enddo
      
      
! read data from archive (refer to ADAS adf21 file format documentation at [2])
      call UFILNAM('ADASDIR',adas_ei_data,filename)
      open(unit=tape,file=filename,action='read', iostat=fErr)
      ! check if file could be opened
      if (fErr .ne. 0) then
         iErr = 2
         return
      endif
      
      ! read number of tables in file
      read(tape,1000) nsel
      if (nsel .lt. 3) then
         iErr = 2
         return
      endif
      
     ! read first table (low temperature)
      read(tape,1001) fn1
      read(tape,1002) (fte1(it),it=1,fn1)
      read(tape,1002) (fsigv1(is),is=1,fn1)
      
      ! skip second table (very low temperature)
      do i=1,9
         read(tape,'(a)') line
      enddo
      
      ! read third table (high temperature)
      read(tape,1001) fn2
      read(tape,1002) (fte2(it),it=1,fn2)
      read(tape,1002) (fsigv2(is),is=1,fn2)
      
      close(tape) 
      
1000  format(i5)
1001  format(15x,i2)
1002  format(6(1x,E9.3E2),/,6(1x,E9.3E2))
      
      
      ! merge tables
      do i=1,fn1
         if (fte1(i) .ge. fte2(1)) then
            exit
         else
            fte(i)   = fte1(i)
            fsigv(i) = fsigv1(i)
         endif
      enddo
      fn1stop = i-1
      
      do i=1,fn2
         fte  (fn1stop+i) = fte2(i)
         fsigv(fn1stop+i) = fsigv2(i)
      enddo
      
      fn = fn1stop + fn2
      
      
      if (fn .lt. 3) then
         iErr = 2
         return
      endif
      
! output adas data for debugging
   
!      filename = "adas_ei_dbg.dat"
!      open(unit = outdbg, file = filename)
!      do i=1,fn
!         write(outdbg,'(5g20.10,5g20.10)') fte(i), fsigv(i)
!      enddo
!      close(unit = outdbg)
      
      
! calculate log of spline data
     do i=1,fn
         logfte(i)   = dlog(fte(i))
         logfsigv(i) = dlog(fsigv(i))
      enddo
      

! output log data for debugging
   
!      filename = "adas_ei_dbglog.dat"
!      open(unit = outdbg, file = filename)
!      do i=1,fn
!         write(outdbg,'(5g20.10,5g20.10)') logfte(i), logfsigv(i)
!      enddo
!      close(unit = outdbg)
      
      
! create EzSpline object and put data into it
      
      bcs_sigv = (/0, 0/)     ! not-a-knot boundary conditions
      
      call EZspline_init(sigv_ezspl, fn, bcs_sigv, sErr)    ! initialise spline object grid and boundary conditios
      call EZspline_error(sErr)                             ! print error message
      if (sErr .ne. 0) then                                 ! interrupt routine in case of error
         iERR = 3
         return
      endif
      sigv_ezspl%x1 = logfte(1:fn)                          ! set grid points
      call EZspline_setup(sigv_ezspl, logfsigv(1:fn), sErr) ! initialise spline data
      call EZspline_error(sErr)                             ! print error message
      if (sErr .ne. 0) then                                 ! interrupt routine in case of error
         iERR = 3
         return
      endif
      
      
! evaluate spline object with Erel values
      do i=1,N
         ! check if requested collision energy is within the available domain
         call EZspline_isInDomain(sigv_ezspl, dlog(te(i)), sErr)
!         call EZspline_error(sErr)
         if (sErr .eq. 0) then
            ! requested value in range, evaluate spline
            call EZspline_interp(sigv_ezspl, dlog(te(i)), logSIGV(i), sErr)
            call EZspline_error(sErr)
            if (sErr .ne. 0) then
               iErr = 3
               return
            endif
            SIGV(i) = dexp(logSIGV(i))
         else
            ! requested value out of range, extrapolate
            if (dlog(te(i)) .lt. sigv_ezspl%x1min) then
               logSIGV(i) = logfsigv(1) + (dlog(te(i)) - logfte(1))            &
               &                        / (logfte(2)   - logfte(1))            &
               &                        * (logfsigv(2) - logfsigv(1))
               SIGV(i) = exp(logSIGV(i))
            else if (dlog(te(i)) .gt. sigv_ezspl%x1max) then
               logSIGV(i) = logfsigv(fn) + (dlog(te(i))    - logfte(fn))       &
               &                         / (logfte(fn-1)   - logfte(fn))       &
               &                         * (logfsigv(fn-1) - logfsigv(fn))
               SIGV(i) = dexp(logSIGV(i))
            else
               iErr = 3
               return
            endif
         endif
      enddo

      SIGV=SIGV*1.e-6_fp !convert from cm**3/sec to m**3/sec
      
      return
end subroutine adas_ei_h
!---------------------------------------------------------------------!
! adas_ei.f90:                                                        !
!     by MG                  !
!     created 2012/05/08                                              !
!                                                                     !
!     reads He electron impact ionisation rate coefficients from adas    !
!     adf07 data tables applies spline interpolation within the data  !
!     range and logarithmic extrapolation beyond                      !
!                                                                     !!                                                                     !
!---------------------------------------------------------------------!
subroutine adas_ei_he(Te, N, SIGV, iErr)
      use EZspline_obj
      use EZspline
      
      implicit none

! Function Parameters
!
!     Te(N)    : electron temperature                            [KeV]
!     N        : number of temperature values
!     SIGV(N)  : requested rate coefficients                     [m**3/s]
!     iErr     : error code    (0 = OK,                          
!                               1 = temperature invalid
!                               2 = adas file reading error
!                               3 = spline error
!                               4 = 
!                              )
!
      integer :: N
      real(fp)  :: Te(N), SIGV(N)
      integer :: iErr
      
      
! Local Parameters
!
! maxn         : max number of entries per data table
!
! fte1(maxn)   : Te    from file (low  temperature part)
! fsigv1(maxn) : sigma from file (low  temperature part)
! fte2(maxn)   : Te    from file (high temperature part)
! fsigv2(maxn) : sigma from file (high temperature part)
! fte(2*maxn)  : Te    from file (accumulated data)
! fsigv(2*maxn): sigma from file (accumulated data)
! fn           : size of data table in file
! i, it, is    : loop indices
!
! sigv_ezspl   : EzSpline object for <sigmav>
! bcs_sigv     : boundary conditions for <sigmav> spline
! serr         : spline error code
!
! tape         : data file identifier adas archive file
! outdbg       : data file identifier debug output
! fErr         : file reading error code
! nsel         : number of tables in file
!
! adas_ei_data : atomic data archive file name (adf07)
! filename     : complete path of adas archive file
! line         : temporary string for file input
!
      integer, parameter :: maxn    = 25
      
      real(fp)  :: fte(maxn), fsigv(maxn)
      real(fp)  :: logfte(maxn), logfsigv(maxn)
      real(fp)  :: logSIGV(N)
      integer ::  fn
      integer :: i, it, is
      
      type(EZspline1)    :: sigv_ezspl
      integer            :: bcs_sigv(2)
      integer            :: sErr
      
      integer, parameter :: tape   = 74
      integer, parameter :: outdbg = 75
      integer            :: fErr
      integer            :: nsel
      
      character*40,  parameter :: adas_ei_data = 'data/adf07/szd93#he/szd93#he_he.dat'
      character*240 :: filename
      character*80  :: line
      
      iErr = 0
      Te=Te*1.e+3_fp !convert to [eV]
      
! check if input data meets requirements and is valid
      ! check if collision energy is positive
      do i=1,N
         if (Te(i) .le. 0.0) then
            iErr = 1
            return
         endif
      enddo
      
      
! read data from archive (refer to ADAS adf21 file format documentation at [2])
      call UFILNAM('ADASDIR',adas_ei_data,filename)
      open(unit=tape,file=filename,action='read', iostat=fErr)
      ! check if file could be opened
      if (fErr .ne. 0) then
         iErr = 2
         return
      endif
      
      ! read number of tables in file
      read(tape,1000) nsel
      if (nsel .lt. 3) then
         iErr = 2
         return
      endif
      
     ! read first table (low temperature)
      read(tape,1001) fn
      read(tape,1002) (fte(it),it=1,fn)
      read(tape,1002) (fsigv(is),is=1,fn)
      
      close(tape) 
      
1000  format(i5)
1001  format(15x,i2)
1002  format(6(1x,E9.3E2),/,6(1x,E9.3E2))
      
      
      
! calculate log of spline data
     do i=1,fn
         logfte(i)   = dlog(fte(i))
         logfsigv(i) = dlog(fsigv(i))
      enddo
      

! output log data for debugging
   
!      filename = "adas_ei_dbglog.dat"
!      open(unit = outdbg, file = filename)
!      do i=1,fn
!         write(outdbg,'(5g20.10,5g20.10)') logfte(i), logfsigv(i)
!      enddo
!      close(unit = outdbg)
      
      
! create EzSpline object and put data into it
      
      bcs_sigv = (/0, 0/)     ! not-a-knot boundary conditions
      
      call EZspline_init(sigv_ezspl, fn, bcs_sigv, sErr)    ! initialise spline object grid and boundary conditios
      call EZspline_error(sErr)                             ! print error message
      if (sErr .ne. 0) then                                 ! interrupt routine in case of error
         iERR = 3
         return
      endif
      sigv_ezspl%x1 = logfte(1:fn)                          ! set grid points
      call EZspline_setup(sigv_ezspl, logfsigv(1:fn), sErr) ! initialise spline data
      call EZspline_error(sErr)                             ! print error message
      if (sErr .ne. 0) then                                 ! interrupt routine in case of error
         iERR = 3
         return
      endif
      
      
! evaluate spline object with Erel values
      do i=1,N
         ! check if requested collision energy is within the available domain
         call EZspline_isInDomain(sigv_ezspl, dlog(te(i)), sErr)
!         call EZspline_error(sErr)
         if (sErr .eq. 0) then
            ! requested value in range, evaluate spline
            call EZspline_interp(sigv_ezspl, dlog(te(i)), logSIGV(i), sErr)
            call EZspline_error(sErr)
            if (sErr .ne. 0) then
               iErr = 3
               return
            endif
            SIGV(i) = dexp(logSIGV(i))
         else
            ! requested value out of range, extrapolate
            if (dlog(te(i)) .lt. sigv_ezspl%x1min) then
               logSIGV(i) = logfsigv(1) + (dlog(te(i)) - logfte(1))            &
               &                        / (logfte(2)   - logfte(1))            &
               &                        * (logfsigv(2) - logfsigv(1))
               SIGV(i) = exp(logSIGV(i))
            else if (dlog(te(i)) .gt. sigv_ezspl%x1max) then
               logSIGV(i) = logfsigv(fn) + (dlog(te(i))    - logfte(fn))       &
               &                         / (logfte(fn-1)   - logfte(fn))       &
               &                         * (logfsigv(fn-1) - logfsigv(fn))
               SIGV(i) = dexp(logSIGV(i))
            else
               iErr = 3
               return
            endif
         endif
      enddo

      SIGV=SIGV*1.e-6_fp !convert from cm**3/sec to m**3/sec
      
      return
end subroutine adas_ei_he

subroutine compute_axis(e_vec,e_vec_range)
  ! calculate axis grid, LOG or LIN
  implicit none
  real(fp), dimension(4), intent(in) :: e_vec_range ! min and max val, npts, specification 0 for LOG, 1 fog LIN
  real(fp), dimension(:), pointer :: e_vec ! output grid
  integer :: spec,i
  real(fp) :: t
  spec=int( e_vec_range(4))
  npts=int( e_vec_range(3))

  allocate(e_vec(npts))

  if(spec.eq.0) then
     t = log(e_vec_range(2) / e_vec_range(1))
     do i=1,npts
        e_vec(i)=e_vec_range(1)*exp(dble(i-1)*t/dble(npts-1))
     enddo
     e_vec(npts)=e_vec_range(2)
  elseif (spec.eq.1) then
     t = e_vec_range(2)- e_vec_range(1)
     do i=1,npts
        e_vec(i)=e_vec_range(1)+(dble(i-1)*t/dble(npts-1))
     enddo
     e_vec(npts)=e_vec_range(2)
  endif
end subroutine compute_axis
!
!-----------------------------------------------------------------------------------------
!
subroutine check_data_react(freact_type,beamchrg,izneut,zion,izion_use,n_use,istat)
!
!checking input data for available reaction in ADAS lib
!
  integer, intent(in) :: freact_type    !reaction type: 1  ='CX', 2 = 'II', 3 = 'SV' for excited states
  integer, intent(in) :: izneut  !atomic charge of primary   particle {1, 2}
  real(fp), intent(in) :: zion   !atomic charge of secondary particle {1, ..., 10}
  integer, intent(in) :: beamchrg !beam type neutral  = 1 or ion =2 
 INTEGER, intent(out) :: istat ! completion code; 0 = normal
                                !  istat = 2:  irtype argument invalid
                                !  istat = 3:  izneut or izchrg invalid
  integer, intent(out) ::  izion_use(2) !izion will be used to calculate sigv, then scale to izion
  integer, intent(out) :: n_use !number sigv need to be calculated to get sigv for a given zion
!
  integer, parameter :: NEUTRAL=1, ION=2
  integer, dimension(2,10) :: izchrg 
  integer izion, iz0,iz1
  real(fp) remaind
!
  !available reaction for H CX,II see adas_ion 
  !available reaction for He CX,II see adas_ion
  ! atomic charge of secondary particle {1, ..., 10}
  izchrg(1,:)=(/1,2,3,4,5,6,7,8,9,10/)
  izchrg(2,:)=(/1,2,0,4,0,6,0,8,0,0/)  
  istat=0
  izion=int(zion)
  remaind=mod(zion,1._fp)
  izion_use=izion
  n_use=1
  if(beamchrg.eq.ION) then !ION beam
     if (freact_type.gt.2) then  !(neutralizing) charge exchange
        istat = 3 ! beamchrg cannot be used for this reaction
        return
     endif
  endif
  if(izneut.gt.2) then
     istat = 3 ! invalid izneut, izion
     return
  endif
  if(freact_type.lt.1.or.freact_type.gt.3) then
     istat = 2
     return
  endif
  if (freact_type.eq.1) then  !(neutralizing) charge exchange
        if(zion.gt.dble(izneut)) then
           istat = 3 ! izneut cannot neutralize izion
           return
        endif
  endif
  if (freact_type.eq.3) then  ! SV reaction
     if(izneut.gt.1) then
        istat = 3 ! invalid izneut
        return
     endif
  endif
  if(izneut.eq.1) then
     if(izion.gt.10) then
        izion_use(1)=10
        n_use=1
     elseif((izion.lt.10).and.(remaind.gt.0.0_fp)) then
        izion_use(1)=izion
        izion_use(2)=izion+1        
        n_use=2
     endif
  elseif(izneut.eq.2) then
     if(izion.gt.8) then
        izion_use=8
        n_use=1
     elseif((izion.lt.8)) then
        n_use=1
        iz0=izion
        do
           if(izchrg(2,iz0).eq.0) then
              iz0=max(1,iz0-1)
           else
              izion_use(1)=iz0
              exit
           endif
        enddo

        if(remaind.gt.0.0_fp)then
           n_use=2
           iz1=izion+1
           do
              if(izchrg(2,iz1).eq.0) then
                 iz1= min(8,iz1+1)   
              else
                 izion_use(2)=iz1 
                 exit
              endif
           enddo
        endif
     endif
  endif
  
end subroutine check_data_react
!
!-----------------------------------------------------------------------------------------
!
subroutine extend(i_z,nuse)
  implicit none
  integer :: i_z,nuse
  real(fp), dimension(:),allocatable :: tmp! wrk.
  allocate(tmp(npts))
  tmp=0.0_fp
  tmp(1:npts_prev(i_z-1))=sigv_table_prev(1:npts_prev(i_z-1),i_z-1)
  deallocate(sigv_table_prev)
  allocate(sigv_table_prev(maxval(npts_prev(:)),nuse))
  sigv_table_prev=0.0_fp
  sigv_table_prev(1:npts_prev(i_z-1),i_z-1)=tmp(1:npts_prev(i_z-1))
  deallocate(tmp)
end subroutine extend

end module adas_mod
