
! Copyright (C) 2002 - Observatoire de Paris/Meudon
!                      Universite Paris 7
!                      CNRS (France)
!                      Contact : Jacques.Lebourlot@obspm.fr
!
! This program is free software; you can redistribute it and/or
! modify it under the terms of the GNU General Public License version 2
! as published by the Free Software Foundation.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program; if not, write to the Free Software
! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

! JLB - 24 May 2008

MODULE PREP_AUTRE

  PRIVATE

  PUBLIC :: AUTRE, XKFILL

CONTAINS

!%%%%%%%%%%%%%%%
SUBROUTINE AUTRE
!%%%%%%%%%%%%%%%

   USE PXDR_FLAGS
   USE PXDR_CONSTANTES
   USE PXDR_CHEM_DATA
   USE PXDR_PROFIL
   USE PXDR_AUXILIAR
   USE PXDR_RF_TOOLS
   USE PREP_VAR

   IMPLICIT NONE

   CHARACTER (LEN=lenSpeci)  :: yspec
   INTEGER                   :: voie_disso
   INTEGER                   :: mm, jj, j, k
   INTEGER                   :: ii2, ii3
   REAL (KIND=dp), DIMENSION (:), ALLOCATABLE :: chg_p, chg_m

!--------+---------+---------+---------+---------+---------+---------+-*-------+

   ii2 = 0
   DO WHILE (ii2 /= -1)
      PRINT *, '  1: Gas Temperature'
      PRINT *, '  2: Dust Temperatures'
      PRINT *, '  3: Proton Density (n(H) + 2 n(H2) + n(H+) + ...)'
      PRINT *, '  4: Total gas density (n(H) + n(H2) + n(He) + ...)'
      PRINT *, '  5: Ionisation degree'
      PRINT *, '  6: Pressure'
      PRINT *, '  7: l (distance in cm)'
      PRINT *, '  8: UV photodestruction from integration of cross sections'
      PRINT *, '  9: formation destruction of H2 and HD'
      PRINT *, ' 10: Dust charge'
      PRINT *, ' 11: Number of ice layers'
      PRINT *, ' 12: Radiation (photon and energy densities from Lyman to Habing)'
      PRINT *, ' 13: Integrated molecular fraction'
      PRINT *, ' 14: Species characteristic times'
      PRINT *, ' -1: end'
      READ *, ii2
      IF (irec == 1) THEN
         WRITE (8,*) ii2
      ENDIF

      IF (ii2 == -1) THEN
         EXIT
      ENDIF

      !--- Gas temperature -----------------------------------------------------
      IF (ii2 == 1) THEN
         iimax = iimax + 1
         y(iimax,0:npo) = tgaz(0:npo)
         texty(iimax) = 'Temp.Gaz      '

      !--- Dust temperature ----------------------------------------------------
      ELSE IF (ii2 == 2) THEN
         DO mm = 1, npg
            iimax = iimax + 1
            y(iimax,0:npo) = tdust(mm,0:npo)
!           texty(iimax) = 'Td.'//TRIM(ADJUSTL(ii2c(mm)))
            write (texty(iimax),'("Td",a2,"-",1pe7.1)') TRIM(ADJUSTL(ii2c(mm))), adust(mm)
         ENDDO

      !--- Proton density ------------------------------------------------------
      ELSE IF (ii2 == 3) THEN
         iimax = iimax + 1
         y(iimax,0:npo) = densh(0:npo)
         texty(iimax) = 'Dens.H        '

      !--- Total density --------------------------------------------------------
      ELSE IF (ii2 == 4) THEN
         iimax = iimax + 1
         y(iimax,0:npo) = totdensity(0:npo)
         texty(iimax) = 'Dens.Tot      '

      !--- Ionization ----------------------------------------------------------
      ELSE IF (ii2 == 5) THEN
         iimax = iimax + 1
         y(iimax,0:npo) = ionidegree(0:npo)
         texty(iimax) = 'Ionisation    '

         ! Check charge conservation
         iimax = iimax + 1
         ALLOCATE (chg_p(0:npo))
         ALLOCATE (chg_m(0:npo))
         chg_p = 0.0_dp
         chg_m = 0.0_dp
         do j = 0, npo
            if (grcharge(j) >= 0.0_dp) then
               chg_p(j) = grcharge(j)
            else
               chg_m(j) = grcharge(j)
            endif
            DO jj = nsp_ne+1, nspec
               if (abnua(jj,j) * ael(jj,natom) >= 0.0_dp) then
                  chg_p(j) = chg_p(j) + abnua(jj,j) * ael(jj,natom)
               else
                  chg_m(j) = chg_m(j) + abnua(jj,j) * ael(jj,natom)
               endif
            ENDDO
         ENDDO
         y(iimax,0:npo) = 50.0_dp * (chg_p + chg_m) / (chg_p - chg_m)
         texty(iimax) = 'Charge-conv-% '
         iimax = iimax + 1
         y(iimax,0:npo) = chg_p + chg_m
         texty(iimax) = 'Charge-tot    '
         DEALLOCATE (chg_p, chg_m)

      !--- Pressure ------------------------------------------------------------
      ELSE IF (ii2 == 6) THEN
         iimax = iimax + 1
         y(iimax,0:npo) = gaspressure(0:npo)
         texty(iimax) = 'Pressure[K.cm-3]'

      !--- Distance ------------------------------------------------------------
      ELSE IF (ii2 == 7) THEN
         iimax = iimax + 1
         y(iimax,0) = 0.0_dp
         y(iimax,0:npo) = d_cm(0:npo)
         texty(iimax) = 'Position[cm]  '

      !--- UV photodestruction from integration of cross sections --------------
      ELSE IF (ii2 == 8) THEN
2006  CONTINUE
         PRINT *, ' which species ?'
         PRINT *, '-1: fin'
         READ (*,'(a8)') yspec
         IF (irec == 1) THEN
            WRITE (8,'(a8)') yspec
         ENDIF

         IF (yspec == "-1") THEN
            CYCLE
         ELSE
            voie_disso = 0
            DO jj = 1, nphot_i
               IF (ndiesp(jj) == yspec) THEN
                  voie_disso = voie_disso + 1
               ENDIF
            ENDDO
            ! pour ecrire les differentes voies !
            IF (voie_disso == 0) THEN
               PRINT *, '  No cross-section for ', yspec
               GOTO 2006
            ENDIF
            ii3 = 0
            DO jj = 1, nphot_i
               IF (ndiesp(jj) == yspec) THEN
                  ii3 = jj
                  EXIT
               ENDIF
            ENDDO
            PRINT*,'nbre de voies de disso: ', voie_disso
            k = voie_disso
            DO WHILE (k /= 0)
               iimax = iimax + 1
               y(iimax,:) = 0.0_dp
               DO j = 0, npo
                  y(iimax,j) = pdiesp(ii3+(k-1),j)
               ENDDO
               texty(iimax) = 'Pd'//TRIM(ADJUSTL(ii2c(voie_disso+1-k)))//'.'//yspec
               k = k - 1
            ENDDO
            GOTO 2006
         ENDIF

      !--- Formation and destruction of H2 and HD ------------------------------
      ELSE IF (ii2 == 9) THEN

         PRINT *, ' 1: H2, 2: CO, 3: HD'
         READ *, ii3
         IF (irec == 1) THEN
            WRITE (8,*) ii3
         ENDIF

         IF (ii3 == 1) THEN
            iimax = iimax + 1
            y(iimax,0) = 0.0_dp
            y(iimax,0:npo) = timh21(0:npo)
            texty(iimax) = 'FH2chi        '
            iimax = iimax + 1
            y(iimax,0) = 0.0_dp
            y(iimax,0:npo) = timh22(0:npo)
            texty(iimax) = 'DH2chi        '
            iimax = iimax + 1
            y(iimax,0) = 0.0_dp
            y(iimax,0:npo) = timh23(0:npo)
            texty(iimax) = 'FH2-g-LH      '
            iimax = iimax + 1
            y(iimax,0) = 0.0_dp
            y(iimax,0:npo) = timh24(0:npo)
            texty(iimax) = 'DH2phot       '
            iimax = iimax + 1
            y(iimax,0) = 0.0_dp
            y(iimax,0:npo) = timh25(0:npo)
            texty(iimax) = 'FH2-g-ER      '
            iimax = iimax + 1
            y(iimax,0:npo) = (timh23(0:npo) + timh25(0:npo)) &
                           / (vmaxw * SQRT(tgaz(0:npo)) * s_gr_t * densh(0:npo) * abnua(i_h,0:npo) / 8.0_dp)
            texty(iimax) = 'FH2-gr-eff   '                   ! Grain efficiency
         ELSE IF (ii3 == 2) THEN
            PRINT *, " To be upgraded (not done yet)"
         ELSE  IF (ii3 == 3) THEN
            iimax = iimax + 1
            y(iimax,0) = 0.0_dp
            y(iimax,0:npo) = timhd1(0:npo)
            texty(iimax) = 'FHDchi        '
            iimax = iimax + 1
            y(iimax,0) = 0.0_dp
            y(iimax,0:npo) = timhd2(0:npo)
            texty(iimax) = 'DHDchi        '
            iimax = iimax + 1
            y(iimax,0) = 0.0_dp
            y(iimax,0:npo) = timhd3(0:npo)
            texty(iimax) = 'FHDgrain      '
            iimax = iimax + 1
            y(iimax,0) = 0.0_dp
            y(iimax,0:npo) = timhd4(0:npo)
            texty(iimax) = 'DHDphot       '
         ELSE
            PRINT *, 'WARNING: illegal value for ii3:', ii3
            CYCLE
         ENDIF

      !--- Grain charge  -------------------------------------------------------
      ELSE IF (ii2 == 10) THEN
         iimax = iimax + 1
         y(iimax,0:npo) = abnua(nspec,0:npo)
         texty(iimax) = 'n(e-)[cm-3]   '
         iimax = iimax + 1
         y(iimax,0:npo) = grcharge(0:npo)
         texty(iimax) = 'Gr.Char[cm-3] '
         DO mm = 1, npg
            iimax = iimax + 1
            y(iimax,0:npo) = zmoy(mm,0:npo)
            texty(iimax) = 'R.gr.'//TRIM(ADJUSTL(ii2c(mm)))
         ENDDO

      !--- Number of layers ----------------------------------------------------
      ELSE IF (ii2 == 11) THEN
         iimax = iimax + 1
         y(iimax,0:npo) = x_lay(0:npo)               ! Real value
         texty(iimax) = 'Nb_Ice_Layers '

      !--- Radiation field  ----------------------------------------------------
      ELSE IF (ii2 == 12) THEN
         ! 7 I 2013 - JLB - Stop integration at 2400 Angstrom (Habing limit)
         ! BG 04/2013 - Start the integration at 911 Angstrom (Lyman limit)
         iimax = iimax + 1
         y(iimax,0:npo) = fluph(0:npo)
         texty(iimax) = 'Flu.PHOT      '
         iimax = iimax + 1
         y(iimax,0:npo) = int_rad(0:npo)
         texty(iimax) = 'U.[erg.cm-3]  '

      !--- Integrated molecular fraction ---------------------------------------
      ELSE IF (ii2 == 13) THEN
         iimax = iimax + 1
         y(iimax,0) = 2.0_dp * abnua(i_h2,0) / (2.0_dp*abnua(i_h2,0) + abnua(i_h,0))
         IF (i_hp /= 0) THEN
            y(iimax,1:npo) = 2.0_dp * codesp(i_h2,1:npo) / (2.0_dp*codesp(i_h2,1:npo) &
                           + codesp(i_h,1:npo) + codesp(i_hp,1:npo))
         ELSE
            y(iimax,1:npo) = 2.0_dp * codesp(i_h2,1:npo) / (2.0_dp*codesp(i_h2,1:npo) &
                           + codesp(i_h,1:npo))
         ENDIF
         texty(iimax) = ' f.int '

      !--- Species characteristic times ----------------------------------------
      ELSE IF (ii2 == 14) THEN
         CALL CAR_TIME
      ELSE
         PRINT *, 'WARNING: Illegal value for ii2:', ii2
         CYCLE
      ENDIF
   ENDDO

END SUBROUTINE AUTRE

!%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE XKFILL (iopt)
!%%%%%%%%%%%%%%%%%%%%%%%

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES
  USE PXDR_CHEM_DATA
  USE PXDR_PROFIL
  USE PXDR_AUXILIAR
  USE PXDR_STR_DATA
  USE PXDR_RF_TOOLS
  USE PXDR_CHEMISTRY
  USE PREP_VAR

  IMPLICIT NONE

  INTEGER, INTENT (IN)      :: iopt

  INTEGER, DIMENSION(0:nes) :: indy
  REAL (KIND=dp)            :: stick_m, vtherm
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:) :: stickH
  REAL (KIND=dp)            :: stick_ER
  REAL (KIND=dp)            :: rate1, rate2, rate, rate_h, rate_l
  REAL (KIND=dp)            :: sigm, pr
  REAL (KIND=dp)            :: k_Ad, k_i_Ad, k_ij_ER, k_ij_Rej, k_j_ER, k_i_Rej
  REAL (KIND=dp)            :: rat_l, endo_rxn, expon
  REAL (KIND=dp)            :: frach2, avr
  INTEGER                   :: mm, ir3, lev
  INTEGER                   :: i, j, l, ik, kkk, ideb, ifin, jj
  INTEGER                   :: ir1, ir2, ip1, ip2, iprod
  REAL (KIND=dp)            :: nu0, nu0_1, nu0_2, nu0_3
  REAL (KIND=dp)            :: tgr
  REAL (KIND=dp)            :: summ, r_rej, tm1_1, tm1_2
  REAL (KIND=dp)            :: react_eff     ! reaction efficiency for 2 species in a site (no unit)
  REAL (KIND=dp)            :: p_react       ! frequency to try to react (s-1)
  REAL (KIND=dp)            :: p_diff        ! frequency to try to diffuse (s-1)
  REAL (KIND=dp)            :: p_desor       ! frequency to try to desorb (s-1)
  REAL (KIND=dp)            :: tunnel_trans  ! Transmission by tunneling effect through an activation barrier
  REAL (KIND=dp)            :: redmass       ! Reduced mass of the system
  REAL (KIND=dp)            :: xldb_1, xldb_2, xldb_3
  INTEGER                   :: iv1, iv2, ivp
  REAL (KIND=dp)            :: attenu
  REAL (KIND=dp)            :: bbadn
  REAL (KIND=dp)            :: scale_rot ! Scaling factor applied to Herraez-Aguilar C+ + H2 rates to match Zanchet et al. rates
  REAL (KIND=dp)            :: scale_vib ! Scaling factor applied to Herraez-Aguilar C+ + H2 rates to match Zanchet et al. rates
  REAL (KIND=dp), DIMENSION (0:14)   :: xh2v
  ! Data from report_4105.pdf
  REAL (KIND=dp), DIMENSION (0:14)   :: kvh2

  indy = 0

  ! Extinction from the "other" side
  av  = tau(iopt) * tautav
  avr = tau(npo) * tautav - av

  ! Fraction of H2 (for secondary photons flux)
  frach2 = abnua(i_h2,iopt) / (abnua(i_h,iopt) + abnua(i_h2,iopt))

  ! x_lay is computed in subroutine PLECTUR (real value)
  ! For chemistry, the max (1.0,x_lay) is done here
  IF (x_lay(iopt) == 0.0_dp) THEN
     attenu = 1.0_dp
  ELSE
     attenu = 1.0_dp - EXP(-3.0_dp / x_lay(iopt))
  ENDIF

   h2para = 0.0_dp
   h2orth = 0.0_dp
   DO lev = 1, l0h2
      jj = njl_h2(lev)
      IF (MOD(jj,2) == 0) THEN
         h2para = h2para + spec_lin(in_sp(i_h2))%xre(lev,iopt)
      ELSE
         h2orth = h2orth + spec_lin(in_sp(i_h2))%xre(lev,iopt)
      ENDIF
   ENDDO

   ! Take care of variables for grain surface
   !    . Add pseudo-species on each grain size
   !    . Set probability of rejection
   IF (.NOT. ALLOCATED(pr_rej)) THEN
      ALLOCATE (pr_rej(nsp_g1,nsp_g1))
      ! Default is that X is rejected by Y:
      pr_rej = 1.0_dp
      DO i = nsp_n1+1, nsp_n1+nsp_g1
         ! probability of reaction H: and D: of H is 0.5, 0 with H2 and HD
         IF (i == i_hgr) THEN
            DO j = nsp_n1+1, nsp_n1+nsp_g1
               IF (j == i_hgr) THEN
                  pr_rej(i-nsp_n1,j-nsp_n1) = 0.5_dp             ! H + H: -> H2
               ELSE IF (j == i_dgr) THEN
                  pr_rej(i-nsp_n1,j-nsp_n1) = 0.5_dp             ! H + D: -> HD
               ENDIF
            ENDDO
         ELSE IF (i == i_dgr) THEN
            DO j = nsp_n1+1, nsp_n1+nsp_g1
               IF (j == i_hgr) THEN
                  pr_rej(i-nsp_n1,j-nsp_n1) = 0.5_dp             ! D + H: -> HD
               ENDIF
            ENDDO
         ENDIF
      ENDDO
   ENDIF

  ! H2 vibrational abundances
  xh2v = 0.0_dp
  DO lev = 1, l0h2
     iv1 = nvl_h2(lev)
     xh2v(iv1) = xh2v(iv1) + spec_lin(in_sp(i_h2))%xre(lev,iopt)
  ENDDO

! chemical reactions are reordered:
! (0) formation of H2 and HD on grains [Old Style] (nh2for)
! (1) cosmic ray processes (ncrion)
! (2) secondary photon processes (npsion)
! (3) radiative association  (nasrad)
! (4) gas phase reactions (nrest)
! (6) Endothermal reactions with H2 (nh2endo) (NEW!)
! (5) photoreactions avec fit exterieur (nphot_f)
! (7) photoreactions avec integration directe (nphot_i)
! (8) 3 body reactions (n3body)
! (101...) exceptions (ncpart)

! (11) reactions on grain surface (ngsurf)
! (12) photoreactions on grain surface (ngphot)
! (13) adsorption on to grains (ngads)
! (14) neutralization (ngneut)
! (15) explosive desorption from grains (nggdes)
! (16) cosmic ray induced desorption from grains (ncrdes)
! (17) photodesorption from grains (nphdes)
! (18) evaporation from grains (ngevap)
! (19) chemisorption on grains (ngchs)
! (20) Eley-Rideal process (ngelri)
! (40) radiative and dielectronic recombination of atomic ions (nglass)

!-------------------------------------------------------------------------
!  Special cases       : NSPEC + 1 : ELECTRON
!                        NSPEC + 2 : PHOTON
!                        NSPEC + 3 : CRP
!                        NSPEC + 4 : GRAIN
!                        NSPEC + 6 : XRAY
!                        NSPEC + 7 : ELECSEC

!       -------------------
!-- 1 - Gas phase reactions
!       -------------------

!-------------------------------------------------------------------------
! (0) formation of H2 and HD on grains [Old Style] (nh2for)  (cm3 s-1)
!
! This type allows users to force the H2 formation rate.
! Example : to have R = 3E-17 cm+3 s-1 in the whole cloud, use in chemistry :
! OLD   h       h       h2                             3.00d-17  0.00     0.00   0
! and remove all h:, h2:, ... species
! The rate is scaled by SQRT(T/100) and the metallicity (g_ratio/0.01)
!-------------------------------------------------------------------------

  DO i = 1, nh2for
     ir1 = react(i,1)
     ir2 = react(i,2)
     iprod = react(i,4)

     ! The scaling (100.0 or 300.0 K) and the exponent (0.0 or 0.5) are set in the chemistry file
     rate = gamm(i) * densh(iopt) * (tgaz(iopt) / bet(i))**alpha(i) &
          * (g_ratio / 0.01_dp) / (istiny + abnua(i_h,iopt))

     kkk = indy(iprod) + 1
     indy(iprod) = kkk
     xmatk(iprod)%fdt(kkk)%k = rate

     kkk = indy(ir1) + 1
     indy(ir1) = kkk
     xmatk(ir1)%fdt(kkk)%k = - rate

     kkk = indy(ir2) + 1
     indy(ir2) = kkk
     xmatk(ir2)%fdt(kkk)%k = - rate
  ENDDO

!-------------------------------------------------------------------------
! (1) cosmic ray processes (ncrion)   (s-1)
!-------------------------------------------------------------------------
  ideb = nh2for + 1
  ifin = nh2for + ncrion
  DO i = ideb, ifin
     rate = gamm(i) * zeta

     ik = react(i,0)
     DO j = 4, ik+1
        iprod = react(i,j)
        kkk = indy(iprod) + 1
        indy(iprod) = kkk
        xmatk(iprod)%fdt(kkk)%k = rate
     ENDDO

     ir1 = react(i,1)
     kkk = indy(ir1) + 1
     indy(ir1) = kkk
     xmatk(ir1)%fdt(kkk)%k = - rate
  ENDDO

!-------------------------------------------------------------------------
! (2) secondary photon processes (npsion)   (s-1)
!-------------------------------------------------------------------------

  ideb = ifin + 1
  ifin = ifin + npsion
  DO i = ideb, ifin
     rate = gamm(i) * frach2 * zeta * (tgaz(iopt)/300.0_dp)**alpha(i)

     ik = react(i,0)
     DO j = 4, ik+1
        iprod = react(i,j)
        kkk = indy(iprod) + 1
        indy(iprod) = kkk
        xmatk(iprod)%fdt(kkk)%k = rate
     ENDDO

     ir1 = react(i,1)
     kkk = indy(ir1) + 1
     indy(ir1) = kkk
     xmatk(ir1)%fdt(kkk)%k = - rate
  ENDDO

!-------------------------------------------------------------------------
! (3) radiative association  (nasrad)   (cm3 s-1)
!-------------------------------------------------------------------------
  ideb = ifin + 1
  ifin = ifin + nasrad
  DO i = ideb, ifin
     rate = gamm(i) * (tgaz(iopt)/300.0_dp)**alpha(i) * EXP(-bet(i)/tgaz(iopt))

     iprod = react(i,4)
     kkk = indy(iprod) + 1
     indy(iprod) = kkk
     xmatk(iprod)%fdt(kkk)%k = rate

     ir1 = react(i,1)
     kkk = indy(ir1) + 1
     indy(ir1) = kkk
     xmatk(ir1)%fdt(kkk)%k = - rate

     ir2 = react(i,2)
     kkk = indy(ir2) + 1
     indy(ir2) = kkk
     xmatk(ir2)%fdt(kkk)%k = - rate
  ENDDO

!-------------------------------------------------------------------------
! (4) gas phase reactions (nrest)   (cm3 s-1)
!-------------------------------------------------------------------------
  ideb = ifin + 1
  ifin = ifin + nrest
  DO i = ideb, ifin
     IF (bet(i) < 0.0_dp) THEN
        expon = EXP(-bet(i)/MAX(tgaz(iopt),200.0_dp))
     ELSE
        expon = EXP(-bet(i)/tgaz(iopt))
     ENDIF
     rate = gamm(i) * (tgaz(iopt)/300.0_dp)**alpha(i) * expon

     ik = react(i,0)
     DO j = 4, ik+1
        iprod = react(i,j)
        kkk = indy(iprod) + 1
        indy(iprod) = kkk
        xmatk(iprod)%fdt(kkk)%k = rate
     ENDDO

     ir1 = react(i,1)
     kkk = indy(ir1) + 1
     indy(ir1) = kkk
     xmatk(ir1)%fdt(kkk)%k = - rate

     ir2 = react(i,2)
     kkk = indy(ir2) + 1
     indy(ir2) = kkk
     xmatk(ir2)%fdt(kkk)%k = - rate
  ENDDO

!-------------------------------------------------------------------------
! (6) Endothermal reactions with H2 (nh2endo)   (cm3 s-1)
!-------------------------------------------------------------------------
  ideb = ifin + 1
  ifin = ifin + nh2endo
  DO i = ideb, ifin
     rate = 0.0_dp
     IF (itype(i) == 6) THEN
        DO lev = 1, l0h2
           endo_rxn = MAX(bet(i) - spec_lin(in_sp(i_h2))%elk(lev), 0.0_dp)
           rat_l = gamm(i) * (tgaz(iopt)/300.0_dp)**alpha(i) * EXP(-endo_rxn/tgaz(iopt))
           rate = rate + rat_l * spec_lin(in_sp(i_h2))%xre(lev,iopt)
        ENDDO

     !--- C+ + H2 -> CH+ + H ---------------------------------------------------
     ELSE IF (itype(i) == 61) THEN

        !--- Rate by Agundez et al. ApJ (2010)
        !DO lev = 1, 8
        !   endo_rxn = MAX(4827.0e0_dp-spec_lin(in_sp(i_h2))%elk(lev),0.0e0_dp)
        !   rat_l = 1.58e-10_dp * EXP(-endo_rxn/tgaz(iopt))
        !   rate  = rate + rat_l * spec_lin(in_sp(i_h2))%xre(lev,iopt)
        !ENDDO
        !DO lev = 9, l0h2
        !   rate = rate + 1.6e-9_dp * spec_lin(in_sp(i_h2))%xre(lev,iopt)
        !ENDDO

        !--- Fit of rates by Herraez-Aguilar et al., Phys. Chem. Chem. Phys., 2014
        !rate = rate + 10.0**(-(1640.07 * tgaz(iopt)**(-0.94) + 9.83)) * spec_lin(in_sp(i_h2))%xre(1,iopt) ! v=0, J=0
        !rate = rate + 10.0**(-(1682.81 * tgaz(iopt)**(-0.95) + 9.87)) * spec_lin(in_sp(i_h2))%xre(2,iopt) ! v=0, J=1
        !rate = rate + 10.0**(-(1400.00 * tgaz(iopt)**(-0.94) + 9.80)) * spec_lin(in_sp(i_h2))%xre(3,iopt) ! v=0, J=2 - Interpolation
        !rate = rate + 10.0**(-(1219.00 * tgaz(iopt)**(-0.93) + 9.74)) * spec_lin(in_sp(i_h2))%xre(4,iopt) ! v=0, J=3
        !rate = rate + 10.0**(-(1000.00 * tgaz(iopt)**(-0.92) + 9.74)) * spec_lin(in_sp(i_h2))%xre(5,iopt) ! v=0, J=4 - Interpolation
        !rate = rate + 10.0**(-(740.30  * tgaz(iopt)**(-0.92) + 9.74)) * spec_lin(in_sp(i_h2))%xre(6,iopt) ! v=0, J=5
        !rate = rate + 10.0**(-(322.27  * tgaz(iopt)**(-0.86) + 9.72)) * spec_lin(in_sp(i_h2))%xre(7,iopt) ! v=0, J=6 - Interpolation
        !rate = rate + 10.0**(-(21.41   * tgaz(iopt)**(-0.52) + 9.58)) * spec_lin(in_sp(i_h2))%xre(8,iopt) ! v=0, J=7
        !rate = rate + (4.66E-10 * tgaz(iopt)**(-0.29) + 1.25E-10)   * spec_lin(in_sp(i_h2))%xre(9,iopt)   ! v=0, J=8
        !DO lev = 10, l0h2
        !   rate = rate + (8.0E-10 * tgaz(iopt)**(-0.29) + 1.25E-10) * spec_lin(in_sp(i_h2))%xre(lev,iopt) ! other levels
        !ENDDO

        !--- Mix Zanchet et al. (ApJ, 2013) and Herraez-Aguilar et al. (PCCP, 2014)
        ! Octavio Roncero suggested to be more confident in the quantum treatment by Zanchet et al.
        ! rather than the semi-classical treatment of Herraez-Aguilar.
        ! Herraez-Aguilar provides rates for H2 in v=0, J=0, 1, 3, 5, 7 + v=1, J=0, 1, 2, 3, 4
        ! Zanchet provides rates for v=0, J=0; v=1, J=0 and J=1; v=2, J=0
        ! Following Octavio Roncero's suggestions, we scale Herraez-Aguilar rates to match Zanchet rates
        ! We find two scaling laws, one for levels <= v=0, J=7 and on for above levels
        ! Note that the rotationnal level v=0, J=8 has the same shape than v=1 levels and so it is scaled by scale_vib.
        scale_rot = 2.4_dp * (tgaz(iopt) / 1000.0)**(-0.5)
        scale_vib = 1.4_dp * (tgaz(iopt) / 1000.0)**(-0.1)
        ! Compute Herraez-Aguilar rates and scale them to get Zanchet et al. values
        rate = rate + 10.0**(-(1640.07 * tgaz(iopt)**(-0.94) + 9.83)) * scale_rot * spec_lin(in_sp(i_h2))%xre(1,iopt) ! v=0, J=0
        rate = rate + 10.0**(-(1682.81 * tgaz(iopt)**(-0.95) + 9.87)) * scale_rot * spec_lin(in_sp(i_h2))%xre(2,iopt) ! v=0, J=1
        rate = rate + 10.0**(-(1400.00 * tgaz(iopt)**(-0.94) + 9.80)) * scale_rot * spec_lin(in_sp(i_h2))%xre(3,iopt) ! v=0, J=2 - Interpolation
        rate = rate + 10.0**(-(1219.00 * tgaz(iopt)**(-0.93) + 9.74)) * scale_rot * spec_lin(in_sp(i_h2))%xre(4,iopt) ! v=0, J=3
        rate = rate + 10.0**(-(1000.00 * tgaz(iopt)**(-0.92) + 9.74)) * scale_rot * spec_lin(in_sp(i_h2))%xre(5,iopt) ! v=0, J=4 - Interpolation
        rate = rate + 10.0**(-(740.30  * tgaz(iopt)**(-0.92) + 9.74)) * scale_rot * spec_lin(in_sp(i_h2))%xre(6,iopt) ! v=0, J=5
        rate = rate + 10.0**(-(322.27  * tgaz(iopt)**(-0.86) + 9.72)) * scale_rot * spec_lin(in_sp(i_h2))%xre(7,iopt) ! v=0, J=6 - Interpolation
        rate = rate + 10.0**(-(21.41   * tgaz(iopt)**(-0.52) + 9.58)) * scale_rot * spec_lin(in_sp(i_h2))%xre(8,iopt) ! v=0, J=7
        rate = rate + (4.66E-10 * tgaz(iopt)**(-0.29) + 1.25E-10)     * scale_vib * spec_lin(in_sp(i_h2))%xre(9,iopt) ! v=0, J=8
        ! From v=1, J=0 (lev=10) and up to v=2, J=0 (lev=22) excluded use scaled Herraez-Aguilar rates
        DO lev = 10, min(l0h2, 21) ! lev = 10 is v=1, J=0 and lev = 22 is v=2, J=0
           rate = rate + (8.0E-10 * tgaz(iopt)**(-0.29) + 1.25E-10) * scale_vib *  spec_lin(in_sp(i_h2))%xre(lev,iopt) ! other levels
        ENDDO
        ! From v = 2, J=0 (lev = 22) use Zanchet et al. v=2, J=0 rate
        DO lev = min(22,l0h2), l0h2
           rate = rate + (2.0E-9 * tgaz(iopt)**(-0.29) + 1.8E-10) * spec_lin(in_sp(i_h2))%xre(lev,iopt)
        ENDDO

     !--- S+ + H2 -> SH+ + H ---------------------------------------------------
     ELSE IF (itype(i) == 62) THEN ! Test for the formation of SH+ in the same way than CH+
        DO lev = 1, 18
           endo_rxn = MAX(9860.0e0_dp-spec_lin(in_sp(i_h2))%elk(lev),0.0e0_dp)
           rat_l = 1.58e-10_dp * EXP(-endo_rxn/tgaz(iopt))
           rate  = rate + rat_l * spec_lin(in_sp(i_h2))%xre(lev,iopt)
        ENDDO
        DO lev = 19, l0h2
           rate = rate + 1.6e-9_dp * spec_lin(in_sp(i_h2))%xre(lev,iopt)
        ENDDO
     ENDIF

     ik = react(i,0)
     DO j = 4, ik+1
        iprod = react(i,j)
        kkk = indy(iprod) + 1
        indy(iprod) = kkk
        xmatk(iprod)%fdt(kkk)%k = rate
     ENDDO

     ir1 = react(i,1)
     kkk = indy(ir1) + 1
     indy(ir1) = kkk
     xmatk(ir1)%fdt(kkk)%k = - rate

     ir2 = react(i,2)
     kkk = indy(ir2) + 1
     indy(ir2) = kkk
     xmatk(ir2)%fdt(kkk)%k = - rate
  ENDDO

!-------------------------------------------------------------------------
! (5) photoreactions (external fit) (nphot_f)    (s-1)
!-------------------------------------------------------------------------
  ideb = ifin + 1
  ifin = ifin + nphot_f
  DO i = ideb, ifin
     ir1 = react(i,1)
     ! The effective radm (or radp) coefficient is computed in PXDR_TRANSFER.f90
     rate1 = gamm(i) * EXP(-bet(i) * av) * radm
     rate2 = gamm(i) * EXP(-bet(i) * avr) * radp
     rate = rate1 + rate2

     ik = react(i,0)
     DO j = 4, ik+1
        iprod = react(i,j)
        kkk = indy(iprod) + 1
        indy(iprod) = kkk
        xmatk(iprod)%fdt(kkk)%k = rate
     ENDDO

     kkk = indy(ir1) + 1
     indy(ir1) = kkk
     xmatk(ir1)%fdt(kkk)%k = - rate
  ENDDO

!-------------------------------------------------------------------------
! (7) photoreactions with direct integration (nphot_i)    (s-1)
!-------------------------------------------------------------------------
  ideb = ifin + 1
  ifin = ifin + nphot_i
  DO i = ideb, ifin
     rate = pdiesp(i-ideb+1,iopt)

     ik = react(i,0)
     DO j = 4, ik+1
        iprod = react(i,j)
        kkk = indy(iprod) + 1
        indy(iprod) = kkk
        xmatk(iprod)%fdt(kkk)%k = rate
     ENDDO

     ir1 = react(i,1)
     kkk = indy(ir1) + 1
     indy(ir1) = kkk
     xmatk(ir1)%fdt(kkk)%k = - rate
  ENDDO

!-------------------------------------------------------------------------
! (8) 3 body reactions (n3body)
!-------------------------------------------------------------------------
  ideb = ifin + 1
  ifin = ifin + n3body
  DO i = ideb, ifin
     ir1 = react(i,1)
     ir2 = react(i,2)
     ir3 = react(i,3)
     expon = EXP(-bet(i)/tgaz(iopt))
     rate = gamm(i) * (tgaz(iopt)/300.0_dp)**alpha(i) * expon

     ik = react(i,0)
     DO j = 4, ik+1
        iprod = react(i,j)
        kkk = indy(iprod) + 1
        indy(iprod) = kkk
        xmatk(iprod)%fdt(kkk)%k = rate
     ENDDO

     kkk = indy(ir1) + 1
     indy(ir1) = kkk
     xmatk(ir1)%fdt(kkk)%k = - rate
     kkk = indy(ir2) + 1
     indy(ir2) = kkk
     xmatk(ir2)%fdt(kkk)%k = - rate
     kkk = indy(ir3) + 1
     indy(ir3) = kkk
     xmatk(ir3)%fdt(kkk)%k = - rate
  ENDDO

!-------------------------------------------------------------------------
! (101...) exceptions (ncpart)
!-------------------------------------------------------------------------
  ideb = ifin + 1
  ifin = ifin + ncpart
  DO i = ideb, ifin
     ir1 = react(i,1)
     ir2 = react(i,2)
     ip1 = react(i,4)
     ip2 = react(i,5)

     !--------------------------------------------------------------------------
     ! (101) H2 + N+ -> NH+ + H
     !--------------------------------------------------------------------------
     IF ( (ir1 == i_h2 .AND. ir2 == i_np) .OR. (ir1 == i_np .AND. ir2 == i_h2)) &
        THEN
        !--- Old expression by Jacques
        !rate = gamm(i) * (h2para * EXP(-bet(i) / tgaz(iopt)) + h2orth)
        !               * ((tgaz(iopt) / 300.0_dp)**alpha(i))
        !--- Dislaire 2012 expression
        rate = gamm(i)    * h2para * EXP( -bet(i) / tgaz(iopt)) * (tgaz(iopt) / 300.0_dp)**alpha(i) &
             + 4.2e-10_dp * h2orth * EXP(-44.5_dp / tgaz(iopt)) * (tgaz(iopt) / 300.0_dp)**(-0.17_dp)

     !--------------------------------------------------------------------------
     ! (102) H2 + H2D+ -> H3+ + HD
     !--------------------------------------------------------------------------
     !--- Old expressions
     !ELSE IF (ir1 == i_h2 .AND. ir2 == i_h2dp .AND. tgaz(iopt)>= 20.0_dp)   THEN
     !     rate = gamm(i) / 10**(62.481_dp * tgaz(iopt)**(-0.94871_dp))
     !ELSE IF (ir1 == i_h2 .AND. ir2 == i_h2dp .AND. tgaz(iopt)< 20.0_dp) THEN
     !     rate = gamm(i) / (6.3407e35_dp * tgaz(iopt)**(-25.203_dp))
     !--- Expression with para and ortho H2
     ELSE IF (ir1 == i_h2 .AND. ir2 == i_h2dp)  THEN
        rate = gamm(i) * (h2para * EXP(-bet(i) / tgaz(iopt))                  &
                       + h2orth * EXP(-61.5_dp / tgaz(iopt)) * ((tgaz(iopt) / 300.0_dp)**alpha(i)))

     !--------------------------------------------------------------------------
     ! (103) 13C+ + CO - Roueff & Loison (2014)
     !--------------------------------------------------------------------------
     ELSE IF (itype(i) == 103 .AND. (ir1 == i_c13p .OR. ir2 == i_c13p ))  THEN
        rate = gamm(i) * (tgaz(iopt)/300.0_dp)**alpha(i) * EXP(-6.5_dp/tgaz(iopt))  &
                       * (1.0_dp / (1.0_dp + EXP(-bet(i)/tgaz(iopt))))

     !--------------------------------------------------------------------------
     ! (103) C+ + 13CO - Roueff & Loison (2014)
     !--------------------------------------------------------------------------
     ELSE IF (itype(i) == 103 .AND. (ir1 == i_cp .OR. ir2 == i_cp ))  THEN
        rate = gamm(i) * (tgaz(iopt)/300.0_dp)**alpha(i) * EXP(-6.5_dp/tgaz(iopt))  &
                       * EXP(-bet(i)/tgaz(iopt)) * (1.0_dp / (1.0_dp + EXP(-bet(i)/tgaz(iopt))))

     !--------------------------------------------------------------------------
     ! (104) Isotopic exchange class B (Evelyne)
     !       13C+ + XXX ->
     !       13C  + XXX ->
     !--------------------------------------------------------------------------
     ELSE IF (itype(i) == 104 .AND. (ir1 == i_c13p .OR. ir1 == i_c13 &
                              .OR.   ir2 == i_c13p .OR. ir2 == i_c13)) THEN
        rate = gamm(i) * (tgaz(iopt)/300.0_dp)**alpha(i)   &
                       * (1.0_dp / (1.0_dp + EXP(-bet(i)/tgaz(iopt))))
     ELSE IF (itype(i) == 104 .AND. (ir1 == i_cp .OR. ir1 == i_c &
                              .OR.   ir2 == i_cp .OR. ir2 == i_c)) THEN
        rate = gamm(i) * (tgaz(iopt)/300.0_dp)**alpha(i)   &
                       * EXP(-bet(i)/tgaz(iopt)) * (1.0_dp / (1.0_dp + EXP(-bet(i)/tgaz(iopt))))

     !--------------------------------------------------------------------------
     ! (105) Reactions avec formule IONPOL1 (voir KIDA)
     ! Example: C+   + NH3
     !          H2+  + CN
     !          NH+  + CN
     !          HCN+ + H2O
     !          H+   + HCN
     !--------------------------------------------------------------------------
     ELSE IF (itype(i) == 105) THEN
        !rate = gamm(i) * (tgaz(iopt)/300.0_dp)**alpha(i) * EXP(-tgaz(iopt)/bet(i)) ! pour EXP()T/DE) ala Black H-
        rate = gamm(i) * alpha(i) * (0.62_dp + (0.4767_dp * bet(i) / sqrt(tgaz(iopt)/300.0_dp)))

     !--------------------------------------------------------------------------
     ! (106) Reactions avec formule IONPOL2
     !--------------------------------------------------------------------------
     ELSE IF (itype(i) == 106) THEN
        rate = gamm(i) * alpha(i) * (1.0_dp + (0.0967_dp * bet(i) / sqrt(tgaz(iopt)/300.0_dp) &
                                            + (bet(i)**2 / 10.526_dp * 300.0_dp/tgaz(iopt))))

     !--------------------------------------------------------------------------
     ! (107) Cl + H2 -> HCl + H
     !--------------------------------------------------------------------------
     ELSE IF (itype(i) == 107 .AND. tgaz(iopt)< 354.0_dp &
              .AND. (ip1 == i_hcl .OR. ip2 == i_hcl)) THEN
        rate = 2.52e-11_dp * EXP(-2214.0_dp / tgaz(iopt))
     ELSE IF (itype(i) == 107 .AND. tgaz(iopt)>= 354.0_dp &
              .AND. (ip1 == i_hcl .OR. ip2 == i_hcl)) THEN
        rate = 2.86e-12_dp * (tgaz(iopt)/300.0_dp)**1.72_dp * EXP(-1544.0_dp / tgaz(iopt))

     !--------------------------------------------------------------------------
     ! (107) HCl + H -> Cl + H2
     !--------------------------------------------------------------------------
     ELSE IF (itype(i) == 107 .AND. tgaz(iopt)< 354.0_dp &
              .AND. (ir1 == i_hcl .OR. ir2 == i_hcl))  THEN
        rate = 1.49e-11_dp * EXP(-1763.0_dp / tgaz(iopt))
     ELSE IF (itype(i) == 107 .AND. tgaz(iopt)>= 354.0_dp &
              .AND. (ir1 == i_hcl .OR. ir2 == i_hcl))   THEN
        rate = 1.69e-12_dp * (tgaz(iopt)/300.0_dp)**1.72_dp * EXP(-1093.0_dp / tgaz(iopt))

     !--------------------------------------------------------------------------
     ! (108) F + H2 -> HF + H
     !--------------------------------------------------------------------------
     ELSE IF (itype(i) == 108) THEN
       !--- Old expression from Neufeld 2009
       !rate = 1.0e-10_dp * (EXP(-450.0_dp/tgaz(iopt)) + 0.078_dp * EXP(-80.0_dp/tgaz(iopt)) &
       !     + 0.01555_dp * EXP(-10.0_dp/tgaz(iopt)))
       !--- Expression updated by Tizniti et al. 2014
       rate = 4.71e-13_dp * (EXP(-0.364_dp/tgaz(iopt)) + 3.38_dp * EXP(-38.9_dp/tgaz(iopt)) &
            + 212.0_dp * EXP(-881.0_dp/tgaz(iopt)) + 124.0_dp * EXP(-414.0_dp/tgaz(iopt)))

     !--------------------------------------------------------------------------
     ! (109) Isotopic exchange class B with symmetrical reactions
     !--------------------------------------------------------------------------
     ELSE IF (itype(i) == 109 .AND. (ir1 == i_c13p .OR. ir1 == i_c13 &
                              .OR.   ir2 == i_c13p .OR. ir2 == i_c13)) THEN
        rate = gamm(i) * (tgaz(iopt)/300.0_dp)**alpha(i) &
                       * (2.0_dp / (2.0_dp + EXP(-bet(i)/tgaz(iopt))))
     ELSE IF (itype(i) == 109 .AND. (ir1 == i_cp .OR. ir1 == i_c &
                              .OR.   ir2 == i_cp .OR. ir2 == i_c)) THEN
        rate = gamm(i) * (tgaz(iopt)/300.0_dp)**alpha(i) &
                       * EXP(-bet(i)/tgaz(iopt)) * (1.0_dp / (2.0_dp + EXP(-bet(i)/tgaz(iopt))))

     !--------------------------------------------------------------------------
     ! (110) Collisional dissociation of H2
     !--------------------------------------------------------------------------
     ELSE IF (itype(i) == 110 .AND. (ir1 == i_h .AND. ir2 == i_h2)) THEN
        !Janev et al. (2008)
        !DO iv1 = 0, 14
        !   kvh2(iv1) = -a1h2v(iv1) - a2h2v(iv1) / (tgaz(iopt)**a3h2v(iv1) * (1.0_dp + a4h2v(iv1) * tgaz(iopt)**a5h2v(iv1)))
        !ENDDO
        !kvh2 = EXP(kvh2)
        !rate = SUM(kvh2(:)*xh2v(:))

        ! Glover et Mac Low, low and high density
        rate_l = 6.67e-12_dp * SQRT(tgaz(iopt)) * EXP(-(1.0_dp + 63590.0_dp / tgaz(iopt)))
        !rate = rate_l
        rate_h = 3.52e-9_dp * EXP(-43900.0_dp / tgaz(iopt))
        rate = EXP(((densh(iopt) / 1.3e3_dp) * LOG(rate_h) + LOG(rate_l)) / (1.0_dp + densh(iopt) / 1.3e3_dp))
     ELSE IF (itype(i) == 110 .AND. (ir1 == i_h2 .AND. ir2 == i_h2)) THEN
        ! Janev et al. (2008)
        !DO iv1 = 0, 14
        !   kvh2(iv1) = 1.30_dp * (1.0_dp + 0.023_dp*iv1 + 1.93e-5_dp * iv1**4.75_dp + 2.85e-24_dp * iv1**21.60_dp) &
        !             * EXP(-(7.47_dp - 0.322_dp*iv1) * 1.0e3 / tgaz(iopt)) * 1.0e-10_dp
        !ENDDO
        !rate = SUM(kvh2(:)*xh2v(:))

        ! Glover et Mac Low, low density
        rate_l = 5.996e-30_dp * tgaz(iopt)**4.1881_dp * EXP(-54657.4_dp/tgaz(iopt)) / (1.0_dp + 6.761e-6_dp * tgaz(iopt))**5.6881_dp
        !rate = rate_l
        rate_h = 1.3e-9_dp * EXP(-53300.0_dp / tgaz(iopt))
        rate = EXP(((densh(iopt) / 1.3e3_dp) * LOG(rate_h) + LOG(rate_l)) / (1.0_dp + densh(iopt) / 1.3e3_dp))
     ELSE
        rate = 0.0_dp
     ENDIF

     ik = react(i,0)
     DO j = 4, ik+1
        iprod = react(i,j)
        kkk = indy(iprod) + 1
        indy(iprod) = kkk
        xmatk(iprod)%fdt(kkk)%k = rate
     ENDDO

     kkk = indy(ir1) + 1
     indy(ir1) = kkk
     xmatk(ir1)%fdt(kkk)%k = - rate

     kkk = indy(ir2) + 1
     indy(ir2) = kkk
     xmatk(ir2)%fdt(kkk)%k = - rate
  ENDDO

!       ---------------------
!-- 2 - Reactions with grains
!       ---------------------

   nsp_n1 = nsp_ne + nsp_ip + nsp_im + nsp_gm + nsp_cs
!-------------------------------------------------------------------------
! (11) reactions on grain surface (ngsurf)
!-------------------------------------------------------------------------
! 10 Feb 2008 - Those reaction are built for only one product
!               This could be changed later
! 15 Jan 2010 - Upgraded to surface reaction with ice mantle.
!               Heavy species are supposed NOT to exhibit tunelling
!               All terms are written as in the document, without possible simplifications.
! 29 Jan 2010 - Add up to 4 products for Ice mantle species (type 11 only)
!               Note: If H or H2 is produced, it MUST desorb immediatly !!!

  ideb = ifin + 1
  ifin = ifin + ngsurf
  DO i = ideb, ifin

     ir1 = react(i,1)
     ir2 = react(i,2)

     ! vibration frequencies in a site
     nu0_1 = SQRT(2.0_dp*xk*t_evap(ir1)/(xmh*mol(ir1))) / (xpi * dsite)
     nu0_2 = SQRT(2.0_dp*xk*t_evap(ir2)/(xmh*mol(ir2))) / (xpi * dsite)
     ! reaction attempts frequency (Ref: Garrod & Pauly 2011, section 2.2)
     nu0_3 = MAX(nu0_1, nu0_2)
     ! reduced mass of the two reactants
     redmass = xmh * mol(ir1) * mol(ir2) / (mol(ir1) + mol(ir2))

     !-------------------------------------------------------------------
     ! Reaction between 2 mantle species
     !-------------------------------------------------------------------
     IF (itype(i) == 11) THEN

        react_eff = 0.0_dp     ! Efficiency of the reaction (no unit)
        rate      = 0.0_dp     ! Reaction rate

        !-- Probability of reaction
        DO mm = 1, npg
           tgr = tdust(mm,iopt) ! Grain temperature of size mm

           ! Hopping frequencies - diffusion between sites
           tm1_1 = nu0_1 * (EXP(-t_diff(ir1) / tgr)) ! Hopping frequency (s-1)
           tm1_2 = nu0_2 * (EXP(-t_diff(ir2) / tgr)) ! Hopping frequency (s-1)

           ! Tunneling effect transmission through the activation barrier
           ! - Approximation
           ! tunnel_trans = 16.0_dp * (tgr*(bet(i) - tgr)/bet(i)**2) * EXP(-dthres / xhp * xpi * SQRT(2.0_dp * redmass * xk * bet(i)))
           ! - Expression by Evelyne, Atkins or Cohen
           IF (bet(i) > tgr) THEN
              xldb_3 =  2.0_dp * xpi / xhp * SQRT(2.0_dp * redmass * xk * (bet(i) - tgr))
              tunnel_trans =  1.0_dp / (1.0_dp + bet(i)**2 &
                           * (SINH(xldb_3 * dthres))**2 / (4.0_dp * tgr * (bet(i) - tgr)))
              p_react  = gamm(i) * (nu0_3 * EXP(-bet(i)/tgr) + nu0_3 * tunnel_trans)
           ELSE
              p_react  = gamm(i) * nu0_3 * EXP(-bet(i)/tgr)
           ENDIF

           ! Efficiency of reaction between the two species (Chang 2007, Garrod and Pauly 2011)
           p_diff    = tm1_1 + tm1_2
           p_desor   = nu0_1 * EXP(-t_evap(ir1) / tgr) + nu0_2 * EXP(-t_evap(ir2) / tgr)
           react_eff = p_react / (p_react + p_diff + p_desor)

           ! Chemical reaction rates
           rate = rate + react_eff * (tm1_1 + tm1_2) * adust(mm)**2 * wwmg(mm)

        ENDDO
        rate = rate * 2.0_dp*xpi * dsite**2 / (s_gr_t_bgr**2 * densh(iopt))
        rate = rate * attenu**2

        ik = react(i,0)
        DO j = 4, ik+1
           iprod = react(i,j)
           kkk = indy(iprod) + 1
           indy(iprod) = kkk
           xmatk(iprod)%fdt(kkk)%k = rate
        ENDDO

        kkk = indy(ir1) + 1
        indy(ir1) = kkk
        xmatk(ir1)%fdt(kkk)%k = - rate

        kkk = indy(ir2) + 1
        indy(ir2) = kkk
        xmatk(ir2)%fdt(kkk)%k = - rate

     !-------------------------------------------------------------------
     ! Reaction between 1 surface specy and 1 mantle specy
     !-------------------------------------------------------------------
     ELSE IF (itype(i) == 111) THEN

        react_eff = 0.0_dp     ! Efficiency of the reaction (no unit)
        rate      = 0.0_dp     ! Reaction rate

        iprod = react(i,4)
        DO mm = 1, npg
           iv2 = nspec + (ir2 - nsp_n1 - 1) * npg + mm
           tgr = tdust(mm,iopt)

           ! Hopping frequencies - diffusion between sites
           xldb_2 =  2.0_dp * xpi * SQRT(2.0_dp * xmh * mol(ir2) * xk * (t_diff(ir2) - tgr)) / xhp
           tm1_1 = nu0_1 * (EXP(-t_diff(ir1) / tgr))
           tm1_2 = nu0_2 * (EXP(-t_diff(ir2) / tgr) + 1.0_dp / (1.0_dp + t_diff(ir2)**2 &
                 * SINH(xldb_2 * dsite)**2 / (4.0_dp * tgr * (t_diff(ir2) - tgr))))

           ! Tunneling effect transmission through the activation barrier
           ! - Approximation
           ! tunnel_trans = 16.0_dp * (tgr*(bet(i) - tgr)/bet(i)**2) * EXP(-dthres / xhp * xpi * SQRT(2.0_dp * redmass * xk * bet(i)))
           ! - Expression by Evelyne, Atkins or Cohen
           IF (bet(i) > tgr) THEN
              xldb_3 =  2.0_dp * xpi / xhp * SQRT(2.0_dp * redmass * xk * (bet(i) - tgr))
              tunnel_trans =  1.0_dp / (1.0_dp + bet(i)**2 &
                           * (SINH(xldb_3 * dthres))**2 / (4.0_dp * tgr * (bet(i) - tgr)))
              p_react  = gamm(i) * (nu0_3 * EXP(-bet(i)/tgr) + nu0_3 * tunnel_trans)
           ELSE
              p_react  = gamm(i) * nu0_3 * EXP(-bet(i)/tgr)
           ENDIF

           ! Efficiency of reaction between the two species (Chang 2007, Garrod and Pauly 2011)
           p_diff    = tm1_1 + tm1_2
           p_desor   = nu0_1 * EXP(-t_evap(ir1) / tgr) + nu0_2 * EXP(-t_evap(ir2) / tgr)
           react_eff = p_react / (p_react + p_diff + p_desor)

           rate = react_eff * (tm1_1 + tm1_2) * dsite**2 / (2.0_dp * s_gr_t_bgr * densh(iopt))
           rate = rate * attenu

           kkk = indy(iprod) + 1
           indy(iprod) = kkk
           xmatk(iprod)%fdt(kkk)%k = rate * wwmg(mm) * densh(iopt)

           kkk = indy(ir1) + 1
           indy(ir1) = kkk
           xmatk(ir1)%fdt(kkk)%k = - rate * wwmg(mm) * densh(iopt)

           kkk = indy(iv2) + 1
           indy(iv2) = kkk
           xmatk(iv2)%fdt(kkk)%k = - rate
        ENDDO

     !-------------------------------------------------------------------
     ! Reaction between 2 surface species
     !-------------------------------------------------------------------
     ELSE IF (itype(i) == 211) THEN

        react_eff = 0.0_dp     ! Efficiency of the reaction (no unit)
        rate      = 0.0_dp     ! Reaction rate

        iprod = react(i,4)
        DO mm = 1, npg
           iv1 = nspec + (ir1 - nsp_n1 - 1) * npg + mm
           iv2 = nspec + (ir2 - nsp_n1 - 1) * npg + mm
           tgr = tdust(mm,iopt)

           ! Hopping frequencies - diffusion between sites
           xldb_1 =  2.0_dp * xpi * SQRT(2.0_dp * xmh * mol(ir1) * xk * (t_diff(ir1) - tgr)) / xhp
           xldb_2 =  2.0_dp * xpi * SQRT(2.0_dp * xmh * mol(ir2) * xk * (t_diff(ir2) - tgr)) / xhp
           tm1_1 = nu0_1 * (EXP(-t_diff(ir1) / tgr) + 1.0_dp / (1.0_dp + t_diff(ir1)**2 &
                 * SINH(xldb_1 * dsite)**2 / (4.0_dp * tgr * (t_diff(ir1) - tgr))))
           tm1_2 = nu0_2 * (EXP(-t_diff(ir2) / tgr) + 1.0_dp / (1.0_dp + t_diff(ir2)**2 &
                 * SINH(xldb_2 * dsite)**2 / (4.0_dp * tgr * (t_diff(ir2) - tgr))))

           ! Tunneling effect transmission through the activation barrier
           ! - Approximation
           ! tunnel_trans = 16.0_dp * (tgr*(bet(i) - tgr)/bet(i)**2) * EXP(-dthres / xhp * xpi * SQRT(2.0_dp * redmass * xk * bet(i)))
           ! - Expression by Evelyne, Atkins or Cohen
           IF (bet(i) > tgr) THEN
              xldb_3 =  2.0_dp * xpi / xhp * SQRT(2.0_dp * redmass * xk * (bet(i) - tgr))
              tunnel_trans =  1.0_dp / (1.0_dp + bet(i)**2 &
                           * (SINH(xldb_3 * dthres))**2 / (4.0_dp * tgr * (bet(i) - tgr)))
              p_react  = gamm(i) * (nu0_3 * EXP(-bet(i)/tgr) + nu0_3 * tunnel_trans)
           ELSE
              p_react  = gamm(i) * nu0_3 * EXP(-bet(i)/tgr)
           ENDIF

           ! Efficiency of reaction between the two species (Chang 2007, Garrod and Pauly 2011)
           p_diff    = tm1_1 + tm1_2
           p_desor   = nu0_1 * EXP(-t_evap(ir1) / tgr) + nu0_2 * EXP(-t_evap(ir2) / tgr)
           react_eff = p_react / (p_react + p_diff + p_desor)

           ! This should be 1 / (8 * pi) (see notes)
           rate = react_eff * (tm1_1 + tm1_2) * dsite**2 / (8.0_dp * xpi * adust(mm)**2)

           kkk = indy(iprod) + 1
           indy(iprod) = kkk
           xmatk(iprod)%fdt(kkk)%k = rate * wwmg(mm) * densh(iopt)

           kkk = indy(iv1) + 1
           indy(iv1) = kkk
           xmatk(iv1)%fdt(kkk)%k = - rate

           kkk = indy(iv2) + 1
           indy(iv2) = kkk
           xmatk(iv2)%fdt(kkk)%k = - rate
        ENDDO
     ENDIF
  ENDDO

!-------------------------------------------------------------------------
! (12) photoreactions on grain surface (ngphot)
!-------------------------------------------------------------------------
!  11 Feb 2008: not revised yet. Do not use

  ideb = ifin + 1
  ifin = ifin + ngphot
  DO i = ideb, ifin
     rate1 = gamm(i) * EXP(-bet(i)*av) * radm
     rate2 = gamm(i) * EXP(-bet(i)*avr) * radp
     rate = rate1 + rate2

     ik = react(i,0)
     DO j = 4, ik+1
        iprod = react(i,j)
        kkk = indy(iprod) + 1
        indy(iprod) = kkk
        xmatk(iprod)%fdt(kkk)%k = rate
     ENDDO

     ir1 = react(i,1)
     kkk = indy(ir1) + 1
     indy(ir1) = kkk
     xmatk(ir1)%fdt(kkk)%k = - rate
  ENDDO

!-------------------------------------------------------------------------
! (13) adsorption on to grains (ngads)
!-------------------------------------------------------------------------
  IF (.NOT. ALLOCATED(stickH)) THEN
     ALLOCATE (stickH(npg))
  ENDIF

  ideb = ifin + 1
  ifin = ifin + ngads
  DO i = ideb, ifin
     ir1 = react(i,1)
     iprod = react(i,4)
     ! Same sticking probability for all species (not only for H and D)
     CALL STICKING(iopt, i, ir1, stickH)
     stick_m = SUM(wwmg(:) * adust(:)**2 * stickH(:))

     IF (itype(i) == 13) THEN

        rate = vmaxw * SQRT(tgaz(iopt) / mol(ir1)) * densh(iopt) * xpi * stick_m

        kkk = indy(iprod) + 1
        indy(iprod) = kkk
        xmatk(iprod)%fdt(kkk)%k = rate

        kkk = indy(ir1) + 1
        indy(ir1) = kkk
        xmatk(ir1)%fdt(kkk)%k = - rate

     ELSE IF (itype(i) == 113) THEN

        vtherm = vmaxw * SQRT(tgaz(iopt) / mol(ir1))
        sigm   = vtherm * dsite*dsite / 4.0_dp
        k_Ad   = vtherm * xpi * densh(iopt) * stick_m

        kkk = indy(ir1) + 1
        indy(ir1) = kkk
        xmatk(ir1)%fdt(kkk)%k = - k_Ad           ! 1 destruction reaction for ir1 (-k_{Ad})

        DO mm = 1, npg
           ivp = nspec + (iprod - nsp_n1 - 1) * npg + mm

           k_i_Ad  = stickH(mm) * vtherm * xpi * adust(mm)**2
           k_i_Rej = stickH(mm) * sigm

           kkk = indy(ivp) + 1
           indy(ivp) = kkk
           xmatk(ivp)%fdt(kkk)%k = k_i_Ad        ! 1 formation of N_j(a_i) (+k^i_{Ad})

           DO j = nsp_n1+1, nsp_n1+nsp_g1
              pr = pr_rej(iprod-nsp_n1,j-nsp_n1)
              k_ij_Rej = sigm * (stickH(mm) - 1.0_dp + pr) * densh(iopt) * wwmg(mm)
              k_j_ER   = sigm * (1.0_dp - pr)
              k_ij_ER  = k_j_ER * densh(iopt) * wwmg(mm)

              kkk = indy(ir1) + 1
              indy(ir1) = kkk
              xmatk(ir1)%fdt(kkk)%k = k_ij_Rej   ! 1 rejection for ir1 (+k^{ij}_{Rej})

              IF (iprod == i_hgr) THEN
                 IF (j == i_hgr) THEN
                    kkk = indy(ivp) + 1
                    indy(ivp) = kkk
                    xmatk(ivp)%fdt(kkk)%k = -k_i_Rej        ! 1 rejection of N_j(a_i) (-k^i_{Rej})
                    kkk = indy(ivp) + 1
                    indy(ivp) = kkk
                    xmatk(ivp)%fdt(kkk)%k = -k_j_ER      ! 1 destruction of N_j(a_i) (-k^j_{ER})
                    kkk = indy(i_h2) + 1
                    indy(i_h2) = kkk
                    xmatk(i_h2)%fdt(kkk)%k = k_ij_ER      ! 1 formation of H2 (+k^{ij}_ER)
                 ELSE IF (j == i_dgr) THEN
                    kkk = indy(ivp) + 1
                    indy(ivp) = kkk
                    xmatk(ivp)%fdt(kkk)%k = -k_i_Rej        ! 1 rejection of N_j(a_i) (-k^i_{Rej})
                    kkk = indy(ivp) + 1
                    indy(ivp) = kkk
                    xmatk(ivp)%fdt(kkk)%k = -k_j_ER      ! 1 destruction of N_j(a_i) (-k^j_{ER})
                    kkk = indy(i_hd) + 1
                    indy(i_hd) = kkk
                    xmatk(i_hd)%fdt(kkk)%k = k_ij_ER      ! 1 formation of HD (+k^{ij}_ER)
                 ELSE
                    kkk = indy(ivp) + 1
                    indy(ivp) = kkk
                    xmatk(ivp)%fdt(kkk)%k = -k_i_Rej        ! 1 rejection of N_j(a_i) (-k^i_{Rej})
                 ENDIF
              ELSE IF (iprod == i_dgr) THEN
                 IF (j == i_hgr) THEN
                    kkk = indy(ivp) + 1
                    indy(ivp) = kkk
                    xmatk(ivp)%fdt(kkk)%k = -k_i_Rej        ! 1 rejection of N_j(a_i) (-k^i_{Rej})
                    kkk = indy(ivp) + 1
                    indy(ivp) = kkk
                    xmatk(ivp)%fdt(kkk)%k = -k_j_ER      ! 1 destruction of N_j(a_i) (-k^j_{ER})
                    kkk = indy(i_hd) + 1
                    indy(i_hd) = kkk
                    xmatk(i_hd)%fdt(kkk)%k = k_ij_ER      ! 1 formation of HD (+k^{ij}_ER)
                 ELSE
                    kkk = indy(ivp) + 1
                    indy(ivp) = kkk
                    xmatk(ivp)%fdt(kkk)%k = -k_i_Rej        ! 1 rejection of N_j(a_i) (-k^i_{Rej})
                 ENDIF
              ELSE
                 kkk = indy(ivp) + 1
                 indy(ivp) = kkk
                 xmatk(ivp)%fdt(kkk)%k = -k_i_Rej           ! 1 rejection of N_j(a_i) (-k^i_{Rej})
              ENDIF
           ENDDO
        ENDDO
     ENDIF
  ENDDO

  DEALLOCATE (stickH)

!-------------------------------------------------------------------------
! (14) neutralization (ngneut)
!-------------------------------------------------------------------------
  ideb = ifin + 1
  ifin = ifin + ngneut

  DO i = ideb, ifin
     ir1   = react(i,1)
     iprod = react(i,4)
     IF ( (ir1 > nsp_ne) .AND. (ir1 <= nsp_ne+nsp_ip+nsp_im) ) THEN
        rate = rxigr(ir1,iopt)
     ELSE IF ( ir1 == nspec ) THEN
        rate = relgr(2,iopt)
     ELSE IF ( iprod == nspec ) THEN
        rate = relgr(1,iopt)
     ENDIF

     IF ( iprod <= n_var ) THEN
        kkk = indy(iprod) + 1
        indy(iprod) = kkk
        xmatk(iprod)%fdt(kkk)%k = rate
     ENDIF

     IF ( ir1 <= n_var ) THEN
        kkk = indy(ir1) + 1
        indy(ir1) = kkk
        xmatk(ir1)%fdt(kkk)%k = - rate
     ENDIF
  ENDDO

!-------------------------------------------------------------------------
! (15) explosive desorption from grains (nggdes)
!    ref: Shalabiea & Greenberg 1994
!-------------------------------------------------------------------------
!  11 Feb 2008: not revised yet. Do not use
  ideb = ifin + 1
  ifin = ifin + nggdes
  DO i = ideb, ifin
     ir1 = react(i,1)
     rate1 = gamm(i) * rdeso * densh(iopt)
     rate2 = gamm(i) * 3.0d4 * zeta * (signgr / 7.0e-21_dp)
     rate = rate1 + rate2

     IF (itype(i) == 15) THEN
        iprod = react(i,4)
        kkk = indy(iprod) + 1
        indy(iprod) = kkk
        xmatk(iprod)%fdt(kkk)%k = rate

        kkk = indy(ir1) + 1
        indy(ir1) = kkk
        xmatk(ir1)%fdt(kkk)%k = - rate
     ENDIF
  ENDDO

!-------------------------------------------------------------------------
! (16) cosmic ray induced desorption from grains (ncrdes)
!      (sans les photons secondaires)
!-------------------------------------------------------------------------
  ideb = ifin + 1
  ifin = ifin + ncrdes
  DO i = ideb, ifin
     rate = gamm(i) * zeta * dsite**2 / 4.0_dp
     ir1 = react(i,1)
     iprod = react(i,4)

     IF (itype(i) == 16) THEN

        kkk = indy(iprod) + 1
        indy(iprod) = kkk
        xmatk(iprod)%fdt(kkk)%k = rate

        kkk = indy(ir1) + 1
        indy(ir1) = kkk
        xmatk(ir1)%fdt(kkk)%k = - rate

     ELSE IF (itype(i) == 116) THEN

        DO mm = 1, npg
           ivp = nspec + (ir1 - nsp_n1 - 1) * npg + mm
           kkk = indy(ivp) + 1
           indy(ivp) = kkk
           xmatk(ivp)%fdt(kkk)%k = - rate

           kkk = indy(iprod) + 1
           indy(iprod) = kkk
           xmatk(iprod)%fdt(kkk)%k = rate * densh(iopt) * wwmg(mm)
        ENDDO
     ENDIF
  ENDDO

!-------------------------------------------------------------------------
! (17) photodesorption from grains (nphdes)
!-------------------------------------------------------------------------
!  flux de photons secondaires due aux rayons cosmiques:
!     1E3 cm-2 s-1 (Roberge, in Dalgarno's book)
!     fphsec = 1.0e3_dp * (zeta / 1.0e-17_dp) = 1.0e3_dp * fmrc

!  flux de Mathis et al de 911 a 2400 A (avec F(l) = 5e-17 erg cm-3 A-1)
!  flupho = 1e8 photon cm-2 s-1      (Tielens & Hagen, 1982, A&A 114, 245)
!     flupho = 1.0d8
!     flupho = flupho * RAD * EXP(-2.0_dp * AV)
  ideb = ifin + 1
  ifin = ifin + nphdes
  DO i = ideb, ifin
     rate = gamm(i) * (fphsec * frach2 + fluph(iopt)) * dsite**2 / 4.0_dp
     ir1 = react(i,1)

     IF (itype(i) == 17) THEN

        rate = rate * attenu

        kkk = indy(ir1) + 1
        indy(ir1) = kkk
        xmatk(ir1)%fdt(kkk)%k = - rate

        ik = react(i,0)
        DO j = 4, ik+1
           iprod = react(i,j)
           kkk = indy(iprod) + 1
           indy(iprod) = kkk
           xmatk(iprod)%fdt(kkk)%k = rate
        ENDDO

     ELSE IF (itype(i) == 117) THEN

        DO mm = 1, npg
           ivp = nspec + (ir1 - nsp_n1 - 1) * npg + mm
           kkk = indy(ivp) + 1
           indy(ivp) = kkk
           xmatk(ivp)%fdt(kkk)%k = - rate

           ik = react(i,0)
           DO j = 4, ik+1
              iprod = react(i,j)
              kkk = indy(iprod) + 1
              indy(iprod) = kkk
              xmatk(iprod)%fdt(kkk)%k = rate * densh(iopt) * wwmg(mm)
           ENDDO
        ENDDO
     ENDIF
  ENDDO

!-------------------------------------------------------------------------
! (18) evaporation from grains (ngevap)
!-------------------------------------------------------------------------
  ideb = ifin + 1
  ifin = ifin + ngevap
  DO i = ideb, ifin
     ir1 = react(i,1)
     iprod = react(i,4)
!    nu0 = SQRT(2.0_dp*xk*t_evap(ir1)/(xmh*mol(ir1))) / (xpi * dsite)
     nu0 = SQRT(2.0_dp*xk*t_evap(ir1)/(xmh*mol(ir1))) / (xpi * dwell)

     IF (itype(i) == 18) THEN

        summ = 0.0_dp
        DO mm = 1, npg
!          tgr = MIN(tdust(mm,iopt), 25.0_dp)
           tgr = tdust(mm,iopt)
           summ = summ + wwmg(mm) * adust(mm)**2 * EXP(-t_evap(ir1) / tgr)
        ENDDO
!       Alternative expression (Evelyne) => no divide by zero for rmin = rmax
        rate = nu0 * summ * 4.0_dp * xpi * attenu / s_gr_t_bgr

        kkk = indy(iprod) + 1
        indy(iprod) = kkk
        xmatk(iprod)%fdt(kkk)%k = rate

        kkk = indy(ir1) + 1
        indy(ir1) = kkk
        xmatk(ir1)%fdt(kkk)%k = - rate

     ELSE IF (itype(i) == 118) THEN

        DO mm = 1, npg
           tgr = tdust(mm,iopt)
           rate = nu0 * EXP(-t_evap(ir1) / tgr)
           ivp = nspec + (ir1 - nsp_n1 - 1) * npg + mm
           kkk = indy(ivp) + 1
           indy(ivp) = kkk
           xmatk(ivp)%fdt(kkk)%k = - rate

           kkk = indy(iprod) + 1
           indy(iprod) = kkk
           xmatk(iprod)%fdt(kkk)%k = rate * densh(iopt) * wwmg(mm)
        ENDDO
     ENDIF
  ENDDO

!-------------------------------------------------------------------------
! (19) Chemisorption on grains (ngchs)
!-------------------------------------------------------------------------
  ideb = ifin + 1
  ifin = ifin + ngchs

  DO i = ideb, ifin
     ! stick_ER = MIN(1.0_dp, SQRT(300.0_dp/tgaz(iopt)))
     ! stick_ER = 1.0_dp / (1.0_dp + 1.0e-4_dp * tgaz(iopt)**1.5_dp)
     stick_ER = 1.0_dp / (1.0_dp + (tgaz(iopt)/T2_stick_ER)**ex_stick_ER)
     ir1 = react(i,1)

     expon = EXP(-bet(i)/tgaz(iopt))
     rate = stick_ER * gamm(i) * vmaxw * SQRT(tgaz(iopt) / mol(ir1)) * s_gr_t * densh(iopt) * expon / 4.0_dp
     r_rej = stick_ER * gamm(i) * vmaxw * SQRT(tgaz(iopt) / mol(ir1)) * dsite**2 *expon / 4.0_dp

     iprod = react(i,4)
     kkk = indy(iprod) + 1
     indy(iprod) = kkk
     xmatk(iprod)%fdt(kkk)%k = rate

     kkk = indy(ir1) + 1
     indy(ir1) = kkk
     xmatk(ir1)%fdt(kkk)%k = - rate

     ! Rejection
     kkk = indy(iprod) + 1
     indy(iprod) = kkk
     xmatk(iprod)%fdt(kkk)%k = - r_rej
     kkk = indy(ir1) + 1
     indy(ir1) = kkk
     xmatk(ir1)%fdt(kkk)%k = r_rej
  ENDDO

!-------------------------------------------------------------------------
! (20) Eley-Rideal process (ngelri)   (cm3 s-1)
!-------------------------------------------------------------------------
! Note : the total number of sites is: s_gr_t * densh(iopt) / dsite**2
  ideb = ifin + 1
  ifin = ifin + ngelri
  DO i = ideb, ifin

     rate = gamm(i) * vmaxw * SQRT(tgaz(iopt) / mol(ir1)) * dsite**2 / 4.0_dp

     ik = react(i,0)
     DO j = 4, ik+1
        iprod = react(i,j)
        kkk = indy(iprod) + 1
        indy(iprod) = kkk
        xmatk(iprod)%fdt(kkk)%k = rate
     ENDDO

     ir1 = react(i,1)
     kkk = indy(ir1) + 1
     indy(ir1) = kkk
     xmatk(ir1)%fdt(kkk)%k = - rate

     ir2 = react(i,2)
     kkk = indy(ir2) + 1
     indy(ir2) = kkk
     xmatk(ir2)%fdt(kkk)%k = - rate
  ENDDO

!-------------------------------------------------------------------------
! (40) radiative and dielec. recomb. of atomic ions (nglass)   (cm3 s-1)
!-------------------------------------------------------------------------
  ideb = ifin + 1
  ifin = ifin + nglass
  DO i = ideb, ifin
     ir1 = react(i,1)
     ir2 = react(i,2)

     l     = i-ideb+1
     bbadn = rdrec(l)%r_B + rdrec(l)%r_C * EXP(-rdrec(l)%r_T(2)/tgaz(iopt))
     ! -------------------------------------------
     ! rates from Badnell (2006) &
     ! http://amdpp.phys.strath.ac.uk/tamoc/DR/
     ! -------------------------------------------
     IF( (rdrec(l)%r_T(0) /= 0.0_dp) .AND. (rdrec(l)%r_T(1) /= 0.0_dp) ) THEN
        rate = rdrec(l)%r_A * ( SQRT(tgaz(iopt)/rdrec(l)%r_T(0)) &
             * (1.0_dp + SQRT(tgaz(iopt)/rdrec(l)%r_T(0)))**(1.0_dp-bbadn) &
             * (1.0_dp + SQRT(tgaz(iopt)/rdrec(l)%r_T(1)))**(1.0_dp+bbadn) )**(-1.0_dp) &
             + tgaz(iopt)**(-1.5_dp) * SUM( rdrec(l)%d_C(1:9) * EXP(-rdrec(l)%d_E(1:9)/tgaz(iopt)) )
     ELSE
        rate = 0.0_dp
     ENDIF
     ! -------------------------------------------
     ! Since Badnell's data are incomplete, the
     ! recombination of s+, s++, fe+, and fe++ are
     ! taken from Landini & Monsignori Fossi (1990)
     ! DR -> included in dielectro_recomb.dat
     ! RR -> expression A*(T/300)**B
     ! -------------------------------------------
     IF     ( ( (speci(ir1) == 's+      ' ).AND.(speci(ir2)=='electr  ') ).OR.&
              ( (speci(ir1) == 'electr  ' ).AND.(speci(ir2)=='s+      ') ) ) THEN
        rate = rate + 3.734e-12_dp*(tgaz(iopt)/300.0_dp)**(-6.300e-1_dp)
     ELSE IF( ( (speci(ir1) == 's++     ' ).AND.(speci(ir2)=='electr  ') ).OR.&
              ( (speci(ir1) == 'electr  ' ).AND.(speci(ir2)=='s++     ') ) ) THEN
        rate = rate + 1.995e-11_dp*(tgaz(iopt)/300.0_dp)**(-6.860e-1_dp)
     ELSE IF( ( (speci(ir1) == 'fe+     ' ).AND.(speci(ir2)=='electr  ') ).OR.&
              ( (speci(ir1) == 'electr  ' ).AND.(speci(ir2)=='fe+     ') ) ) THEN
        rate = rate + 3.230e-12_dp*(tgaz(iopt)/300.0_dp)**(-8.910e-1_dp)
     ELSE IF( ( (speci(ir1) == 'fe++    ' ).AND.(speci(ir2)=='electr  ') ).OR.&
              ( (speci(ir1) == 'electr  ' ).AND.(speci(ir2)=='fe++    ') ) ) THEN
        rate = rate + 1.961e-11_dp*(tgaz(iopt)/300.0_dp)**(-8.430e-1_dp)
     ENDIF
     ! -------------------------------------------
     ! Since Badnell's data are incomplete, the
     ! recombination of ar+ and ar++ are taken
     ! from Shull & Van Steenberg (1982) for both
     ! the radiative and dielectronic processes.
     ! -------------------------------------------
     IF     ( ( (speci(ir1) == 'Ar+     ' ).AND.(speci(ir2)=='electr  ') ).OR.&
              ( (speci(ir1) == 'electr  ' ).AND.(speci(ir2)=='Ar+     ') ) ) THEN
        rate = rate + 3.70e-12_dp*(tgaz(iopt)/300.0_dp)**(-6.51e-1_dp)
        rate = rate + tgaz(iopt)**(-1.5_dp) * 1.0e-3_dp * EXP(-3.2e+5_dp/tgaz(iopt)) &
             * (1.0_dp + 5.0e-3_dp * EXP(-3.1e+5/tgaz(iopt)))
     ELSE IF( ( (speci(ir1) == 'Ar++    ' ).AND.(speci(ir2)=='electr  ') ).OR.&
              ( (speci(ir1) == 'electr  ' ).AND.(speci(ir2)=='Ar++    ') ) ) THEN
        rate = rate + 2.72e-11_dp*(tgaz(iopt)/300.0_dp)**(-7.52e-1_dp)
        rate = rate + tgaz(iopt)**(-1.5_dp) * 1.1e-2_dp * EXP(-2.9e+5_dp/tgaz(iopt)) &
             * (1.0_dp + 4.5e-2_dp * EXP(-5.5e+5/tgaz(iopt)))
     ENDIF

     iprod = react(i,4)
     kkk = indy(iprod) + 1
     indy(iprod) = kkk
     xmatk(iprod)%fdt(kkk)%k = rate

     kkk = indy(ir1) + 1
     indy(ir1) = kkk
     xmatk(ir1)%fdt(kkk)%k = - rate

     kkk = indy(ir2) + 1
     indy(ir2) = kkk
     xmatk(ir2)%fdt(kkk)%k = - rate
  ENDDO

END SUBROUTINE XKFILL

!%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE FABDESP (iopt)
!%%%%%%%%%%%%%%%%%%%%%%%%

   USE PXDR_FLAGS
   USE PXDR_CONSTANTES
   USE PXDR_CHEM_DATA
   USE PXDR_PROFIL
   USE PXDR_AUXILIAR
   USE PXDR_STR_DATA

   IMPLICIT NONE

   INTEGER, INTENT (IN)                             :: iopt
   REAL (KIND=dp), DIMENSION (nqm)                  :: ab1, ab2, ab3
   INTEGER, DIMENSION (nqm)                         :: j1, j2, j3
   INTEGER                                          :: i, k
   INTEGER                                          :: nrxi
   REAL (KIND=dp)                                   :: duma

   DO i = 1, nspec-nsp_g1-1

      nrxi = xmatk(i)%nbt
      DO k = 1, nrxi
         j1(k) = xmatk(i)%fdt(k)%r1
         j2(k) = xmatk(i)%fdt(k)%r2
         j3(k) = xmatk(i)%fdt(k)%r3
         IF (j1(k) > n_var) THEN
            ab1(k) = 1.0_dp
         ELSE
            ab1(k) = abnua(j1(k),iopt)
         ENDIF
         IF (j2(k) > n_var) THEN
            ab2(k) = 1.0_dp
         ELSE
            ab2(k) = abnua(j2(k),iopt)
         ENDIF
         IF (j3(k) > n_var) THEN
            ab3(k) = 1.0_dp
         ELSE
            ab3(k) = abnua(j3(k),iopt)
         ENDIF
      ENDDO

      duma = 0.0_dp
      DO k = 1, nrxi
!        write (6, '(2i5,1p,4e15.6)') i, k, xmatk(i)%fdt(k)%k, ab1(k), ab2(k), ab3(k)
         IF (xmatk(i)%fdt(k)%k > 0.0_dp) THEN
            duma = duma + xmatk(i)%fdt(k)%k * ab1(k) * ab2(k) * ab3(k)
         ENDIF
      ENDDO
      creat(i) = duma
   ENDDO

END SUBROUTINE FABDESP

!%%%%%%%%%%%%%%%%%%
SUBROUTINE CAR_TIME
!%%%%%%%%%%%%%%%%%%

   USE PXDR_FLAGS
   USE PXDR_CONSTANTES
   USE PXDR_CHEM_DATA
   USE PXDR_PROFIL
   USE PXDR_BILTHERM
   USE PREP_VAR

   IMPLICIT NONE

   INTEGER                                     :: iopt
   INTEGER                                     :: i, j, k
   REAL (KIND=dp), DIMENSION(:,:), ALLOCATABLE :: form_sp
   CHARACTER (LEN=lenSpeci)                    :: spe

   IF (ALLOCATED(creat)) THEN
      DEALLOCATE (creat)
   ENDIF
   ALLOCATE (creat(nspec))
   ALLOCATE (form_sp(nspec,0:npo))

   DO iopt = 0, npo
      CALL XKFILL (iopt)
      CALL FABDESP (iopt)
      form_sp(:,iopt) = creat(:)
   ENDDO

!  DO iopt = 0, npo
!     av = tau(iopt) * tautav
!     DO j = 1, nspec
!        WRITE(10,'(i5,1p,e20.8,i5,a10,3e15.6)') &
!             iopt, av, j, speci(j), form_sp(j,iopt), abnua(j,iopt), abnua(j,iopt) / form_sp(j,iopt)
!     ENDDO
!     WRITE (10,'(" ")')
!  ENDDO

   PRINT *, " Do you want also the densities and formation rates? (Yes: 1, No: 0)"
   READ *, k
   IF (irec == 1) THEN
      WRITE (8,*) k
   ENDIF

   i = 1
   DO WHILE (i == 1)
      PRINT *, " Which species (end: 0)?"
      READ *, spe
      IF (irec == 1) THEN
         WRITE (8,'(a8)') spe
      ENDIF
      IF (spe == "0") THEN
         i = 0
         CYCLE
      ENDIF
      DO j = 1, nspec
         IF (spe == speci(j)) EXIT
      ENDDO
      IF (j > nspec) THEN
         PRINT *, spe, " not found"
      ELSE
         PRINT *, j, speci(j)
      ENDIF
      iimax = iimax + 1
      y(iimax,0:npo) = (abnua(j,0:npo) / form_sp(j,0:npo)) / (Myr * 1.0e-6_dp)
      texty(iimax) = ' t.ca.'//speci(j)
      IF (k == 1) THEN
         iimax = iimax + 1
         y(iimax,0:npo) = abnua(j,0:npo)
         texty(iimax) = ' Ab.'//speci(j)
         iimax = iimax + 1
         y(iimax,0:npo) = form_sp(j,0:npo)
         texty(iimax) = ' FR.'//speci(j)
      ENDIF
   ENDDO

END SUBROUTINE CAR_TIME

END MODULE PREP_AUTRE
