module hatom_mod
  !
    SAVE
  !
  !  private module for nubeam (TRANSP MC fast ion code)
  !  modernization/modurization effort -- dmc June 2001
  !
  !  enable use of `preact' NTCC software -- reusable atomic physics
  !  data access package
  !
  !  this contains items for handling H, He, and H/He
  !  neutralizing charge exchange and impact ionization reactions
  !  **and** H/He isotope fusion reactions
  !  **and** impurity stopping rate coeffs for H, He neutral atoms
  !  **and** electron,H recombination and electron impaction ionization
  !          rate coeefficients as functions of Te
  !
  !  *****WARNING*****
  !  some Lithium data also available, but this is not complete.
  !
 
  integer :: hatom_flag = 0    ! flag that module has been initialized...
 
  !  "policy options" for range errors on table lookups.
  !  for each initialization a "policy" must be set for two
  !  conditions:  out-of-range low, and out-of-range high
  !  -- can also modify independently for each dimension of each table...
 
  integer, parameter :: r_ignore=0,r_warn=1,r_halt=2
  integer, parameter :: r_ignore_clear=3,r_warn_clear=4
 
  !
  ! These policies have effect when an energy or temperature argument
  ! is given beyond the range of the table data:
  !
  !  r_ignore means:  ignore range error; use nearest table value
  !  r_warn means:  use nearest table value, but issue a warning message
  !  r_halt means:  issue a warning message and exit
  !  r_ignore_clear means:  set result to zero *silently*
  !  r_warn_clear means:  set result to zero with warning message
  !
  !  actual policies:
  !    default:  ignore if out-of-range low
  !              halt with message if out-of-range high
  !
  !-------------------
  !    for cx reactions energy beam-target tables, (E) dimension only:
  !              ignore if out-of-range low
  !              silently clear to zero if out-of-range high
  !    for T dimension use defaults.
  !
  !      cx table ranges:  E=1e-3 keV/amu -- 1e3 keV/amu
  !                        T=1e-3 kev/amu -- 2e2 keV/amu
  !
  !      ii table ranges:  E=1e-2 keV/amu -- 10e3 keV/amu
  !                        T=1e-3 kev/amu -- 2e2 keV/amu
  !
  !           (so code will halt with message if Ti/A > 200KeV)
  !
  !-------------------
  !    for fusion reactions:
  !
  !      thermonuclear table:  silently clear to zero if T < Tmin,
  !                            halt with error if T > Tmax
  !                               temperature range:  0.1keV -> 200keV
  !
  !      beam-target table:    silently clear to zero if E < Emin
  !                            ignore if T < Tmin
  !                            halt with error if T > Tmax or E > Emax
  !                               temperature range:  0.2keV -> 200keV
  !                               energy range 1keV -> 10000keV
  !
  !      gyro-avg table:       silently clear to zero if E < Emin
  !                            halt with error if var. fraction not in [0,1].
  !
  !-------------------
  !    impurity stopping cross section vs. relative (Erel/A):
  !      range 0.001 KeV/AMU to 10e3 keV/AMU
  !      (use e.g. E0/A0 + 1.5*Ti/Ai for Erel/A, keV/AMU)
  !
  !      ignore if Erel/A < Emin, halt with error if Erel/A > Emax
  !
  !-------------------
  !    <sigma*v>(Te) reactions (recombination; electron impact ionization)
  !      range Te = 0.001 KeV to 200 KeV
  !
  !      issue warning if out of range low;
  !      halt with error message if out of range high.
  !
  !
  !
  !
  !  charge exchange "handles"...
 
  integer :: Lcx_H0_H           ! Hydrogen-Hydrogen
  integer :: Lcx_HE0_HE         ! Helium-Helium double cx
  integer :: Lcx_HE0_H          ! Helium neutral on H+
 
  !  we have some real Li data...
 
  integer :: Lcx_LI0_LI         ! Lithium-Lithium "triple" cx  (set to ~zero)
  integer :: Lcx_LI0_HE         ! Lithium-neutral & He++ double cx
  integer :: Lcx_LI0_H          ! Lithium-neutral & H+
 
  !  impact ionization "handles"...
 
  integer :: Lii_H0_H           ! Hydrogen-Hydrogen
  integer :: Lii_H0_HE          ! Hydrogen neutral on He++ (H0,HE++ ii)
  integer :: Lii_H0_LI          ! Hydrogen neutral on Li+++
                                !   for this using 1.5*(H0,HE++ ii)
 
  integer :: Lii_HE0_H          ! Helium neutral on H+
  integer :: Lii_HE0_HE         ! Helium0-Helium++ impact ioniz. (He0,HE++ ii)
  integer :: Lii_HE0_LI         ! Helium neutral on Li+++
                                !   for this using 1.5*(He0,HE++ ii)
 
  integer :: Lii_LI0_H          ! Lithium neutral on H+
  integer :: Lii_LI0_HE         ! Lithium neutral on He++
  integer :: Lii_LI0_LI         ! Lithium neutral on Li+++
                                !   for this using 1.5*(He0,HE++ ii) (??)
 
  !  impurity stopping rate coefficient tables sigma*v(Erel/A)
 
  integer :: Lst_H0_C6          ! H0 stopped by C+6
  integer :: Lst_HE0_C6         ! HE0 stopped by C+6
  integer :: Lst_LI0_C6         ! LI0 stopped by C+6 (using H0 data)
 
  integer :: Lst_H0_O8          ! H0 stopped by C+8
  integer :: Lst_HE0_O8         ! HE0 stopped by C+8
  integer :: Lst_LI0_O8         ! LI0 stopped by C+8 (using H0 data)
 
  !  electron <sigma*v> reactions
 
  integer :: Lreco_H_e          ! H+,e recombination
 
  integer :: Lei_H0             ! H0 electron impact ionization
  integer :: Lei_HE0            ! He0 electron impact ionization
  integer :: Lei_LI0            ! Li0 electron impact ionization (use H0 data)
 
  !  handles for fusion reactions...
  !  not strictly atomic physics but the numerical methods are the
  !  same so we do it here anyway...
 
  !  note DT & TD -- D beam T target; T beam D target, respectively.
 
  integer :: Lfs_DDn            ! DD neutron branch
  integer :: Lfs_DDp            ! DD proton branch
  integer :: Lfs_DT             ! D-->T
  integer :: Lfs_TD             ! T-->D
  integer :: Lfs_TT             ! TT fusion
  integer :: Lfs_dpcTT        ! TT fusion,DPC data 06/2018
  integer :: Lfs_D3             ! D-->He3
  integer :: Lfs_3D             ! He3-->D
  integer :: Lfs_T3             ! T-->He3
  integer :: Lfs_3T             ! He3-->T
 
contains
 
  subroutine hatom_init
    !
    !  initialize hatom_mod
    !
 
    implicit NONE
 
    real*8 zdum
 
    integer cx_init,ii_init,fs_init,sv_init,ei_init,icode_preact
    external cx_init,ii_init,fs_init,sv_init,ei_init,icode_preact
 
    hatom_flag=1
 
    !-------------------
    ! charge exchange (neutral atom in, neutral atom out)
    Lcx_HE0_H = cx_init(icode_preact('H+->He0x'),r_ignore,r_halt)
    Lcx_H0_H = cx_init(icode_preact('H->H(cx)'),r_ignore,r_halt)
    Lcx_HE0_HE = cx_init(icode_preact('He++>Hex'),r_ignore,r_halt)
    Lcx_LI0_H = cx_init(icode_preact('H+->Li0x'),r_ignore,r_halt)
    Lcx_LI0_HE = cx_init(icode_preact('He++>Lix'),r_ignore,r_halt)
    Lcx_LI0_LI = cx_init(icode_preact('Li+++>Lx'),r_ignore,r_halt)
    call cx_coldtarget_epolicy(Lcx_H0_H,r_ignore,r_ignore_clear)
    call cx_coldtarget_epolicy(Lcx_HE0_HE,r_ignore,r_ignore_clear)
    call cx_coldtarget_epolicy(Lcx_HE0_H,r_ignore,r_ignore_clear)
 
    call cx_coldtarget_epolicy(Lcx_LI0_H,r_ignore,r_ignore_clear)
    call cx_coldtarget_epolicy(Lcx_LI0_HE,r_ignore,r_ignore_clear)
    call cx_coldtarget_epolicy(Lcx_LI0_LI,r_ignore,r_ignore_clear)
 
    call cx_warmtarget_epolicy(Lcx_H0_H,r_ignore,r_ignore_clear)
    call cx_warmtarget_epolicy(Lcx_HE0_HE,r_ignore,r_ignore_clear)
    call cx_warmtarget_epolicy(Lcx_HE0_H,r_ignore,r_ignore_clear)
 
    call cx_warmtarget_epolicy(Lcx_LI0_LI,r_ignore,r_ignore_clear)
    call cx_warmtarget_epolicy(Lcx_LI0_HE,r_ignore,r_ignore_clear)
    call cx_warmtarget_epolicy(Lcx_LI0_H,r_ignore,r_ignore_clear)
 
    call cx_energyavg_peramu_epolicy(Lcx_H0_H,r_ignore,r_ignore_clear)
    call cx_energyavg_peramu_epolicy(Lcx_HE0_HE,r_ignore,r_ignore_clear)
    call cx_energyavg_peramu_epolicy(Lcx_HE0_H,r_ignore,r_ignore_clear)
 
    call cx_energyavg_peramu_epolicy(Lcx_LI0_LI,r_ignore,r_ignore_clear)
    call cx_energyavg_peramu_epolicy(Lcx_LI0_HE,r_ignore,r_ignore_clear)
    call cx_energyavg_peramu_epolicy(Lcx_LI0_H,r_ignore,r_ignore_clear)
 
    call cx_average_vdotnorm_epolicy(Lcx_H0_H,r_ignore,r_ignore_clear)
    call cx_average_vdotnorm_epolicy(Lcx_HE0_HE,r_ignore,r_ignore_clear)
    call cx_average_vdotnorm_epolicy(Lcx_HE0_H,r_ignore,r_ignore_clear)
 
    call cx_average_vdotnorm_epolicy(Lcx_LI0_LI,r_ignore,r_ignore_clear)
    call cx_average_vdotnorm_epolicy(Lcx_LI0_HE,r_ignore,r_ignore_clear)
    call cx_average_vdotnorm_epolicy(Lcx_LI0_H,r_ignore,r_ignore_clear)
 
    !-------------------
    ! impact ionization (H/He/Li)
 
    Lii_H0_H = ii_init(icode_preact('H->H(ii)'),r_ignore,r_halt)
    Lii_H0_HE = ii_init(icode_preact('He++>H0i'),r_ignore,r_halt)
    Lii_H0_LI= ii_init(icode_preact('Li+++->H'),r_ignore,r_halt)
 
    Lii_HE0_H = ii_init(icode_preact('H+->He0i'),r_ignore,r_halt)
    Lii_HE0_HE = ii_init(icode_preact('He++>Hei'),r_ignore,r_halt)
    Lii_HE0_LI = ii_init(icode_preact('Li+++>He'),r_ignore,r_halt)
 
    Lii_LI0_H = ii_init(icode_preact('H+->Li0i'),r_ignore,r_halt)
    Lii_LI0_HE = ii_init(icode_preact('He++>Lii'),r_ignore,r_halt)
    Lii_LI0_LI = ii_init(icode_preact('Li+++>Li'),r_ignore,r_halt)
 
    !-------------------
    ! impurity stopping
 
    Lst_H0_C6 = sv_init(icode_preact('C+6->H'),r_ignore,r_halt)
    Lst_He0_C6 = sv_init(icode_preact('C+6->He'),r_ignore,r_halt)
    Lst_Li0_C6 = sv_init(icode_preact('C+6->Li'),r_ignore,r_halt)
 
    Lst_H0_O8 = sv_init(icode_preact('O+8->H'),r_ignore,r_halt)
    Lst_He0_O8 = sv_init(icode_preact('O+8->He'),r_ignore,r_halt)
    Lst_Li0_O8 = sv_init(icode_preact('O+8->Li'),r_ignore,r_halt)
 
    !-------------------
    ! <sigma*v>(Te)
 
    Lreco_H_e = ei_init(icode_preact('recombine'),r_warn,r_halt)
 
    Lei_H0 = ei_init(icode_preact('i:e->H0'),r_warn,r_halt)
    Lei_He0 = ei_init(icode_preact('i:e->He0'),r_warn,r_halt)
    Lei_Li0 = ei_init(icode_preact('i:e->Li0'),r_warn,r_halt)
 
    !-------------------
    ! fusion
 
    Lfs_DDn = fs_init(icode_preact('D->D(n)'),r_ignore,r_halt)
    Lfs_DDp = fs_init(icode_preact('D->D(p)'),r_ignore,r_halt)
 
    Lfs_DT = fs_init(icode_preact('D->T'),r_ignore,r_halt)
    Lfs_TD = fs_init(icode_preact('T->D'),r_ignore,r_halt)
    Lfs_TT = fs_init(icode_preact('T->T'),r_ignore,r_halt)
    Lfs_dpcTT = fs_init(icode_preact('dpcT->T'),r_ignore,r_halt)
 
    Lfs_D3 = fs_init(icode_preact('D->He3'),r_ignore,r_halt)
    Lfs_3D = fs_init(icode_preact('He3->D'),r_ignore,r_halt)
    Lfs_T3 = fs_init(icode_preact('T->He3'),r_ignore,r_halt)
    Lfs_3T = fs_init(icode_preact('He3->T'),r_ignore,r_halt)
 
    ! cold-target tables:  <sigma*v>=0 if E<Emin
 
    call fs_coldtarget_epolicy(Lfs_DDn,r_ignore_clear,r_halt)
    call fs_coldtarget_epolicy(Lfs_DDp,r_ignore_clear,r_halt)
 
    call fs_coldtarget_epolicy(Lfs_DT,r_ignore_clear,r_halt)
    call fs_coldtarget_epolicy(Lfs_TD,r_ignore_clear,r_halt)
    call fs_coldtarget_epolicy(Lfs_TT,r_ignore_clear,r_halt)
    call fs_coldtarget_epolicy(Lfs_dpcTT,r_ignore_clear,r_halt)
 
    call fs_coldtarget_epolicy(Lfs_D3,r_ignore_clear,r_halt)
    call fs_coldtarget_epolicy(Lfs_3D,r_ignore_clear,r_halt)
    call fs_coldtarget_epolicy(Lfs_T3,r_ignore_clear,r_halt)
    call fs_coldtarget_epolicy(Lfs_3T,r_ignore_clear,r_halt)
 
    ! thermonuclear tables:  <sigma*v>=0 if T<Tmin
 
    call fs_thermonuclear_tpolicy(Lfs_DDn,r_ignore_clear,r_halt)
    call fs_thermonuclear_tpolicy(Lfs_DDp,r_ignore_clear,r_halt)
 
    call fs_thermonuclear_tpolicy(Lfs_DT,r_ignore_clear,r_halt)
    call fs_thermonuclear_tpolicy(Lfs_TD,r_ignore_clear,r_halt)
    call fs_thermonuclear_tpolicy(Lfs_TT,r_ignore_clear,r_halt)
    call fs_thermonuclear_tpolicy(Lfs_dpcTT,r_ignore_clear,r_halt)
 
    call fs_thermonuclear_tpolicy(Lfs_D3,r_ignore_clear,r_halt)
    call fs_thermonuclear_tpolicy(Lfs_3D,r_ignore_clear,r_halt)
    call fs_thermonuclear_tpolicy(Lfs_T3,r_ignore_clear,r_halt)
    call fs_thermonuclear_tpolicy(Lfs_3T,r_ignore_clear,r_halt)
 
    ! beam-target tables:  <sigma*v>=0 if E<Emin
 
    call fs_warmtarget_epolicy(Lfs_DDn,r_ignore_clear,r_halt)
    call fs_warmtarget_epolicy(Lfs_DDp,r_ignore_clear,r_halt)
 
    call fs_warmtarget_epolicy(Lfs_DT,r_ignore_clear,r_halt)
    call fs_warmtarget_epolicy(Lfs_TD,r_ignore_clear,r_halt)
    call fs_warmtarget_epolicy(Lfs_TT,r_ignore_clear,r_halt)
    call fs_warmtarget_epolicy(Lfs_dpcTT,r_ignore_clear,r_halt)
 
    call fs_warmtarget_epolicy(Lfs_D3,r_ignore_clear,r_halt)
    call fs_warmtarget_epolicy(Lfs_3D,r_ignore_clear,r_halt)
    call fs_warmtarget_epolicy(Lfs_T3,r_ignore_clear,r_halt)
    call fs_warmtarget_epolicy(Lfs_3T,r_ignore_clear,r_halt)
 
    ! gyro-Avg tables:  <sigma*v>=0 if E<Emin
 
    call fs_gyroAvg_epolicy(Lfs_DDn,r_ignore_clear,r_halt)
    call fs_gyroAvg_epolicy(Lfs_DDp,r_ignore_clear,r_halt)
 
    call fs_gyroAvg_epolicy(Lfs_DT,r_ignore_clear,r_halt)
    call fs_gyroAvg_epolicy(Lfs_TD,r_ignore_clear,r_halt)
    call fs_gyroAvg_epolicy(Lfs_TT,r_ignore_clear,r_halt)
    call fs_gyroAvg_epolicy(Lfs_dpcTT,r_ignore_clear,r_halt)

    call fs_gyroAvg_epolicy(Lfs_D3,r_ignore_clear,r_halt)
    call fs_gyroAvg_epolicy(Lfs_3D,r_ignore_clear,r_halt)
    call fs_gyroAvg_epolicy(Lfs_T3,r_ignore_clear,r_halt)
    call fs_gyroAvg_epolicy(Lfs_3T,r_ignore_clear,r_halt)
 
    !  require E-variation fraction to be in range [0,1]
 
    call fs_gyroAvg_varpolicy(Lfs_DDn,r_halt,r_halt)
    call fs_gyroAvg_varpolicy(Lfs_DDp,r_halt,r_halt)
 
    call fs_gyroAvg_varpolicy(Lfs_DT,r_halt,r_halt)
    call fs_gyroAvg_varpolicy(Lfs_TD,r_halt,r_halt)
    call fs_gyroAvg_varpolicy(Lfs_TT,r_halt,r_halt)
    call fs_gyroAvg_varpolicy(Lfs_dpcTT,r_halt,r_halt)
 
    call fs_gyroAvg_varpolicy(Lfs_D3,r_halt,r_halt)
    call fs_gyroAvg_varpolicy(Lfs_3D,r_halt,r_halt)
    call fs_gyroAvg_varpolicy(Lfs_T3,r_halt,r_halt)
    call fs_gyroAvg_varpolicy(Lfs_3T,r_halt,r_halt)
 
  end subroutine hatom_init
end module hatom_mod
