program fpreact_test
 
  ! test code for fpreact -- fortran interface to preact module
  ! this code tests a sampling of reaction tables; it  tests
  ! all tables
  use iso_c_binding, only: fp => c_double
  use physconst_mod, only: mp_Kg,qe_eV,zero,one
  use adas_mod
  use periodic_table_mod
  use fpreact_parameters

  implicit NONE
 
  ! note that the fpreact calls are generally vectorized, so we
  ! create vectors here -- even if only of length 1.
 
  integer, parameter  :: jZimp_lbound = 3 , jZimp_ubound = 74 !3 <= Z impurity <=74  and  58,59,60 has some  
                                                              !problems with neutral radiation numerics,
                                                              !so they are forbidden.
  integer  :: jZimp  ! Z for impurity
  
  integer i               ! loop variable 

  real(fp) enr8(1)          ! energy or energy/nucleon (KeV or KeV/AMU)
  real(fp) tr8(1)           ! temperature or T/nuclean (KeV or KeV/AMU)
  real(fp) ansr(1),ansrr(1)          ! result returned (usually <sigma*v>, m**3/sec)
  real(fp) var8(1)          ! variation parameter (for beam-beam fusion table)

  real(fp), dimension(:,:), allocatable :: rioniz8, rrecom8, rcoron8, rrad8 ! impurity rates 
 
  
  integer :: izbeam,iztarg
  integer ierr,ihandle,idum1,idum2
  integer, dimension(2) :: izimp =(/6,8/)        !SV reaction is available only for C+6, and O+8
  integer, dimension(3) :: izneut = (/1,2,3/)    !SV reaction. Neutrals are H0, He0 and LiO
  integer :: iimp,ineut
  real(fp) ranger8(2)
  real(fp) aa,aa1,aa2,aa3
  integer iz,ic
  real(fp) :: zz
  character*16 tmp_r8
  character(len=5) :: fusion_type
  iz=2
  aa=zero
  do iz=1,109
     write(*,*)'tr_species_convert ',iz 
     call tr_species_convert(iz,1,iz*2,aa,aa1,aa2,ic)
     call tr_species_convert(iz,1,int(aa2),aa,aa1,aa2,ic)
     zz= aa2/mp_Kg
     if(iz.eq.3) then 
        zz=6.9610_fp
        call tr_species_convert(iz,1,int(zz),aa,aa1,aa2,ic)
     endif
     call tr_species_convert(iz,1,zz,aa,aa1,aa3,ic)
     if(aa2.ne.aa3) write(*,*)'tr_species_convert',aa2/mp_Kg,aa3/mp_Kg
  enddo
  tmp_r8=to_periodic_table(3,6.88_fp,1,1)
  write(*,*)'to_pseudo_periodic_table ',tmp_r8
  tmp_r8=to_periodic_table(3,6.01_fp,1,1)
  write(*,*)'to_pseudo_periodic_table ',tmp_r8
  tmp_r8=to_pseudo_periodic_table(1,3,6.88_fp,1,1)
  write(*,*)'to_pseudo_periodic_table ',tmp_r8
  tmp_r8=to_pseudo_periodic_table(1,3,6.01_fp,1,1)
  write(*,*)'to_pseudo_periodic_table ',tmp_r8
  tmp_r8=to_pseudo_periodic_table(1,3,6.96_fp,1,1)
  write(*,*)'to_pseudo_periodic_table ',tmp_r8
  tmp_r8=to_pseudo_periodic_table(1,3,6.88_fp,1,1)
  write(*,*)'to_pseudo_periodic_table ',tmp_r8
  tmp_r8=to_pseudo_periodic_table(1,3,6.01_fp,1,1)
  write(*,*)'to_pseudo_periodic_table ',tmp_r8
  tmp_r8=to_pseudo_periodic_table(1,3,6.96_fp,1,1)
  write(*,*)'to_pseudo_periodic_table ',tmp_r8
 
  enr8 = 10.00_fp         ! KeV
  
  tr8 = 3.00_fp           ! KeV
  write(6,*) ' '
  write(6,*) ' -->fpreact_test:  atomic reaction tests...............'
  write(6,*) 'IMPURITY STOPPING CROSS_SECTION'
  !-------------------
  ! test: SV  impurity stopping cross-section
  !
 
 
  iimp=5
  do ineut=1,size(izneut)
     do iimp=jZimp_lbound, jZimp_ubound
        call zstop_sigv(izneut(ineut),iimp,enr8,1,ansr)
        call zstop_sigv(izneut(ineut),dble(iimp),enr8,1,ansrr)
        
        write(6,1001) izneut(ineut),iimp,enr8,ansr,ansrr
        call zstop_handle(ineut,iimp,ihandle)
        call sv_coldtarget_erange(ihandle,ranger8(1),ranger8(2),idum1,idum2)
     enddo
  enddo
1001 format(/ &
          ' ** impurity stopping sigma*v ** '/ &
          ' Z(neutral atom) = ',i1,' Z(impurity) = ',i2,' E/A = ',f10.2, &
          ' KeV/AMU'/ &
          ' -->real(fp) sigma*v = ',1pe20.13,/ &
          ' -->real(fp) sigma*v = ',1pe20.13 / )
1021 format(/ &
          ' ** impurity stopping table energy limits'/ &
          ' Z(neutral atom) = ',i1,' Z(impurity) = ',i2,' E/A_min = ',1pe20.13, &
          ' KeV/AMU'/ &
          ' E/A_max = ',1pe20.13, &
          ' KeV/AMU'/ )
  !-------------------
  ! test:  electron impact ionization
  !
  write(6,*) ' '
  write(6,*) ' '
  write(6,*) 'ELECTRON IMPACT IONIZATION'
  do ineut=1,size(izneut)
     call sigvte_ioniz(izneut(ineut),tr8,1,ansr)
     
     write(6,1002) izneut(ineut),tr8,ansr

        call sigvte_ioniz_handle(izneut(ineut),ihandle)
        call ei_sigvte_trange(ihandle,ranger8(1),ranger8(2),idum1,idum2)
  enddo
  
1002 format(/ &
          ' ** electron impact ionization <sigma*v> ** '/ &
          ' Z(neutral atom) = ',i1,' electron temperature = ',f10.2,' KeV'/ &
          ' -->real(fp) <sigma*v> = ',1pe20.13)
 

 
2001 format(/' electron ionization Z=',i1,' table limits (Te, KeV):'/ &
          ' (preact ei_sigvte_trange call,  real(fp)):  ',2(1x,1pe20.13))

  !-------------------
  !-------------------
 
  enr8 = 100.00_fp         ! KeV (beam energy/nucleon)
  
  tr8 = 10.00_fp           ! KeV (target temperature/nucleon)
  
  !-------------------
  ! test:  impact ionization
  !
  write(6,*)' '
  write(6,*)' '
  write(6,*)'IMPACT IONIZATION NEUTRAL_BEAM '
  do ineut=1,size(izneut)
     do iimp=1,size(izneut)
        izbeam=ineut
        iztarg=iimp
        call hatom_btsigv(fpreact_II,fpreact_NEUTRAL_BEAM, &
             enr8,tr8,1,izbeam,iztarg, ansr,ierr)
        
        if(ierr.ne.0) call errmsg_exit(' ?hatom_btsigv returned an error code!')
        
        write(6,1003) ' ** ion impact ionization <sigma*v> ** ', &
             izbeam,iztarg,enr8,tr8,ansr
           call hatom_handle(2,izbeam,iztarg,ihandle)
           call ii_warmtarget_erange(ihandle,ranger8(1),ranger8(2),idum1,idum2)
           call ii_coldtarget_erange(ihandle,ranger8(1),ranger8(2),idum1,idum2)
     enddo
  enddo
1023 format(/ &
          ' **  II warm target table energy limits'/ &
          ' Z(neutral atom) = ',i1,' Z(target) = ',i2,' E/A_min = ',1pe20.13, &
          ' KeV/AMU'/ &
          ' E/A_max = ',1pe20.13, &
          ' KeV/AMU'/ )
1024 format(/ &
          ' **  II cold target table energy limits'/ &
          ' Z(neutral atom) = ',i1,' Z(target) = ',i2,' E/A_min = ',1pe20.13, &
          ' KeV/AMU'/ &
          ' E/A_max = ',1pe20.13, &
          ' KeV/AMU'/ )

  write(6,*)' '
  write(6,*)' '
  write(6,*)'IMPACT IONIZATION ION_BEAM '
  do ineut=1,size(izneut)
     do iimp=1,size(izneut)
        izbeam=ineut
        iztarg=iimp
        call hatom_btsigv(fpreact_II,fpreact_ION_BEAM, &
             enr8,tr8,1,izbeam,iztarg, ansr,ierr)
        
        if(ierr.ne.0) call errmsg_exit(' ?hatom_btsigv returned an error code!')
        
        write(6,1003) ' ** ion impact ionization <sigma*v> ** ', &
             izbeam,iztarg,enr8,tr8,ansr
     enddo
  enddo
     

  !-------------------
  ! test:  charge exchange rate coefficient
  write(6,*)' '
  write(6,*)' '
  write(6,*)'CHARGE EXCHANGE RATE COEFFICIENT NEUTRAL_BEAM'
  !
  do ineut=1,size(izneut)
     do iimp=1,ineut
        izbeam=ineut
        iztarg=iimp
 
        call hatom_btsigv(fpreact_CX,fpreact_NEUTRAL_BEAM, &
             enr8,tr8,1,izbeam,iztarg, ansr,ierr)
        
        if(ierr.ne.0) call errmsg_exit(' ?hatom_btsigv returned an error code!')
        
        write(6,1003) ' ** charge exchange <sigma*v> ** ', &
             izbeam,iztarg,enr8,tr8,ansr
           call hatom_handle(1,izbeam,iztarg,ihandle)
           call cx_warmtarget_erange(ihandle,ranger8(1),ranger8(2),idum1,idum2)
           call cx_coldtarget_erange(ihandle,ranger8(1),ranger8(2),idum1,idum2)
     enddo
  enddo
1025 format(/ &
          ' **  CX warm target table energy limits'/ &
          ' Z(neutral atom) = ',i1,' Z(target) = ',i2,' E/A_min = ',1pe20.13, &
          ' KeV/AMU'/ &
          ' E/A_max = ',1pe20.13, &
          ' KeV/AMU'/ )
1026 format(/ &
          ' **  CX cold target table energy limits'/ &
          ' Z(neutral atom) = ',i1,' Z(target) = ',i2,' E/A_min = ',1pe20.13, &
          ' KeV/AMU'/ &
          ' E/A_max = ',1pe20.13, &
          ' KeV/AMU'/ )
  write(6,*)' '
  write(6,*)' '
  write(6,*)'CHARGE EXCHANGE RATE COEFFICIENT ION_BEAM'
  !
  do ineut=1,size(izneut)
     do iimp=1,ineut
        izbeam=iimp
        iztarg=ineut
 
        call hatom_btsigv(fpreact_CX,fpreact_ION_BEAM, &
             enr8,tr8,1,izbeam,iztarg, ansr,ierr)
        
        if(ierr.ne.0) call errmsg_exit(' ?hatom_btsigv returned an error code!')
        
        write(6,1003) ' ** charge exchange <sigma*v> ** ', &
             izbeam,iztarg,enr8,tr8,ansr
     enddo
  enddo
  
  !-------------------
  ! test:  charge exchange Eav rate coefficient
  !
  
  
  write(6,*)' '
  write(6,*)' '
  write(6,*)'CHARGE EXCHANGE Eav RATE COEFFICIENT NEUTRAL_BEAM'
  do ineut=1,size(izneut)
     do iimp=1,ineut
        izbeam=ineut
        iztarg=iimp
        call hatom_btsigv(fpreact_EAV,fpreact_NEUTRAL_BEAM, &
             enr8,tr8,1,izbeam,iztarg, ansr,ierr)
        
        if(ierr.ne.0) call errmsg_exit(' ?hatom_btsigv returned an error code!')
        
        write(6,1003) ' ** charge exchange <Eav> of target reagent ** ', &
             izbeam,iztarg,enr8,tr8,ansr
     enddo
  enddo
  write(6,*)' '
  write(6,*)' '
  write(6,*)'CHARGE EXCHANGE Eav RATE COEFFICIENT ION_BEAM'
  do ineut=1,size(izneut)
     do iimp=1,ineut
        izbeam=iimp
        iztarg=ineut
        call hatom_btsigv(fpreact_EAV,fpreact_ION_BEAM, &
             enr8,tr8,1,izbeam,iztarg, ansr,ierr)
        
        if(ierr.ne.0) call errmsg_exit(' ?hatom_btsigv returned an error code!')
        
        write(6,1003) ' ** charge exchange <Eav> of target reagent ** ', &
             izbeam,iztarg,enr8,tr8,ansr
     enddo
  enddo
  
  !-------------------
  ! test:  charge exchange rate coefficient
  !
  write(6,*)' '
  write(6,*)' '
  write(6,*)'CHARGE EXCHANGE Fd RATE COEFFICIENT NEUTRAL_BEAM'
  do ineut=1,size(izneut)
     do iimp=1,ineut
        izbeam=ineut
        iztarg=iimp

        call hatom_btsigv(fpreact_FD,fpreact_NEUTRAL_BEAM, &
             enr8,tr8,1,izbeam,iztarg, ansr,ierr)
        
        if(ierr.ne.0) call errmsg_exit(' ?hatom_btsigv returned an error code!')
        
        write(6,1003) ' ** charge exchange <fd> (normalized <vb.vtarg>) ** ', &
             izbeam,iztarg,enr8,tr8,ansr
     enddo
  enddo
  write(6,*)' '
  write(6,*)' '
  write(6,*)'CHARGE EXCHANGE Fd RATE COEFFICIENT ION_BEAM '
  do ineut=1,size(izneut)
     do iimp=1,ineut
        izbeam=iimp
        iztarg=ineut

        call hatom_btsigv(fpreact_FD,fpreact_ION_BEAM, &
             enr8,tr8,1,izbeam,iztarg, ansr,ierr)
        
        if(ierr.ne.0) call errmsg_exit(' ?hatom_btsigv returned an error code!')
        
        write(6,1003) ' ** charge exchange <fd> (normalized <vb.vtarg>) ** ', &
             izbeam,iztarg,enr8,tr8,ansr
     enddo
  enddo
 
 1003 format(/,A,/ &
          ' Z(neutral beam) = ',i1,'  Z(target plasma) = ',i1/ &
          ' E(beam) = ',f10.2,' KeV/AMU;  T(target) = ',f10.2,' KeV/AMU'/ &
          ' -->real(fp) result = ',1pe20.13)
  
  write(6,*)' '
  write(6,*)' '
  write(6,*)'CHARGE EXCHANGE sigma*v  COEFFICIENT'
  do ineut=1,size(izneut)  !neutrals
     do iimp=1,ineut       !ion species
        izbeam=ineut
        iztarg=iimp

        call hatom_sigv(fpreact_CX,enr8,1,izbeam,iztarg, ansr,ierr)
        
        if(ierr.ne.0) call errmsg_exit(' ?hatom_sigv returned an error code!')
        
        write(6,1013) ' ** charge exchange sigma*v (m**3/sec) **', &
             izbeam,iztarg,enr8,ansr
     enddo
  enddo
  write(6,*)' '
  write(6,*)' '
  write(6,*)' IMPACT IONIZATION sigma*v  COEFFICIENT'
  do ineut=1,size(izneut)  !neutrals
     do iimp=1,size(izneut)!ion species
        izbeam=ineut
        iztarg=iimp

        call hatom_sigv(fpreact_II,enr8,1,izbeam,iztarg, ansr,ierr)
        
        if(ierr.ne.0) call errmsg_exit(' ?hatom_sigv returned an error code!')
        
        write(6,1013) ' ** impact ionization  sigma*v (m**3/sec) **', &
             izbeam,iztarg,enr8,ansr
     enddo
  enddo
 
 1013 format(/,A,/ &
          ' Z(neutral beam) = ',i1,'  Z(ion species) = ',i1/ &
          ' E(beam) = ',f10.2,' KeV/AMU'/ &
          ' -->real(fp) result = ',1pe20.13)
   

 
 !-------------------
  ! test:  electron, H recombination
  !
  write(6,*)' '
  write(6,*)' '
  write(6,*)'ELECTRON H RECOMBINATION'

  call sigvte_reco(tr8,1,ansr)
 
  write(6,1004) tr8,ansr
1004 format(/ &
          ' ** <sigma*v> e-,H+ recombination, for Te = ',f10.2,' KeV:'/ &
          ' -->real(fp) result = ',1pe20.13)
  !-------------------
  write(6,*) ' '
  write(6,*) ' '
  write(6,*) ' '
  write(6,*) 'COLD TARGET  FUSION REACTION'
  !-------------------
  ! test:  COLD TARGET  fusion
  !  the following have the same reactivity
  !     DT  --  D beam, T cold target  50 KeV D beam
  !     TD  --  T beam, D cold target  75 KeV T beam
  !  the energy is must be measured in the rest frame of the target!
  !  (similar issue for D3/3D and T3/3T).
  ! 
  ! The results will be not the same but close to each other, because each reaction
  ! has own table. So it is matter of an interpolation.

  tr8=50.0_fp
  !  DT   -- DT fusion:  D beam, T target 
  fusion_type=' DT '
  call fusn_coldtarget_DT(tr8,ansr,1)
  
  write(6,1015) fusion_type,tr8,ansr
  
  !  TD   -- TD fusion:  T beam, D target 
  tr8=75.0_fp
  fusion_type=' TD '
  call fusn_coldtarget_TD(tr8,ansr,1)
  
  write(6,1015) fusion_type,tr8,ansr
  tr8=50.0_fp
 !  D3   -- D-He3 fusion:  D beam, He3 target
  fusion_type='DHe3'
  call fusn_coldtarget_D3(tr8,ansr,1)
   
  write(6,1015) fusion_type,tr8,ansr
  tr8=75.0_fp
 
  !  3D   -- He3-D fusion:  He3 beam, D target
  fusion_type='He3D'
  call fusn_coldtarget_3D(tr8,ansr,1)
  
  write(6,1015) fusion_type,tr8,ansr
  tr8=50.0_fp
  !  T3   -- T-He3 fusion:  D beam, T target
  fusion_type='THe3'
  call fusn_coldtarget_T3(tr8,ansr,1)
  
  write(6,1015) fusion_type,tr8,ansr
  
  !  3T   -- He3-T fusion:  T beam, T target
  fusion_type='He3T'
  call fusn_coldtarget_3T(tr8,ansr,1)
  
  write(6,1015) fusion_type,tr8,ansr
  
  !  DDp  -- DD fusion --> p,T
  fusion_type=' DDp'
  call fusn_coldtarget_DDp(tr8,ansr,1)
  
  write(6,1015) fusion_type,tr8,ansr
  
  !  DDn  -- DD fusion --> n,He3
  fusion_type=' DDn'
  call fusn_coldtarget_DDn(tr8,ansr,1)
  
  write(6,1015) fusion_type,tr8,ansr
  
  !  TT   -- TT fusion --> 2n,He4
  fusion_type=' TT '
  call fusn_coldtarget_TT(tr8,ansr,1)
  
  write(6,1015) fusion_type,tr8,ansr

  !  TT   -- TT fusion --> 2n,He4 DPC fit, 06/2018
  fusion_type='dpcTT '
  call fusn_coldtarget_dpcTT(tr8,ansr,1)
  
  write(6,1015) fusion_type,tr8,ansr
  
1015 format(/ &
          ' ** sigma*v[m**3/sec]',1x,a,1x,'cold target  fusion, beam energy = ',f10.2,' KeV:'/ &
          ' -->real(fp) result = ',1pe20.13)
  !-------------------
  write(6,*) ' '
  write(6,*) ' '
  write(6,*) ' '
  write(6,*) 'THERMONUCLEAR FUSION REACTION'
  !-------------------
  ! test:  thermonuclear fusion
  !    --thermonuclear rate coefficients (vs. Temperature) 


  !  DT   -- DT fusion:  D beam, T target 
  fusion_type=' DT '
  call fusn_thermo_DT(tr8,ansr,1)
  
  write(6,1005) fusion_type,tr8,ansr
  
  !  TD   -- TD fusion:  T beam, D target 
  fusion_type=' TD '
  call fusn_thermo_TD(tr8,ansr,1)
  
  write(6,1005) fusion_type,tr8,ansr
  
  !  DDp  -- DD fusion --> p,T
  fusion_type=' DDp'
  call fusn_thermo_DDp(tr8,ansr,1)
  
  write(6,1005) fusion_type,tr8,ansr
  
  !  DDn  -- DD fusion --> n,He3
  fusion_type=' DDn'
  call fusn_thermo_DDn(tr8,ansr,1)
  
  write(6,1005) fusion_type,tr8,ansr
  
  !  TT   -- TT fusion --> 2n,He4
  fusion_type=' TT '
  call fusn_thermo_TT(tr8,ansr,1)
  
  write(6,1005) fusion_type,tr8,ansr

   !  TT   -- TT fusion --> 2n,He4 DPC fit 06/2018
  fusion_type=' dpcTT '
  call fusn_thermo_dpcTT(tr8,ansr,1)
  
  write(6,1005) fusion_type,tr8,ansr
  
 
  !  D3   -- D-He3 fusion:  D beam, He3 target
  fusion_type='DHe3'
  call fusn_thermo_D3(tr8,ansr,1)
  
  write(6,1005) fusion_type,tr8,ansr
  
  !  3D   -- He3-D fusion:  He3 beam, D target
  fusion_type='He3D'
  call fusn_thermo_3D(tr8,ansr,1)
  
  write(6,1005) fusion_type,tr8,ansr
  !  T3   -- T-He3 fusion:  D beam, T target
  fusion_type='THe3'
  call fusn_thermo_T3(tr8,ansr,1)
  
  write(6,1005) fusion_type,tr8,ansr
  
  !  3T   -- He3-T fusion:  T beam, T target
  fusion_type='He3T'
  call fusn_thermo_3T(tr8,ansr,1)
  
  write(6,1005) fusion_type,tr8,ansr
  
1005 format(/ &
          ' ** <<sigma*v>> [m**3/sec]',1x,a,1x,'thermonuclear fusion, Ti = ',f10.2,' KeV:'/ &
          ' -->real(fp) result = ',1pe20.13)
  
  
  !-------------------
  ! test:  beam-target fusion
  !
  write(6,*) ' '
  write(6,*) ' '
  write(6,*) ' '
  write(6,*) 'BEAM-TARGET FUSION .'
  fusion_type=' DT '
  call fusn_btsigv_DT(enr8,tr8,ansr,1)
  
  write(6,1006) fusion_type,'D',enr8,'T',tr8,ansr
  
  fusion_type=' TD '
  call fusn_btsigv_TD(enr8,tr8,ansr,1)
  
  write(6,1006) fusion_type,'T',enr8,'D',tr8,ansr
  
  
  
  fusion_type=' DDp'
  call fusn_btsigv_DDp(enr8,tr8,ansr,1)
  
  write(6,1006) fusion_type,'D',enr8,'D',tr8,ansr
  
  
  fusion_type=' DDn'
  call fusn_btsigv_DDn(enr8,tr8,ansr,1)
  
  write(6,1006)  fusion_type,'D',enr8,'D',tr8,ansr
  
  fusion_type=' TT '
  
  call fusn_btsigv_TT(enr8,tr8,ansr,1)
  
  write(6,1006) fusion_type,'T',enr8,'T',tr8,ansr

  fusion_type='dpcTT ' !DPC fit, 06.2018
  
  call fusn_btsigv_dpcTT(enr8,tr8,ansr,1)
  
  write(6,1006) fusion_type,'T',enr8,'T',tr8,ansr
  
  fusion_type='DHe3'
  call fusn_btsigv_D3(enr8,tr8,ansr,1)
  
  write(6,1006) fusion_type,'D',enr8,'He3',tr8,ansr
 
  fusion_type='He3D'
  call fusn_btsigv_3D(enr8,tr8,ansr,1)
   
  write(6,1006) fusion_type,'He3',enr8,'D',tr8,ansr
  
  fusion_type='THe3'
  call fusn_btsigv_T3(enr8,tr8,ansr,1)
  
  write(6,1006) fusion_type,'T',enr8,'He3',tr8,ansr
  
  fusion_type='He3T'
  call fusn_btsigv_3T(enr8,tr8,ansr,1)
  
  write(6,1006) fusion_type,'He3',enr8,'T',tr8,ansr
 
 1006 format(/ &
          ' ** <sigma*v> ',1x,a,1x,' beam-target fusion **'/ &
          1x,a,1x,' beam energy = ',f10.2,'KeV',1x,a,1x,' target Ti = ',f10.2,' KeV:'/ &
          ' -->real(fp) result = ',1pe20.13)
 
  !-------------------
  ! test:  beam-beam fusion
  !
  write(6,*) ' '
  write(6,*) ' '
  write(6,*) ' '
  write(6,*) ' BEAM-BEAM FUSION '

  tr8=0.50_fp          !fractional beam energy variation in the target frame
  
  fusion_type=' DT '
  call fusn_bbsigv_DT(enr8,tr8,ansr,1)
  
  write(6,1007) fusion_type,'D',enr8,'T',tr8,ansr
  
!  fusion_type=' TD '
!  call fusn_bbsigv_TD(enr8,tr8,ansr,1)
!  write(6,1007) fusion_type,'T',enr8,'D',tr8,ansr
  

  fusion_type=' DDp'
  call fusn_bbsigv_DDp(enr8,tr8,ansr,1)
  
  write(6,1007) fusion_type,'D',enr8,'D',tr8,ansr
  
  
  fusion_type=' DDn'
  call fusn_bbsigv_DDn(enr8,tr8,ansr,1)

  write(6,1007)  fusion_type,'D',enr8,'D',tr8,ansr
  
  fusion_type=' TT '
  
  call fusn_bbsigv_TT(enr8,tr8,ansr,1)
  
  write(6,1007) fusion_type,'T',enr8,'T',tr8,ansr
  
  fusion_type='dpcTT ' !DPC fit, 06/2018
  
  call fusn_bbsigv_dpcTT(enr8,tr8,ansr,1)
  
  write(6,1007) fusion_type,'T',enr8,'T',tr8,ansr
  
  fusion_type='DHe3'
  call fusn_bbsigv_D3(enr8,tr8,ansr,1)
  
  write(6,1007) fusion_type,'D',enr8,'He3',tr8,ansr
  
!  fusion_type='He3D'
!  call fusn_bbsigv_3D(enr8,tr8,ansr,1)
  
!  write(6,1007) fusion_type,'He3',enr8,'D',tr8,ansr
  
  fusion_type='THe3'
  call fusn_bbsigv_T3(enr8,tr8,ansr,1)
  
  write(6,1007) fusion_type,'T',enr8,'He3',tr8,ansr
  
!  fusion_type='He3T'
!  call fusn_bbsigv_3T(enr8,tr8,ansr,1)
  
!  write(6,1007) fusion_type,'He3',enr8,'T',tr8,ansr
  
1007 format(/ &
          ' ** <<sigma*v>>',1x,a,1x,'beam-beam fusion **'/ &
          1x,a,1x,'beam energy = ',f10.2,'KeV',1x,a,1x,', variation fraction = ',f10.2,':'/ &
          ' -->real(fp) result = ',1pe20.13)
  write(6,*) ' '
  write(6,*) ' '
  write(6,*) ' '
  write(6,*) 'IMPURITY REACTION '
  
  ! ------------------
  ! test: impurity radiation rate
  !
  tr8(1)  = .1_fp        ! Te in keV
  var8(1) = 1.e19_fp     ! Ne in m-3
!  call imptable_def_brem(0) default
! -- ionization --
  do jZimp = jZimp_lbound, jZimp_ubound   !allowed range forZ impurity
     impurity: if( jZimp /= 58 .and. jZimp /= 59 .and.  jZimp /= 60) then 


        allocate( rioniz8(jZimp+1,1))
        allocate( rrecom8(jZimp+1,1))
        allocate( rcoron8(jZimp+1,1))
        allocate( rrad8(jZimp+1,1))
        call imptable_ioniz_r8(jZimp, 1, tr8, var8, jZimp+1, rioniz8)
        
        write(6,1101) ' ** <sigma*v*ne> Impurity ionization rate ' // &
             trim(name_pseudo_periodic_table(0,jZimp,0.)) // ' **',  &
             jZimp, tr8(1), var8(1)
        
        do i = 1, jZimp+1
           write(6,1102) (i-1), rioniz8(i,1)
        end do
        

! -- recombination --
        call imptable_recom_r8(jZimp, 1, tr8, var8, jZimp+1, rrecom8)
        
        write(6,1101) ' ** <sigma*v*ne> Impurity recombination rate ' // &
             trim(name_pseudo_periodic_table(0,jZimp,0.)) // ' **',  &
             jZimp, tr8(1), var8(1)
        
        do i = 1, jZimp+1
           write(6,1102) (i-1), rrecom8(i,1)
        end do
! -- bremsstrahlung --
        call imptable_brem_r8(jZimp, 1, tr8, var8, jZimp+1, rrad8)
        
        write(6,1101) ' ** <sigma*v*ne> Impurity bremsstrahlung ' // &
             trim(name_pseudo_periodic_table(0,jZimp,0.)) // ' **',  &
             jZimp, tr8(1), var8(1)
        
        do i = 1, jZimp+1
           write(6,1102) (i-1), rrad8(i,1)
        end do
        rrad8=zero
! -- radiation (no bremsstrahlung) --
        call imptable_rad_r8(jZimp, 1, tr8, var8, jZimp+1, rrad8)
        
        write(6,1101) ' ** <sigma*v*ne> Impurity radiation rate (no bremsstrahlung) ' // &
             trim(name_pseudo_periodic_table(0,jZimp,0.)) // ' **',  &
             jZimp, tr8(1), var8(1)
        
        do i = 1, jZimp+1
           write(6,1102) (i-1), rrad8(i,1)
        end do
        
        
! -- coronal equilibrium --
        call impreaction_coronal_r8(jZimp, 1, rioniz8, rrecom8, jZimp+1, rcoron8)
       
        write(6,1101) ' ** <sigma*v*ne> Impurity coronal equilibrium ' // &
             trim(name_pseudo_periodic_table(0,jZimp,0.)) // ' **',  &
             jZimp, tr8(1), var8(1)
        
        do i = 1, jZimp+1
           write(6,1102) (i-1), rcoron8(i,1)
        end do
! -- coronal equilibrium radiaiton --
        call impreaction_coronal_rad_r8(jZimp, 1, rcoron8, rrad8, jZimp+1, enr8)
        aa=zero
        write(6,1101) ' ** <sigma*v*ne> Impurity coronal equilibrium radiation (no bremsstrahlung) ' // &
             trim(name_pseudo_periodic_table(0,jZimp,aa)) // ' **',  &
             jZimp, tr8(1), var8(1)
        
        write(6,1103) enr8(1)
        
        write(6,'(//)') 

        deallocate( rioniz8 )
        deallocate( rrecom8 )
        deallocate( rcoron8 )
        deallocate( rrad8 )
        
!        call imptable_print(jZimp)
     else 
        write(6,'(//)') 
        write(6,*)' -->fpreact_test:  abnormal exit:  Z impurity out of range or .eq. forbidden numbers :58, 59, 60'
        
     endif impurity
  enddo
  
1101 format(/,A,/ &
          ' Z(impurity) = ',i2,'  Te = ',f10.2,' KeV',&
          '  Ne = ',es10.3, ' m-3')
  
1102 format(' charge = ',i2,' -->real(fp) result = ',1pe20.13,/12x)
1103 format(' -->real(fp) result = ',1pe20.13)

  aa=12.0107_fp
  tmp_r8=to_periodic_table(6,aa,-1,1)
  write(*,*) 'to periodic r8 ',tmp_r8
  call inv_periodic_table('C',    .true.,  iz, aa, ic)
  write(*,*) 'r8 ',iz, aa, ic
  tmp_r8= name_periodic_table (iz,aa)
  write(*,*) 'name r8 ',tmp_r8
  aa=one
  tmp_r8=to_pseudo_periodic_table(1,1,aa,-1,1)
 write(*,*) 'to pseudo periodic r8 ',tmp_r8
  
  call inv_pseudo_periodic_table(1,'H',    .true.,  iz, aa, ic)
  write(*,*) 'pseudo r8 ',iz, aa, ic
  call standard_amu(6,aa)
  write(*,*) 'r8 A=',aa
  iz=11.8
  write(*,*)'iz= ',iz
  iz=11.8+0.01_fp
  write(*,*)'iz= ',iz
  iz=11.8+0.5_fp
  write(*,*)'iz= ',iz
  iz=11.1
  write(*,*)'iz= ',iz
  iz=11.1+0.01_fp
  write(*,*)'iz= ',iz
  iz=11.1+0.5_fp
  write(*,*)'iz= ',iz
  call tr_species_convert(6,5,12,aa1,aa,aa2,ic)
  aa2=aa2/mp_Kg
  aa1=aa1/qe_eV
  aa=aa/qe_eV

  write(*,*)aa1,aa,aa2,ic
  call tr_species_convert(3,3,6,aa1,aa,aa2,ic)
  aa2=aa2/mp_Kg
  aa1=aa1/qe_eV
  aa=aa/qe_eV

  write(*,*)aa1,aa,aa2,ic
  
  
  
end program fpreact_test
