
! 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 - 23 May 2008

MODULE PXDR_COLSPE

  PRIVATE

  PUBLIC :: COLHAT,  COLCAT, COLNAT,   COLOAT,  COLSAT  &
          , COLSIAT, COLCPL, COLCPP,   COLNPL,  COLNPP  &
          , COLOPL,  COLOPP, COLSPL,   COLSPP           &
          , COLSIP,  COLNEP, COLNEPP,  COLCO0,  COLCO1  &
          , COLCO2,  COLCO3, COLCO0N,  COLCO1N, COLCO2N &
          , COLCO3N, COLCS0, COLOH,    COLH2O,  COLHCOP &
          , COLCHP,  COLH3P, COLHCN,   COLO2,   COLOHP  &
          , COLSHP,  COLARHP

CONTAINS

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLHAT (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!---------------------------------------------------------------------
!       ttry  :temperature du gaz
!---------------------------------------------------------------------

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    INTEGER                                 :: levl, levu
    INTEGER                                 :: i, j_sp
    REAL (KIND=dp)                          :: fact_e
    REAL (KIND=dp)                          :: delten, logttry
    REAL (KIND=dp)                          :: r_e
    REAL (KIND=dp)                          :: rdo_e
    REAL (KIND=dp)                          :: ratdo, ratup

    j_sp = in_sp(i_h)
    logttry = LOG10(ttry)

    !--- Find the temperature point in H collisions with electrons
    IF (logttry <= tempch_e(1)) THEN
       i0_e = 1
    ELSE IF (logttry >= tempch_e(ntth_e)) THEN
       i0_e = ntth_e
    ELSE
       DO i = 2, ntth_e
          IF (logttry <= tempch_e(i)) THEN
             i0_e = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact_e = (tempch_e(i0_e) - logttry) / (tempch_e(i0_e) - tempch_e(i0_e+1))

    eqcol = 0.0_dp

    ! ----------------------------------------------------------------
    ! notes : given the behaviors of the H collision rates, we make
    !         *** a linear (log-log scale) extrapolation for T<Tmin
    !         *** a constant extrapolation for T>Tmax
    ! ----------------------------------------------------------------
    !--- Compute collision rates
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_e  = q_h_e(i0_e,levu,levl) + fact_e * (q_h_e(i0_e+1,levu,levl) - q_h_e(i0_e,levu,levl))
          rdo_e = 10.0_dp**r_e
          ! ----------------------------------------------------
          ! conversion from collision strength to collision rate
          ! see document Coll_Strength.pdf (JLB 2013)
          ! ----------------------------------------------------
          rdo_e = rdo_e * 8.62913e-6_dp / (spec_lin(j_sp)%gst(levu) * sqrt(ttry))

          ratdo = rdo_e * ab(nspec)
          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO

END SUBROUTINE COLHAT

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLCAT (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_H, ec_He
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_Hp, ec_e
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_orthoH2
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_paraH2, ec
    REAL (KIND=dp)                          :: xnhmp, xnhmo, auxt4
    INTEGER                                 :: j_sp, jl, ju

    j_sp = in_sp(i_c)

    xnhmp = h2para * ab(i_h2)
    xnhmo = h2orth * ab(i_h2)
    ec_H  = colr_min
    ec_orthoH2 = colr_min
    ec_paraH2  = colr_min
    ec_He = colr_min
    ec_Hp = colr_min
    ec_e  = colr_min

!    a-collisions with H
! Fine structure: probably Launay & Roueff 1977 (check)

    ec_H(1,2) = 1.01e-10_dp * ttry**0.117_dp
    ec_H(1,3) = 4.49e-11_dp * ttry**0.194_dp
    ec_H(2,3) = 1.06e-10_dp * ttry**0.234_dp

! 1D - 3P
! DRF : Do not use O I + H rates

!  b-collisions with H2
! fit from Schroder, Staemmler, Smith, Flower & Jaquet (1991)

    ec_paraH2(1,2)  = 0.80e-10_dp
    ec_orthoH2(1,2) = 0.75e-10_dp
    ec_paraH2(1,3)  = 0.90e-10_dp
    ec_orthoH2(1,3) = 3.54e-11_dp * ttry**0.167_dp
    ec_paraH2(2,3)  = 2.00e-10_dp
    ec_orthoH2(2,3) = 5.25e-11_dp * ttry**0.244_dp

!     c-collisions with He
! Fine structure: Staemmler & Flower (1991)

    ec_He(1,2) = 8.38e-12_dp * ttry**0.159_dp
    ec_He(1,3) = 5.98e-11_dp * ttry**0.078_dp
    ec_He(2,3) = 3.68e-11_dp * ttry**0.041_dp

! collisions with H+
! from AA 236, 515 (1990)  Roueff & Le Bourlot (fit DRF)

    IF (i_hp /= 0) THEN
       ec_Hp(1,2) = 10._dp**(-10.359_dp + 0.7959_dp*LOG10(ttry) - 0.08748_dp*(LOG10(ttry))**2._dp)
       ec_Hp(1,3) = 10._dp**(-13.232_dp + 2.4171_dp*LOG10(ttry) - 0.29151_dp*(LOG10(ttry))**2._dp)
       ec_Hp(2,3) = 10._dp**(-11.290_dp + 1.7915_dp*LOG10(ttry) - 0.23010_dp*(LOG10(ttry))**2._dp)
    ELSE
       ec_Hp = 0.0_dp
    ENDIF

!     d-collisions with electrons
! Should we use Pequignot 1990...
! From Pequignot & Aldrovandi, A&A 50, 141, 1976 as compiled by Mendoza (1983)

    IF (nused >= 4) THEN
       auxt4 = 1.83e-4_dp * ttry ** 0.444_dp
       ec_e(1,4) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(4) * spec_lin(j_sp)%gst(1) / 9.0_dp
       ec_e(2,4) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(4) * spec_lin(j_sp)%gst(2) / 9.0_dp
       ec_e(3,4) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(4) * spec_lin(j_sp)%gst(3) / 9.0_dp
    ENDIF
    IF (nused >= 5) THEN
       auxt4 = 9.86e-5_dp * ttry ** 0.343_dp
       ec_e(1,5) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(5) * spec_lin(j_sp)%gst(1) / 9.0_dp
       ec_e(2,5) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(5) * spec_lin(j_sp)%gst(2) / 9.0_dp
       ec_e(3,5) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(5) * spec_lin(j_sp)%gst(3) / 9.0_dp
       auxt4 = 2.77e-3_dp
       ec_e(4,5) = 8.629e-6_dp *auxt4 / spec_lin(j_sp)%gst(5)
    ENDIF

!  Bring em together

   ec = 0.0_dp
   ec = 0.0_dp
   DO jl = 1, nused-1
      DO ju = jl+1, nused
         ec(jl,ju) = ec_H(jl,ju) * ab(i_h) + ec_Hp(jl,ju) * ab(i_hp) + ec_paraH2(jl,ju) * xnhmp &
                   + ec_orthoH2(jl,ju) * xnhmo + ec_He(jl,ju) * ab(i_he) + ec_e(jl,ju) * ab(nspec)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         ec(ju,jl) = ec(jl,ju) * (spec_lin(j_sp)%gst(ju)/spec_lin(j_sp)%gst(jl)) &
                   * EXPBOR(-(spec_lin(j_sp)%elk(ju)-spec_lin(j_sp)%elk(jl))/ttry)
      ENDDO
   ENDDO

   eqcol = 0.0_dp

   DO jl = 1, nused-1
      DO ju = jl+1, nused
         eqcol(jl,ju) = eqcol(jl,ju) - ec(jl,ju)
         eqcol(ju,ju) = eqcol(ju,ju) + ec(jl,ju)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         eqcol(ju,jl) = eqcol(ju,jl) - ec(ju,jl)
         eqcol(jl,jl) = eqcol(jl,jl) + ec(ju,jl)
      ENDDO
   ENDDO

END SUBROUTINE COLCAT

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLNAT (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_H, ec_He
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_Hp, ec_e
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_orthoH2
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_paraH2, ec
    REAL (KIND=dp)                            :: xnhmp
    REAL (KIND=dp)                            :: xnhmo, auxt4
    INTEGER                                   :: j_sp, jl, ju

    j_sp = in_sp(i_n)

    xnhmp = h2para * ab(i_h2)
    xnhmo = h2orth * ab(i_h2)

    ec_H  = colr_min
    ec_orthoH2 = colr_min
    ec_paraH2  = colr_min
    ec_He = colr_min
    ec_Hp = colr_min
    ec_e  = colr_min

!    collisions with H

!    collisions with H2

!    collisions with He

!    collisions with H+

!    collisions with electrons
!     From compilation of Mendoza (1983)

    IF (nused >= 2) THEN
       auxt4 = 1.5_dp * 7.92e-6_dp * ttry**0.589_dp
       ec_e(1,2) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(2)
    ENDIF
    IF (nused >= 3) THEN
       auxt4 = 7.92e-6_dp * ttry**0.589_dp
       ec_e(1,3) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(3)
       auxt4 = 4.78e-5_dp * ttry**0.431_dp
       ec_e(2,3) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(3)
    ENDIF
    IF (nused >= 4) THEN
       auxt4 = 1.74e-6_dp * ttry**0.621_dp
       ec_e(1,4) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(4)
       auxt4 = 6.82e-5_dp * ttry**0.301_dp
       ec_e(2,4) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(4)
       auxt4 = 1.65e-4_dp * ttry**0.193_dp
       ec_e(3,4) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(4)
    ENDIF
    IF (nused >= 5) THEN
       auxt4 = 2.0_dp * 1.74e-6_dp * ttry**0.621_dp
       ec_e(1,5) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(5)
       auxt4 = 3.59e-4_dp * ttry**0.217_dp
       ec_e(2,5) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(5)
       auxt4 = 1.13e-4_dp * ttry**0.279_dp
       ec_e(3,5) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(5)
       auxt4 = 2.61e-6_dp * ttry**0.609_dp
       ec_e(4,5) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(5)
    ENDIF

!  Bring em together

   ec = 0.0_dp
   DO jl = 1, nused-1
      DO ju = jl+1, nused
         ec(jl,ju) = ec_H(jl,ju) * ab(i_h) + ec_Hp(jl,ju) * ab(i_hp) + ec_paraH2(jl,ju) * xnhmp &
                   + ec_orthoH2(jl,ju) * xnhmo + ec_He(jl,ju) * ab(i_he) + ec_e(jl,ju) * ab(nspec)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         ec(ju,jl) = ec(jl,ju) * (spec_lin(j_sp)%gst(ju)/spec_lin(j_sp)%gst(jl)) &
                   * EXPBOR(-(spec_lin(j_sp)%elk(ju)-spec_lin(j_sp)%elk(jl))/ttry)
      ENDDO
   ENDDO

   eqcol = 0.0_dp

   DO jl = 1, nused-1
      DO ju = jl+1, nused
         eqcol(jl,ju) = eqcol(jl,ju) - ec(jl,ju)
         eqcol(ju,ju) = eqcol(ju,ju) + ec(jl,ju)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         eqcol(ju,jl) = eqcol(ju,jl) - ec(ju,jl)
         eqcol(jl,jl) = eqcol(jl,jl) + ec(ju,jl)
      ENDDO
   ENDDO

END SUBROUTINE COLNAT

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLOAT (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_H, ec_He
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_Hp, ec_e
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_orthoH2
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_paraH2, ec
    REAL (KIND=dp)                            :: xnhmp, toto
    REAL (KIND=dp)                            :: xnhmo, auxt4
    INTEGER                                   :: j_sp, jl, ju

    j_sp = in_sp(i_o)

    xnhmp = h2para * ab(i_h2)
    xnhmo = h2orth * ab(i_h2)

    ec_H  = colr_min
    ec_orthoH2 = colr_min
    ec_paraH2  = colr_min
    ec_He = colr_min
    ec_Hp = colr_min
    ec_e  = colr_min

!    collisions with H
!  New fit from Launay & Roueff

!  ec_H(1,2) = 4.37e-12_dp * ttry**0.66_dp
!  ec_H(1,3) = 1.06e-12_dp * ttry**0.80_dp
!  ec_H(2,3) = 1.35e-11_dp * ttry**0.45_dp

!  fit from Abrahamsson et al  2007, ApJ654, 1171 (done by Evelyne - XII 08)
   ec_H(1,2) = 5.9601e-11_dp * ttry**0.39561_dp
   ec_H(1,3) = 6.1719e-11_dp * ttry**0.36291_dp
   IF (ttry <= 1000.0_dp) THEN
      ec_H(2,3) = (2.5544e-11_dp - 1.232e-14_dp * ttry) * ttry**0.62996_dp
   ELSE
      ec_H(2,3) =  1.063e-9_dp
   ENDIF

! 1D - 3P
! fit by JLB, from datas of Federman & Shipsey, Ap J, 1983, 269, 791 (using potential V2)

   IF (nused >= 4) THEN
      ec_H(1,4) = 9.85e-14_dp * ttry**0.245_dp
      ec_H(2,4) = 9.85e-14_dp * ttry**0.245_dp
      ec_H(3,4) = 9.85e-14_dp * ttry**0.245_dp
   ENDIF

!  collisions with H2
!  fit from Jaquet, Staemmler, Smith & Flower, J.Phys.B (1992)

   ec_paraH2(1,2) = 3.46e-11_dp * ttry**0.316_dp
   ec_orthoH2(1,2) = 2.70e-11_dp * ttry**0.362_dp
   ec_paraH2(1,3) = 7.07e-11_dp * ttry**0.268_dp
   ec_orthoH2(1,3) = 5.49e-11_dp * ttry**0.317_dp
   ec_paraH2(2,3) = 1.44e-14_dp * ttry**1.109_dp
   ec_orthoH2(2,3) = 4.64e-14_dp * ttry**0.976_dp

!     collisions with He
! fit from Monteiro & Flower, MNRAS 228, 101 (1987)

   ec_He(1,2) = 1.55e-12_dp * ttry**0.694_dp
   ec_He(1,3) = 2.52e-12_dp * ttry**0.681_dp
   ec_He(2,3) = 2.00e-15_dp * ttry**1.428_dp

!    collisions with H+
! Pequignot A&A 231, 499 (1990) + erratum A&A 313, 1026 (1996)

    IF (i_hp /= 0) THEN
       IF (ttry < 194.664_dp) THEN
          toto = 1.40e-3_dp * (ttry*1.0e-2_dp)**0.90_dp
       ELSE IF (ttry < 3686.2414_dp) THEN
          toto = 2.14e-2_dp * (ttry*1.0e-3_dp)**1.30_dp
       ELSE
          toto = 2.78e-1_dp * (ttry*1.0e-4_dp)**0.87_dp
       ENDIF
       ec_HP(1,2) = toto * 8.629e-6_dp / (SQRT(ttry) * spec_lin(j_sp)%gst(2))

       IF (ttry < 511.9563_dp) THEN
          toto = 1.12e-4_dp * (ttry*1.0e-2_dp)**1.60_dp
       ELSE IF (ttry < 7510.155_dp) THEN
          toto = 3.90e-3_dp * (ttry*1.0e-3_dp)**1.40_dp
       ELSE
          toto = 8.25e-2_dp * (ttry*1.0e-4_dp)**0.80_dp
       ENDIF
       ec_Hp(1,3) = toto * 8.629e-6_dp / SQRT(ttry)

       IF (ttry < 2090.2558_dp) THEN
          toto = 3.10e-4_dp * (ttry*1.0e-2_dp)**1.06_dp
       ELSE
          toto = 2.29e-2_dp * (ttry*1.0e-4_dp)**0.69_dp
       ENDIF
       ec_Hp(2,3) = toto * 8.629e-6_dp / SQRT(ttry)
    ELSE
       ec_Hp = 0.0_dp
    ENDIF

!     d-collisions with electrons
!      From Pequignot, 1990, A&A, 231, 499 and Berrington, 1998, MNRAS, 293, L83

   IF (nused >= 4) THEN
      auxt4 = 4.28e-1_dp * (ttry/1.e4_dp) ** 1.43_dp / (1.00_dp + 6.05e-1_dp * (ttry/1.e4_dp) ** 1.105_dp)
      ec_e(1,4) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(4) / SQRT(ttry) * spec_lin(j_sp)%gst(1) / 9.0_dp
      ec_e(2,4) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(4) / SQRT(ttry) * spec_lin(j_sp)%gst(2) / 9.0_dp
      ec_e(3,4) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(4) / SQRT(ttry) * spec_lin(j_sp)%gst(3) / 9.0_dp
   ENDIF
   IF (nused >= 5) THEN
      auxt4 = 5.88e-2_dp * (ttry/1.e4_dp) ** 1.50_dp / (1.00_dp + 8.00e-1_dp * (ttry/1.e4_dp) ** 1.125_dp)
      ec_e(1,5) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(5) / SQRT(ttry) * spec_lin(j_sp)%gst(1) / 9.0_dp
      ec_e(2,5) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(5) / SQRT(ttry) * spec_lin(j_sp)%gst(2) / 9.0_dp
      ec_e(3,5) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(5) / SQRT(ttry) * spec_lin(j_sp)%gst(3) / 9.0_dp
      auxt4 = 1.16e-1_dp * (ttry/1.e4_dp) ** 0.53_dp / (1.00_dp + 1.11e-1_dp * (ttry/1.e4_dp) ** 0.160_dp)
      ec_e(4,5) = 8.629e-6_dp *auxt4 / spec_lin(j_sp)%gst(5) / SQRT(ttry)
   ENDIF

   auxt4 = 1.49e-4_dp * ttry ** 0.4565_dp
   ec_e(1,2) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(2) / SQRT(ttry)
   auxt4 = 4.98e-5_dp * ttry ** 0.4955_dp
   ec_e(1,3) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(3) / SQRT(ttry)
   auxt4 = 1.83e-9_dp * ttry ** 1.347_dp
   ec_e(2,3) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(3) / SQRT(ttry)

!  Bring em together

   ec = 0.0_dp
   DO jl = 1, nused-1
      DO ju = jl+1, nused
         ec(jl,ju) = ec_H(jl,ju) * ab(i_h) + ec_Hp(jl,ju) * ab(i_hp) + ec_paraH2(jl,ju) * xnhmp &
                   + ec_orthoH2(jl,ju) * xnhmo + ec_He(jl,ju) * ab(i_he) + ec_e(jl,ju) * ab(nspec)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         ec(ju,jl) = ec(jl,ju) * (spec_lin(j_sp)%gst(ju)/spec_lin(j_sp)%gst(jl)) &
                   * EXPBOR(-(spec_lin(j_sp)%elk(ju)-spec_lin(j_sp)%elk(jl))/ttry)
      ENDDO
   ENDDO

   eqcol = 0.0_dp

   DO jl = 1, nused-1
      DO ju = jl+1, nused
         eqcol(jl,ju) = eqcol(jl,ju) - ec(jl,ju)
         eqcol(ju,ju) = eqcol(ju,ju) + ec(jl,ju)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         eqcol(ju,jl) = eqcol(ju,jl) - ec(ju,jl)
         eqcol(jl,jl) = eqcol(jl,jl) + ec(ju,jl)
      ENDDO
   ENDDO

END SUBROUTINE COLOAT

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLSAT (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_H, ec_He
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_Hp, ec_e
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_orthoH2
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_paraH2, ec
    REAL (KIND=dp)                            :: xnhmp
    REAL (KIND=dp)                            :: xnhmo, auxt4
    INTEGER                                   :: j_sp, jl, ju

    j_sp = in_sp(i_s)

    xnhmp = h2para * ab(i_h2)
    xnhmo = h2orth * ab(i_h2)

    ec_H  = colr_min
    ec_orthoH2 = colr_min
    ec_paraH2  = colr_min
    ec_He = colr_min
    ec_Hp = colr_min
    ec_e  = colr_min

! All collision rates as for O, but CT with H is excluded, as it is non-resonant

!    collisions with H

!  As O: fit from Abrahamsson et al  2007, ApJ654, 1171 (done by Evelyne - XII 08)
    ec_H(1,2) = 5.9601e-11_dp * ttry**0.39561_dp
    IF (nused >= 3) THEN
       ec_H(1,3) = 6.1719e-11_dp * ttry**0.36291_dp
       IF (ttry <= 1000.0_dp) THEN
          ec_H(2,3) = (2.5544e-11_dp - 1.232e-14_dp * ttry) * ttry**0.62996_dp
       ELSE
          ec_H(2,3) =  1.063e-9_dp
       ENDIF
    ENDIF

!    collisions with H2
!    fit from Jaquet, Staemmler, Smith & Flower, J.Phys.B (1991)

    ec_paraH2(1,2) = 3.46e-11_dp * ttry**0.316_dp
    ec_orthoH2(1,2) = 2.70e-11_dp * ttry**0.362_dp
    IF (nused >= 3) THEN
       ec_paraH2(1,3) = 7.07e-11_dp * ttry**0.268_dp
       ec_orthoH2(1,3) = 5.49e-11_dp * ttry**0.317_dp
       ec_paraH2(2,3) = 1.44e-14_dp * ttry**1.109_dp
       ec_orthoH2(2,3) = 4.64e-14_dp * ttry**0.976_dp
    ENDIF

!    collisions with He
!    fit from Monteiro & Flower, MNRAS 228, 101 (1987)

    ec_He(1,2) = 1.55e-12_dp * ttry**0.694_dp
    IF (nused >= 3) THEN
       ec_He(1,3) = 2.52e-12_dp * ttry**0.681_dp
       ec_He(2,3) = 2.00e-15_dp * ttry**1.428_dp
    ENDIF

!    collisions with H+
! guess (Evelyne)

    IF (i_hp /= 0) THEN
       ec_Hp(1,2) = 1.0e-8_dp
       IF (nused >= 3) THEN
          ec_Hp(1,3) = 1.0e-8_dp
          ec_Hp(2,3) = 1.0e-8_dp
       ENDIF
    ELSE
       ec_Hp = 0.0_dp
    ENDIF

!    collisions with electrons
!    From Pequignot, 1990, A&A, 231, 499 and Berrington, 1998, MNRAS, 293, L83

    IF (nused >= 4) THEN
       auxt4 = 4.28e-1_dp * (ttry/1.e4_dp) ** 1.43_dp / (1.00_dp + 6.05e-1_dp * (ttry/1.e4_dp) ** 1.105_dp)
       ec_e(1,4) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(4) / SQRT(ttry) * spec_lin(j_sp)%gst(1) / 9.0_dp
       ec_e(2,4) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(4) / SQRT(ttry) * spec_lin(j_sp)%gst(2) / 9.0_dp
       ec_e(3,4) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(4) / SQRT(ttry) * spec_lin(j_sp)%gst(3) / 9.0_dp
    ENDIF
    IF (nused >= 5) THEN
       auxt4 = 5.88e-2_dp * (ttry/1.e4_dp) ** 1.50_dp / (1.00_dp + 8.00e-1_dp * (ttry/1.e4_dp) ** 1.125_dp)
       ec_e(1,5) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(5) / SQRT(ttry) * spec_lin(j_sp)%gst(1) / 9.0_dp
       ec_e(2,5) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(5) / SQRT(ttry) * spec_lin(j_sp)%gst(2) / 9.0_dp
       ec_e(3,5) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(5) / SQRT(ttry) * spec_lin(j_sp)%gst(3) / 9.0_dp
       auxt4 = 1.16e-1_dp * (ttry/1.e4_dp) ** 0.53_dp / (1.00_dp + 1.11e-1_dp * (ttry/1.e4_dp) ** 0.160_dp)
       ec_e(4,5) = 8.629e-6_dp *auxt4 / spec_lin(j_sp)%gst(5) / SQRT(ttry)
    ENDIF

    auxt4 = 1.49e-4_dp * ttry ** 0.4565_dp
    ec_e(1,2) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(2) / SQRT(ttry)
    IF (nused >= 3) THEN
       auxt4 = 4.98e-5_dp * ttry ** 0.4955_dp
       ec_e(1,3) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(3) / SQRT(ttry)
       auxt4 = 1.83e-9_dp * ttry ** 1.347_dp
       ec_e(2,3) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(3) / SQRT(ttry)
    ENDIF

!  Bring em together

   ec = 0.0_dp
   DO jl = 1, nused-1
      DO ju = jl+1, nused
         ec(jl,ju) = ec_H(jl,ju) * ab(i_h) + ec_Hp(jl,ju) * ab(i_hp) + ec_paraH2(jl,ju) * xnhmp &
                   + ec_orthoH2(jl,ju) * xnhmo + ec_He(jl,ju) * ab(i_he) + ec_e(jl,ju) * ab(nspec)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         ec(ju,jl) = ec(jl,ju) * (spec_lin(j_sp)%gst(ju)/spec_lin(j_sp)%gst(jl)) &
                   * EXPBOR(-(spec_lin(j_sp)%elk(ju)-spec_lin(j_sp)%elk(jl))/ttry)
      ENDDO
   ENDDO

   eqcol = 0.0_dp

   DO jl = 1, nused-1
      DO ju = jl+1, nused
         eqcol(jl,ju) = eqcol(jl,ju) - ec(jl,ju)
         eqcol(ju,ju) = eqcol(ju,ju) + ec(jl,ju)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         eqcol(ju,jl) = eqcol(ju,jl) - ec(ju,jl)
         eqcol(jl,jl) = eqcol(jl,jl) + ec(ju,jl)
      ENDDO
   ENDDO

END SUBROUTINE COLSAT

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLSIAT (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_H, ec_He
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_Hp, ec_e
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_orthoH2
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_paraH2, ec
    REAL (KIND=dp)                            :: xnhmp
    REAL (KIND=dp)                            :: xnhmo, auxt4
    INTEGER                                   :: j_sp, jl, ju

    j_sp = in_sp(i_si)

    xnhmp = h2para * ab(i_h2)
    xnhmo = h2orth * ab(i_h2)

    ec_H  = colr_min
    ec_orthoH2 = colr_min
    ec_paraH2  = colr_min
    ec_He = colr_min
    ec_Hp = colr_min
    ec_e  = colr_min

! All collision rates as for C

!    collisions with H
!    Fine structure: Launay & Roueff, 1977, A&A, 56, 289

    ec_H(1,2) = 1.01e-10_dp * ttry**0.117_dp
    ec_H(1,3) = 4.49e-11_dp * ttry**0.194_dp
    ec_H(2,3) = 1.06e-10_dp * ttry**0.234_dp

!    collisions with H2
!    fit from Schroder, Staemmler, Smith, Flower & Jaquet (1991)

    ec_paraH2(1,2) = 0.80e-10_dp
    ec_orthoH2(1,2)= 0.75e-10_dp
    ec_paraH2(1,3) = 0.90e-10_dp
    ec_orthoH2(1,3)= 3.54e-11_dp * ttry**0.167_dp
    ec_paraH2(2,3) = 2.00e-10_dp
    ec_orthoH2(2,3)= 5.25e-11_dp * ttry**0.244_dp

!    collisions with He
!    Fine structure: Staemmler & Flower (1991)

    ec_He(1,2) = 8.38e-12_dp * ttry**0.159_dp
    ec_He(1,3) = 5.98e-11_dp * ttry**0.078_dp
    ec_He(2,3) = 3.68e-11_dp * ttry**0.041_dp

!    collisions with H+

    IF (i_hp /= 0) THEN
       ec_Hp(1,2) = 10._dp**(-10.359_dp + 0.7959_dp*LOG10(ttry) - 0.08748_dp*(LOG10(ttry))**2._dp)
       ec_Hp(1,3) = 10._dp**(-13.232_dp + 2.4171_dp*LOG10(ttry) - 0.29151_dp*(LOG10(ttry))**2._dp)
       ec_Hp(2,3) = 10._dp**(-11.290_dp + 1.7915_dp*LOG10(ttry) - 0.23010_dp*(LOG10(ttry))**2._dp)
    ELSE
       ec_Hp = 0.0_dp
    ENDIF

!    collisions with electrons
!    From Pequignot & Aldrovandi, A&A 50, 141, 1976 as compiled by Mendoza (1983)

    IF (nused >= 4) THEN
       auxt4 = 1.83e-4_dp * ttry ** 0.444_dp
       ec_e(1,4) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(4) * spec_lin(j_sp)%gst(1) / 9.0_dp
       ec_e(2,4) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(4) * spec_lin(j_sp)%gst(2) / 9.0_dp
       ec_e(3,4) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(4) * spec_lin(j_sp)%gst(3) / 9.0_dp
       auxt4 = 9.86e-5_dp * ttry ** 0.343_dp
    ENDIF
    IF (nused >= 5) THEN
       ec_e(1,5) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(5) * spec_lin(j_sp)%gst(1) / 9.0_dp
       ec_e(2,5) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(5) * spec_lin(j_sp)%gst(2) / 9.0_dp
       ec_e(3,5) = 8.629e-6_dp * auxt4 / spec_lin(j_sp)%gst(5) * spec_lin(j_sp)%gst(3) / 9.0_dp
       auxt4 = 2.77e-3_dp
       ec_e(4,5) = 8.629e-6_dp *auxt4 / spec_lin(j_sp)%gst(5)
    ENDIF

!  Bring em together

   ec = 0.0_dp
   DO jl = 1, nused-1
      DO ju = jl+1, nused
         ec(jl,ju) = ec_H(jl,ju) * ab(i_h) + ec_Hp(jl,ju) * ab(i_hp) + ec_paraH2(jl,ju) * xnhmp &
                   + ec_orthoH2(jl,ju) * xnhmo + ec_He(jl,ju) * ab(i_he) + ec_e(jl,ju) * ab(nspec)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         ec(ju,jl) = ec(jl,ju) * (spec_lin(j_sp)%gst(ju)/spec_lin(j_sp)%gst(jl)) &
                   * EXPBOR(-(spec_lin(j_sp)%elk(ju)-spec_lin(j_sp)%elk(jl))/ttry)
      ENDDO
   ENDDO

   eqcol = 0.0_dp

   DO jl = 1, nused-1
      DO ju = jl+1, nused
         eqcol(jl,ju) = eqcol(jl,ju) - ec(jl,ju)
         eqcol(ju,ju) = eqcol(ju,ju) + ec(jl,ju)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         eqcol(ju,jl) = eqcol(ju,jl) - ec(ju,jl)
         eqcol(jl,jl) = eqcol(jl,jl) + ec(ju,jl)
      ENDDO
   ENDDO

END SUBROUTINE COLSIAT

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLCPL (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_H, ec_He
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_Hp, ec_e
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_orthoH2
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_paraH2, ec
    REAL (KIND=dp)                            :: xnhmp
    REAL (KIND=dp)                            :: xnhmo, toto
    INTEGER                                   :: j_sp, jl, ju

    j_sp = in_sp(i_cp)

    xnhmp = h2para * ab(i_h2)
    xnhmo = h2orth * ab(i_h2)

    ec_H  = colr_min
    ec_orthoH2 = colr_min
    ec_paraH2  = colr_min
    ec_He = colr_min
    ec_Hp = colr_min
    ec_e  = colr_min

!    a-collisions with H

    ec_H(1,2) = 8.86e-10_dp

!  b-collisions with H2

    ec_paraH2(1,2) = 3.94e-10_dp
    ec_orthoH2(1,2) = 4.92e-10_dp

!     c-collisions with electrons

! k21 : Hayes & Nussbaumer, 1984, A&A 134, 193
! Dec 02, CM & DRF
! k21 changed to power law fit to Wilson & Bell, 2002, MNRAS, 337, 1027
! other : Lennon et al., 1985, Ap J 294, 200

    toto = 0.65582_dp * ttry**(0.13244_dp)
    ec_e(1,2) = 8.629e-6_dp * MIN(toto,2.5_dp) / (4.0_dp*SQRT(ttry))
    IF (nused >= 3) THEN
       ec_e(1,3) = 8.629e-6_dp * (0.288_dp - 5.89e-7_dp*ttry) / (2.0_dp * SQRT(ttry))
       ec_e(2,3) = 8.629e-6_dp * (0.197_dp - 3.15e-7_dp*ttry) / (2.0_dp * SQRT(ttry))
    ENDIF
    IF (nused >= 4) THEN
       ec_e(1,4) = 8.629e-6_dp * (0.424_dp - 8.35e-7_dp*ttry) / (4.0_dp * SQRT(ttry))
       ec_e(2,4) = 8.629e-6_dp * (0.544_dp - 9.84e-7_dp*ttry) / (4.0_dp * SQRT(ttry))
    ENDIF
    IF (nused >= 5) THEN
       ec_e(1,5) = 8.629e-6_dp * (0.257_dp - 3.95e-7_dp*ttry) / (6.0_dp * SQRT(ttry))
       ec_e(2,5) = 8.629e-6_dp * (1.200_dp - 2.40e-6_dp*ttry) / (6.0_dp * SQRT(ttry))
    ENDIF

!  Bring em together

   ec = 0.0_dp
   DO jl = 1, nused-1
      DO ju = jl+1, nused
         ec(jl,ju) = ec_H(jl,ju) * ab(i_h) + ec_Hp(jl,ju) * ab(i_hp) + ec_paraH2(jl,ju) * xnhmp &
                   + ec_orthoH2(jl,ju) * xnhmo + ec_He(jl,ju) * ab(i_he) + ec_e(jl,ju) * ab(nspec)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         ec(ju,jl) = ec(jl,ju) * (spec_lin(j_sp)%gst(ju)/spec_lin(j_sp)%gst(jl)) &
                   * EXPBOR(-(spec_lin(j_sp)%elk(ju)-spec_lin(j_sp)%elk(jl))/ttry)
      ENDDO
   ENDDO

   eqcol = 0.0_dp

   DO jl = 1, nused-1
      DO ju = jl+1, nused
         eqcol(jl,ju) = eqcol(jl,ju) - ec(jl,ju)
         eqcol(ju,ju) = eqcol(ju,ju) + ec(jl,ju)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         eqcol(ju,jl) = eqcol(ju,jl) - ec(ju,jl)
         eqcol(jl,jl) = eqcol(jl,jl) + ec(ju,jl)
      ENDDO
   ENDDO

END SUBROUTINE COLCPL

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLCPP (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!---------------------------------------------------------------------
!       ttry  :temperature du gaz
!---------------------------------------------------------------------

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    INTEGER                                 :: levl, levu
    INTEGER                                 :: i, j_sp
    REAL (KIND=dp)                          :: fact_e
    REAL (KIND=dp)                          :: delten, logttry
    REAL (KIND=dp)                          :: r_e
    REAL (KIND=dp)                          :: rdo_e
    REAL (KIND=dp)                          :: ratdo, ratup

    j_sp = in_sp(i_cpp)
    logttry = LOG10(ttry)

    !--- Find the temperature point in C++ collisions with electrons
    IF (logttry <= tempccpp_e(1)) THEN
       i0_e = 1
    ELSE IF (logttry >= tempccpp_e(nttcpp_e)) THEN
       i0_e = nttcpp_e
    ELSE
       DO i = 2, nttcpp_e
          IF (logttry <= tempccpp_e(i)) THEN
             i0_e = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact_e = (tempccpp_e(i0_e) - logttry) / (tempccpp_e(i0_e) - tempccpp_e(i0_e+1))

    eqcol = 0.0_dp

    ! ----------------------------------------------------------------
    ! notes : given the behaviors of the C++ collision rates, we make
    !         *** a linear (log-log scale) extrapolation for T<Tmin
    !         *** a constant extrapolation for T>Tmax
    ! ----------------------------------------------------------------
    !--- Compute collision rates
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_e  = q_cpp_e(i0_e,levu,levl) + fact_e * (q_cpp_e(i0_e+1,levu,levl) - q_cpp_e(i0_e,levu,levl))
          rdo_e = 10.0_dp**r_e
          ! ----------------------------------------------------
          ! conversion from collision strength to collision rate
          ! see document Coll_Strength.pdf (JLB 2013)
          ! ----------------------------------------------------
          rdo_e = rdo_e * 8.62913e-6_dp / (spec_lin(j_sp)%gst(levu) * sqrt(ttry))

          ratdo = rdo_e * ab(nspec)
          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO

END SUBROUTINE COLCPP

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLNPL (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_H, ec_He
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_Hp, ec_e
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_orthoH2
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_paraH2, ec
    REAL (KIND=dp)                            :: xnhmp
    REAL (KIND=dp)                            :: xnhmo
    INTEGER                                   :: j_sp, jl, ju

    j_sp = in_sp(i_np)

    xnhmp = h2para * ab(i_h2)
    xnhmo = h2orth * ab(i_h2)

    ec_H  = colr_min
    ec_orthoH2 = colr_min
    ec_paraH2  = colr_min
    ec_He = colr_min
    ec_Hp = colr_min
    ec_e  = colr_min

!    collisions with H

!    collisions with H2

!    collisions with electrons
! Mendoza, 1983, International astrophysical union, symposium 103
! JLB 21 XI 2016 - correct an error in the statistical weights for nused = 5, spotted by David Flower
! Weight is 1 for a Singlet state (and not 2 as incorrectly done before)

    ec_e(1,2) =  8.629e-6_dp * (0.138_dp * ttry**0.119_dp) / (3.0_dp * SQRT(ttry))
    ec_e(1,3) =  8.629e-6_dp * (0.0834_dp * ttry**0.130_dp) / (5.0_dp * SQRT(ttry))
    ec_e(2,3) =  8.629e-6_dp * (0.359_dp * ttry**0.125_dp) / (5.0_dp * SQRT(ttry))
    IF (nused >= 4) THEN
       ec_e(1,4) =  8.629e-6_dp * (0.203_dp * ttry**0.0414_dp) / (5.0_dp * SQRT(ttry))
       ec_e(2,4) =  8.629e-6_dp * (0.609_dp * ttry**0.0414_dp) / (5.0_dp * SQRT(ttry))
       ec_e(3,4) =  8.629e-6_dp * (1.02_dp * ttry**0.0414_dp) / (5.0_dp * SQRT(ttry))
    ENDIF
    IF (nused >= 5) THEN
       ec_e(4,5) =  8.629e-6_dp * (3.14_dp * ttry**(-0.142_dp)) / (1.0_dp * SQRT(ttry))
       ec_e(3,5) =  8.629e-6_dp * (0.158_dp + ttry*4.26e-7_dp) / (1.0_dp * SQRT(ttry))
       ec_e(2,5) =  8.629e-6_dp * (0.0949_dp + ttry*2.56e-7_dp) / (1.0_dp * SQRT(ttry))
       ec_e(1,5) =  8.629e-6_dp * (0.0316_dp + ttry*8.52e-8_dp) / (1.0_dp * SQRT(ttry))
    ENDIF

!  Bring em together

   ec = 0.0_dp
   DO jl = 1, nused-1
      DO ju = jl+1, nused
         ec(jl,ju) = ec_H(jl,ju) * ab(i_h) + ec_Hp(jl,ju) * ab(i_hp) + ec_paraH2(jl,ju) * xnhmp &
                   + ec_orthoH2(jl,ju) * xnhmo + ec_He(jl,ju) * ab(i_he) + ec_e(jl,ju) * ab(nspec)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         ec(ju,jl) = ec(jl,ju) * (spec_lin(j_sp)%gst(ju)/spec_lin(j_sp)%gst(jl)) &
                   * EXPBOR(-(spec_lin(j_sp)%elk(ju)-spec_lin(j_sp)%elk(jl))/ttry)
      ENDDO
   ENDDO

   eqcol = 0.0_dp

   DO jl = 1, nused-1
      DO ju = jl+1, nused
         eqcol(jl,ju) = eqcol(jl,ju) - ec(jl,ju)
         eqcol(ju,ju) = eqcol(ju,ju) + ec(jl,ju)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         eqcol(ju,jl) = eqcol(ju,jl) - ec(ju,jl)
         eqcol(jl,jl) = eqcol(jl,jl) + ec(ju,jl)
      ENDDO
   ENDDO

END SUBROUTINE COLNPL

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLNPP (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!---------------------------------------------------------------------
!       ttry  :temperature du gaz
!---------------------------------------------------------------------

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    INTEGER                                 :: levl, levu
    INTEGER                                 :: i, j_sp
    REAL (KIND=dp)                          :: fact_e
    REAL (KIND=dp)                          :: delten, logttry
    REAL (KIND=dp)                          :: r_e
    REAL (KIND=dp)                          :: rdo_e
    REAL (KIND=dp)                          :: ratdo, ratup

    j_sp = in_sp(i_npp)
    logttry = LOG10(ttry)

    !--- Find the temperature point in Ne++ collisions with electrons
    IF (logttry <= tempcnpp_e(1)) THEN
       i0_e = 1
    ELSE IF (logttry >= tempcnpp_e(nttnpp_e)) THEN
       i0_e = nttnpp_e
    ELSE
       DO i = 2, nttnpp_e
          IF (logttry <= tempcnpp_e(i)) THEN
             i0_e = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact_e = (tempcnpp_e(i0_e) - logttry) / (tempcnpp_e(i0_e) - tempcnpp_e(i0_e+1))

    eqcol = 0.0_dp

    ! ----------------------------------------------------------------
    ! notes : given the behaviors of the N++ collision rates, we make
    !         *** a linear (log-log scale) extrapolation for T<Tmin
    !         *** a constant extrapolation for T>Tmax
    ! ----------------------------------------------------------------
    !--- Compute collision rates
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_e  = q_npp_e(i0_e,levu,levl) + fact_e * (q_npp_e(i0_e+1,levu,levl) - q_npp_e(i0_e,levu,levl))
          rdo_e = 10.0_dp**r_e
          ! ----------------------------------------------------
          ! conversion from collision strength to collision rate
          ! see document Coll_Strength.pdf (JLB 2013)
          ! ----------------------------------------------------
          rdo_e = rdo_e * 8.62913e-6_dp / (spec_lin(j_sp)%gst(levu) * sqrt(ttry))

          ratdo = rdo_e * ab(nspec)
          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO

END SUBROUTINE COLNPP

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLOPL (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_H, ec_He
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_Hp, ec_e
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_orthoH2
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_paraH2, ec
    REAL (KIND=dp)                            :: xnhmp
    REAL (KIND=dp)                            :: xnhmo
    INTEGER                                   :: j_sp, jl, ju

    j_sp = in_sp(i_op)

    xnhmp = h2para * ab(i_h2)
    xnhmo = h2orth * ab(i_h2)

    ec_H  = colr_min
    ec_orthoH2 = colr_min
    ec_paraH2  = colr_min
    ec_He = colr_min
    ec_Hp = colr_min
    ec_e  = colr_min

!    collisions with H

!    collisions with H2

!    collisions with electrons

!  Bring em together

   ec = 0.0_dp
   DO jl = 1, nused-1
      DO ju = jl+1, nused
         ec(jl,ju) = ec_H(jl,ju) * ab(i_h) + ec_Hp(jl,ju) * ab(i_hp) + ec_paraH2(jl,ju) * xnhmp &
                   + ec_orthoH2(jl,ju) * xnhmo + ec_He(jl,ju) * ab(i_he) + ec_e(jl,ju) * ab(nspec)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         ec(ju,jl) = ec(jl,ju) * (spec_lin(j_sp)%gst(ju)/spec_lin(j_sp)%gst(jl)) &
                   * EXPBOR(-(spec_lin(j_sp)%elk(ju)-spec_lin(j_sp)%elk(jl))/ttry)
      ENDDO
   ENDDO

   eqcol = 0.0_dp

   DO jl = 1, nused-1
      DO ju = jl+1, nused
         eqcol(jl,ju) = eqcol(jl,ju) - ec(jl,ju)
         eqcol(ju,ju) = eqcol(ju,ju) + ec(jl,ju)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         eqcol(ju,jl) = eqcol(ju,jl) - ec(ju,jl)
         eqcol(jl,jl) = eqcol(jl,jl) + ec(ju,jl)
      ENDDO
   ENDDO

END SUBROUTINE COLOPL

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLOPP (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    REAL (KIND=dp), DIMENSION (5,5)         :: a1, b1, c1  ! fit to coll strength
    ! Fit done by JLB - 19 / VI / 2013
    ! From Palay et al., MNRAS, 423, L35 (2012)
    DATA a1 /        0.0_dp,        0.0_dp,       0.0_dp,       0.0_dp, 0.0_dp &
            ,  0.0678898_dp,        0.0_dp,       0.0_dp,       0.0_dp, 0.0_dp &
            ,  0.0281121_dp,   0.107159_dp,       0.0_dp,       0.0_dp, 0.0_dp &
            ,  0.0278453_dp,  0.0840328_dp,  0.140995_dp,       0.0_dp, 0.0_dp &
            , 0.00440574_dp,  0.0109864_dp, 0.0176459_dp,  0.064396_dp, 0.0_dp /
    DATA b1 /        0.0_dp,        0.0_dp,       0.0_dp,       0.0_dp, 0.0_dp &
            ,  -0.419838_dp,        0.0_dp,       0.0_dp,       0.0_dp, 0.0_dp &
            ,  -0.137834_dp,  -0.500477_dp,       0.0_dp,       0.0_dp, 0.0_dp &
            ,  -0.130833_dp,  -0.395357_dp, -0.663841_dp,       0.0_dp, 0.0_dp &
            , -0.0354237_dp, -0.0921735_dp, -0.144678_dp, -0.313394_dp, 0.0_dp /
    DATA c1 /       0.0_dp,         0.0_dp,       0.0_dp,       0.0_dp, 0.0_dp &
            ,   1.14439_dp,         0.0_dp,       0.0_dp,       0.0_dp, 0.0_dp &
            ,  0.379641_dp,     1.60642_dp,       0.0_dp,       0.0_dp, 0.0_dp &
            ,  0.351075_dp,      1.0595_dp,   1.78113_dp,       0.0_dp, 0.0_dp &
            ,  0.113449_dp,    0.320983_dp,  0.510188_dp,  0.758875_dp, 0.0_dp /

    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_e, ec
    REAL (KIND=dp)                          :: l10t, sq_t
    INTEGER                                 :: j_sp, jl, ju

    j_sp = in_sp(i_opp)

    ec_e  = colr_min
    sq_t = SQRT(ttry)
    l10t = LOG10(ttry)
    l10t = MAX(1.0_dp, MIN(l10t,5.0_dp))

!    collisions with electrons

   DO ju = 2, nused
      DO jl=1,ju-1
         ec_e(jl,ju) = ((a1(jl,ju) * l10t + b1(jl,ju)) * l10t + c1(jl,ju)) / spec_lin(j_sp)%gst(ju)
      ENDDO
   ENDDO
   ec_e = ec_e / sq_t

!  Bring em together

   ec = 0.0_dp
   DO jl = 1, nused-1
      DO ju = jl+1, nused
         ec(jl,ju) = ec_e(jl,ju) * ab(nspec)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         ec(ju,jl) = ec(jl,ju) * (spec_lin(j_sp)%gst(ju)/spec_lin(j_sp)%gst(jl)) &
                   * EXPBOR(-(spec_lin(j_sp)%elk(ju)-spec_lin(j_sp)%elk(jl))/ttry)
      ENDDO
   ENDDO

   eqcol = 0.0_dp

   DO jl = 1, nused-1
      DO ju = jl+1, nused
         eqcol(jl,ju) = eqcol(jl,ju) - ec(jl,ju)
         eqcol(ju,ju) = eqcol(ju,ju) + ec(jl,ju)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         eqcol(ju,jl) = eqcol(ju,jl) - ec(ju,jl)
         eqcol(jl,jl) = eqcol(jl,jl) + ec(ju,jl)
      ENDDO
   ENDDO

END SUBROUTINE COLOPP

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLSPL (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_H, ec_He
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_Hp, ec_e
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_orthoH2
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_paraH2, ec
    REAL (KIND=dp)                            :: xnhmp
    REAL (KIND=dp)                            :: xnhmo, tt4
    INTEGER                                   :: j_sp, jl, ju

    j_sp = in_sp(i_sp)

    xnhmp = h2para * ab(i_h2)
    xnhmo = h2orth * ab(i_h2)

    ec_H  = colr_min
    ec_orthoH2 = colr_min
    ec_paraH2  = colr_min
    ec_He = colr_min
    ec_Hp = colr_min
    ec_e  = colr_min

!    a-collisions with H
! Storzer and Hollenbach, Ap J 539, 751 (2000) (guess)

   IF (nused >= 2) THEN
      ec_H(1,2) = 1.0e-12_dp
   ENDIF
   IF (nused >= 3) THEN
      ec_H(1,3) = 1.0e-12_dp
      ec_H(2,3) = 1.0e-12_dp
   ENDIF
   IF (nused >= 4) THEN
      ec_H(1,4) = 1.0e-12_dp
      ec_H(2,4) = 1.0e-12_dp
      ec_H(3,4) = 1.0e-12_dp
   ENDIF
   IF (nused >= 5) THEN
      ec_H(1,5) = 1.0e-12_dp
      ec_H(2,5) = 1.0e-12_dp
      ec_H(3,5) = 1.0e-12_dp
      ec_H(4,5) = 1.0e-12_dp
   ENDIF

!  b-collisions with H2

!     c-collisions with electrons

! Mendoza, 1983, International astrophysical union, symposium 103

!      ec_e(1,2) =  8.629e-6_dp * (6.4739_dp * ttry**(-0.092663_dp))
!    1           / (4.0_dp * SQRT(ttry))
!      ec_e(1,3) =  8.629e-6_dp * (9.7526_dp * ttry**(-0.093125_dp))
!    1           / (6.0_dp * SQRT(ttry))

! Storzer and Hollenbach, Ap J 539, 751 (2000)

   tt4 = ttry * 1.0e-4_dp
   IF (nused >= 2) THEN
      ec_e(1,2) = 6.0e-8_dp * tt4**(-0.6_dp)
   ENDIF
   IF (nused >= 3) THEN
      ec_e(1,3) = 6.0e-8_dp * tt4**(-0.6_dp)
      ec_e(2,3) = 1.1e-7_dp * tt4**(-0.6_dp)
   ENDIF
   IF (nused >= 4) THEN
      ec_e(1,4) = 5.0e-8_dp * tt4**(-0.6_dp)
      ec_e(2,4) = 7.7e-8_dp * tt4**(-0.6_dp)
      ec_e(3,4) = 9.5e-8_dp * tt4**(-0.6_dp)
   ENDIF
   IF (nused >= 5) THEN
      ec_e(1,5) = 5.1e-8_dp * tt4**(-0.6_dp)
      ec_e(2,5) = 6.5e-8_dp * tt4**(-0.6_dp)
      ec_e(3,5) = 1.1e-7_dp * tt4**(-0.6_dp)
      ec_e(4,5) = 5.8e-8_dp * tt4**(-0.6_dp)
   ENDIF

!  Bring em together

   ec = 0.0_dp
   DO jl = 1, nused-1
      DO ju = jl+1, nused
         ec(jl,ju) = ec_H(jl,ju) * ab(i_h) + ec_Hp(jl,ju) * ab(i_hp) + ec_paraH2(jl,ju) * xnhmp &
                   + ec_orthoH2(jl,ju) * xnhmo + ec_He(jl,ju) * ab(i_he) + ec_e(jl,ju) * ab(nspec)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         ec(ju,jl) = ec(jl,ju) * (spec_lin(j_sp)%gst(ju)/spec_lin(j_sp)%gst(jl)) &
                   * EXPBOR(-(spec_lin(j_sp)%elk(ju)-spec_lin(j_sp)%elk(jl))/ttry)
      ENDDO
   ENDDO

   eqcol = 0.0_dp

   DO jl = 1, nused-1
      DO ju = jl+1, nused
         eqcol(jl,ju) = eqcol(jl,ju) - ec(jl,ju)
         eqcol(ju,ju) = eqcol(ju,ju) + ec(jl,ju)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         eqcol(ju,jl) = eqcol(ju,jl) - ec(ju,jl)
         eqcol(jl,jl) = eqcol(jl,jl) + ec(ju,jl)
      ENDDO
   ENDDO

END SUBROUTINE COLSPL

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLSPP (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!---------------------------------------------------------------------
!       ttry  :temperature du gaz
!---------------------------------------------------------------------

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    INTEGER                                 :: levl, levu
    INTEGER                                 :: i, j_sp
    REAL (KIND=dp)                          :: fact_e
    REAL (KIND=dp)                          :: delten, logttry
    REAL (KIND=dp)                          :: r_e
    REAL (KIND=dp)                          :: rdo_e
    REAL (KIND=dp)                          :: ratdo, ratup

    j_sp = in_sp(i_spp)
    logttry = LOG10(ttry)

    !--- Find the temperature point in Ne++ collisions with electrons
    IF (logttry <= tempcspp_e(1)) THEN
       i0_e = 1
    ELSE IF (logttry >= tempcspp_e(nttspp_e)) THEN
       i0_e = nttspp_e
    ELSE
       DO i = 2, nttspp_e
          IF (logttry <= tempcspp_e(i)) THEN
             i0_e = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact_e = (tempcspp_e(i0_e) - logttry) / (tempcspp_e(i0_e) - tempcspp_e(i0_e+1))

    eqcol = 0.0_dp

    ! ----------------------------------------------------------------
    ! notes : given the behaviors of the S++ collision rates, we make
    !         *** a linear (log-log scale) extrapolation for T<Tmin
    !         *** a constant extrapolation for T>Tmax
    ! ----------------------------------------------------------------
    !--- Compute collision rates
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_e  = q_spp_e(i0_e,levu,levl) + fact_e * (q_spp_e(i0_e+1,levu,levl) - q_spp_e(i0_e,levu,levl))
          rdo_e = 10.0_dp**r_e
          ! ----------------------------------------------------
          ! conversion from collision strength to collision rate
          ! see document Coll_Strength.pdf (JLB 2013)
          ! ----------------------------------------------------
          rdo_e = rdo_e * 8.62913e-6_dp / (spec_lin(j_sp)%gst(levu) * sqrt(ttry))

          ratdo = rdo_e * ab(nspec)
          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO

END SUBROUTINE COLSPP

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLSIP (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_H, ec_He
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_Hp, ec_e
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_orthoH2
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_paraH2, ec
    REAL (KIND=dp)                            :: xnhmp
    REAL (KIND=dp)                            :: xnhmo
    INTEGER                                   :: j_sp, jl, ju

    j_sp = in_sp(i_sip)

    xnhmp = h2para * ab(i_h2)
    xnhmo = h2orth * ab(i_h2)

    ec_H  = colr_min
    ec_orthoH2 = colr_min
    ec_paraH2  = colr_min
    ec_He = colr_min
    ec_Hp = colr_min
    ec_e  = colr_min

!  excitation de Si+
!  d apres Roueff 90 A&A 234, 567

!    collisions with H

    ec_H(1,2) = 6.00e-10_dp

!    collisions with H2

    ec_paraH2(1,2)  = 3.94e-10_dp
    ec_orthoH2(1,2) = 4.92e-10_dp

!  excitation de Si+ par les electrons
! Dufton & Kingston, 1991, MNRAS 248, 827

    ec_e(1,2) = 8.629e-6_dp * 5.6_dp / (4.0_dp*SQRT(ttry))

!  Bring em together

   ec = 0.0_dp
   DO jl = 1, nused-1
      DO ju = jl+1, nused
         ec(jl,ju) = ec_H(jl,ju) * ab(i_h) + ec_Hp(jl,ju) * ab(i_hp) + ec_paraH2(jl,ju) * xnhmp &
                   + ec_orthoH2(jl,ju) * xnhmo + ec_He(jl,ju) * ab(i_he) + ec_e(jl,ju) * ab(nspec)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         ec(ju,jl) = ec(jl,ju) * (spec_lin(j_sp)%gst(ju)/spec_lin(j_sp)%gst(jl)) &
                   * EXPBOR(-(spec_lin(j_sp)%elk(ju)-spec_lin(j_sp)%elk(jl))/ttry)
      ENDDO
   ENDDO

   eqcol = 0.0_dp

   DO jl = 1, nused-1
      DO ju = jl+1, nused
         eqcol(jl,ju) = eqcol(jl,ju) - ec(jl,ju)
         eqcol(ju,ju) = eqcol(ju,ju) + ec(jl,ju)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         eqcol(ju,jl) = eqcol(ju,jl) - ec(ju,jl)
         eqcol(jl,jl) = eqcol(jl,jl) + ec(ju,jl)
      ENDDO
   ENDDO

END SUBROUTINE COLSIP

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLNEP (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!---------------------------------------------------------------------
!       ttry  :temperature du gaz
!---------------------------------------------------------------------

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    INTEGER                                 :: levl, levu
    INTEGER                                 :: i, j_sp
    REAL (KIND=dp)                          :: fact_e
    REAL (KIND=dp)                          :: delten, logttry
    REAL (KIND=dp)                          :: r_e
    REAL (KIND=dp)                          :: rdo_e
    REAL (KIND=dp)                          :: ratdo, ratup

    j_sp = in_sp(i_nep)
    logttry = LOG10(ttry)

    !--- Find the temperature point in Ne+ collisions with electrons
    IF (logttry <= tempcnep_e(1)) THEN
       i0_e = 1
    ELSE IF (logttry >= tempcnep_e(nttnep_e)) THEN
       i0_e = nttnep_e
    ELSE
       DO i = 2, nttnep_e
          IF (logttry <= tempcnep_e(i)) THEN
             i0_e = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact_e = (tempcnep_e(i0_e) - logttry) / (tempcnep_e(i0_e) - tempcnep_e(i0_e+1))

    eqcol = 0.0_dp

    ! ---------------------------------------------------------------
    ! notes : given the behaviors of the Ne+ collision rates, we make
    !         *** a linear (log-log scale) extrapolation for T<Tmin
    !         *** a constant extrapolation for T>Tmax
    ! ---------------------------------------------------------------
    !--- Compute collision rates
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_e  = q_nep_e(i0_e,levu,levl) + fact_e * (q_nep_e(i0_e+1,levu,levl) - q_nep_e(i0_e,levu,levl))
          rdo_e = 10.0_dp**r_e
          ! ----------------------------------------------------
          ! conversion from collision strength to collision rate
          ! see document Coll_Strength.pdf (JLB 2013)
          ! ----------------------------------------------------
          rdo_e = rdo_e * 8.62913e-6_dp / (spec_lin(j_sp)%gst(levu) * sqrt(ttry))

          ratdo = rdo_e * ab(nspec)
          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO

END SUBROUTINE COLNEP

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLNEPP (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!---------------------------------------------------------------------
!       ttry  :temperature du gaz
!---------------------------------------------------------------------

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    INTEGER                                 :: levl, levu
    INTEGER                                 :: i, j_sp
    REAL (KIND=dp)                          :: fact_e
    REAL (KIND=dp)                          :: delten, logttry
    REAL (KIND=dp)                          :: r_e
    REAL (KIND=dp)                          :: rdo_e
    REAL (KIND=dp)                          :: ratdo, ratup

    j_sp = in_sp(i_nepp)
    logttry = LOG10(ttry)

    !--- Find the temperature point in Ne++ collisions with electrons
    IF (logttry <= tempcnepp_e(1)) THEN
       i0_e = 1
    ELSE IF (logttry >= tempcnepp_e(nttnepp_e)) THEN
       i0_e = nttnepp_e
    ELSE
       DO i = 2, nttnepp_e
          IF (logttry <= tempcnepp_e(i)) THEN
             i0_e = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact_e = (tempcnepp_e(i0_e) - logttry) / (tempcnepp_e(i0_e) - tempcnepp_e(i0_e+1))

    eqcol = 0.0_dp

    ! ----------------------------------------------------------------
    ! notes : given the behaviors of the Ne++ collision rates, we make
    !         *** a linear (log-log scale) extrapolation for T<Tmin
    !         *** a constant extrapolation for T>Tmax
    ! ----------------------------------------------------------------
    !--- Compute collision rates
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_e  = q_nepp_e(i0_e,levu,levl) + fact_e * (q_nepp_e(i0_e+1,levu,levl) - q_nepp_e(i0_e,levu,levl))
          rdo_e = 10.0_dp**r_e
          ! ----------------------------------------------------
          ! conversion from collision strength to collision rate
          ! see document Coll_Strength.pdf (JLB 2013)
          ! ----------------------------------------------------
          rdo_e = rdo_e * 8.62913e-6_dp / (spec_lin(j_sp)%gst(levu) * sqrt(ttry))

          ratdo = rdo_e * ab(nspec)
          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO

END SUBROUTINE COLNEPP

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLCO0N (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    REAL (KIND=dp), DIMENSION (2:nused)     :: cdodj1      ! CO collision rate J -> J-1
    REAL (KIND=dp), DIMENSION (1:nused-1)   :: cupdj1      ! CO collision rate J -> J+1
    REAL (KIND=dp), DIMENSION (3:nused)     :: cdodj2      ! CO collision rate J -> J-2
    REAL (KIND=dp), DIMENSION (1:nused-2)   :: cupdj2      ! CO collision rate J -> J+2
    REAL (KIND=dp), DIMENSION (4:nused)     :: cdodj3      ! CO collision rate J -> J-3
    REAL (KIND=dp), DIMENSION (1:nused-3)   :: cupdj3      ! CO collision rate J -> J+3
    REAL (KIND=dp), DIMENSION (5:nused)     :: cdodj4      ! CO collision rate J -> J-4
    REAL (KIND=dp), DIMENSION (1:nused-4)   :: cupdj4      ! CO collision rate J -> J+4
    INTEGER                                 :: j_sp, j, ij

!       nouveaux taux (corrects?)
    REAL (KIND=dp)                          :: tcohe1 = 3.3e-11_dp
    REAL (KIND=dp)                          :: tcoh1  = 1.0e-11_dp
    REAL (KIND=dp)                          :: tcohe2 = 6.0e-11_dp
    REAL (KIND=dp)                          :: tcoh2  = 1.0e-11_dp
    REAL (KIND=dp)                          :: tcohe3 = 1.6e-11_dp
    REAL (KIND=dp)                          :: tcoh3  = 3.0e-13_dp
    REAL (KIND=dp)                          :: tcohe4 = 1.3e-11_dp
    REAL (KIND=dp)                          :: tcoh4  = 1.0e-13_dp

    REAL (KIND=dp)                          :: delten
    REAL (KIND=dp)                          :: logttry
    REAL (KIND=dp)                          :: r_oh2, r_ph2
    REAL (KIND=dp)                          :: rdo_ph2, rdo_oh2
    REAL (KIND=dp)                          :: ratup, ratdo
    INTEGER                                 :: levu, levl
    INTEGER                                 :: i, i0
    REAL (KIND=dp)                          :: fact

    j_sp = in_sp(i_co)
    logttry = LOG10(ttry)
    eqcol(:,:) = 0.0_dp

! JLB - 19 dec 2010 - Introduce collisions with H2 by interpolation through Yang et al. data
! For now, keep collisions with H and He "as is".

!         *************transfert deltaj = 1 *************

    cdodj1(2) = tcoh1*ab(i_h) * 0.6_dp + tcohe1*ab(i_he) * 2.0_dp / 3.0_dp
    DO j = 3, nused
       cdodj1(j) = tcoh1*ab(i_h) + tcohe1*ab(i_he)
    ENDDO

    DO j = 1, nused-1
       delten = spec_lin(j_sp)%elk(j+1) - spec_lin(j_sp)%elk(j)
       cupdj1(j) = cdodj1(j+1) * (2*j+1) * EXPBOR(-delten / ttry) / (2*j-1)
    ENDDO

!       *************transfert deltaj = 2 *************

    cdodj2(3) = tcoh2*ab(i_h) * 0.5_dp + tcohe2*ab(i_he) / 2.0_dp
    cdodj2(4) = tcoh2*ab(i_h) * 0.5_dp * SQRT(2.0_dp) + tcohe2*ab(i_he) / 1.33_dp

    DO j = 5, nused
       cdodj2(j) = tcoh2*ab(i_h) + tcohe2*ab(i_he)
    ENDDO

    DO j = 1, nused-2
       delten = spec_lin(j_sp)%elk(j+2) - spec_lin(j_sp)%elk(j)
       cupdj2(j) = cdodj2(j+2) * (2*j+3) * EXPBOR(-delten / ttry) / (2*j-1)
    ENDDO

!       *************transfert deltaj = 3 *************

    cdodj3(4) = tcoh3*ab(i_h) / 3.0_dp + tcohe3*ab(i_he) * 0.3_dp
    cdodj3(5) = tcoh3*ab(i_h) + tcohe3*ab(i_he) / 2.0_dp
    DO j = 6, nused
       cdodj3(j) = tcoh3 *ab(i_h) + tcohe3 *ab(i_he)
    ENDDO

    DO j = 1, nused-3
       delten = spec_lin(j_sp)%elk(j+3) - spec_lin(j_sp)%elk(j)
       cupdj3(j) = cdodj3(j+3) * (2*j+5) * EXPBOR(-delten / ttry) / (2*j-1)
    ENDDO


!       *************transfert deltaj = 4 ************************

    cdodj4(5) = tcoh4*ab(i_h) /2.0_dp + 0.5e-11_dp*ab(i_he)
    cdodj4(6) = tcoh4*ab(i_h) * 0.8_dp + 1.0e-11_dp*ab(i_he)
    DO j = 7, nused
       cdodj4(j) = tcoh4*ab(i_h) + tcohe4*ab(i_he)
    ENDDO

    DO j = 1, nused-4
       delten = spec_lin(j_sp)%elk(j+4) - spec_lin(j_sp)%elk(j)
       cupdj4(j) = cdodj4(j+4) * (2*j+7) * EXPBOR(-delten / ttry) / (2*j-1)
    ENDDO

!       ************ matrice d'equilibre collisionnel************

    eqcol = 0.0_dp

    eqcol(1,1) = cupdj1(1) + cupdj2(1) + cupdj3(1) + cupdj4(1)
    eqcol(1,2) = - cdodj1(2)
    eqcol(1,3) = - cdodj2(3)
    eqcol(1,4) = - cdodj3(4)
    eqcol(1,5) = - cdodj4(5)

    eqcol(2,1) = - cupdj1(1)
    eqcol(2,2) = cupdj1(2) + cupdj2(2) + cupdj3(2) + cupdj4(2) + cdodj1(2)
    eqcol(2,3) = - cdodj1(3)
    eqcol(2,4) = - cdodj2(4)
    eqcol(2,5) = - cdodj3(5)
    eqcol(2,6) = - cdodj4(6)


    eqcol(3,1) = - cupdj2(1)
    eqcol(3,2) = - cupdj1(2)
    eqcol(3,3) = cupdj1(3) + cupdj2(3) + cupdj3(3) + cupdj4(3) + cdodj1(3) + cdodj2(3)
    eqcol(3,4) = - cdodj1(4)
    eqcol(3,5) = - cdodj2(5)
    eqcol(3,6) = - cdodj3(6)
    eqcol(3,7) = - cdodj4(7)

    eqcol(4,1) = - cupdj3(1)
    eqcol(4,2) = - cupdj2(2)
    eqcol(4,3) = - cupdj1(3)
    eqcol(4,4) = cupdj1(4) + cupdj2(4) + cupdj3(4) + cupdj4(4) + cdodj1(4) + cdodj2(4) + cdodj3(4)
    eqcol(4,5) = - cdodj1(5)
    eqcol(4,6) = - cdodj2(6)
    eqcol(4,7) = - cdodj3(7)
    eqcol(4,8) = - cdodj4(8)

    DO ij = 5, nused-4
       eqcol(ij,ij-4) = - cupdj4(ij-4)
       eqcol(ij,ij-3) = - cupdj3(ij-3)
       eqcol(ij,ij-2) = - cupdj2(ij-2)
       eqcol(ij,ij-1) = - cupdj1(ij-1)
       eqcol(ij,ij) = cdodj1(ij) + cupdj1(ij) + cdodj2(ij) + cupdj2(ij) &
                    + cdodj3(ij) + cupdj3(ij) + cdodj4(ij) + cupdj4(ij)
       eqcol(ij,ij+1) = - cdodj1(ij+1)
       eqcol(ij,ij+2) = - cdodj2(ij+2)
       eqcol(ij,ij+3) = - cdodj3(ij+3)
       eqcol(ij,ij+4) = - cdodj4(ij+4)
    ENDDO


    eqcol(nused-3,nused-7) = - cupdj4(nused-8)
    eqcol(nused-3,nused-6) = - cupdj3(nused-7)
    eqcol(nused-3,nused-5) = - cupdj2(nused-6)
    eqcol(nused-3,nused-4) = - cupdj1(nused-5)
    eqcol(nused-3,nused-3) = cdodj1(nused-4) + cupdj1(nused-4) + cdodj2(nused-4) &
                           + cupdj2(nused-4) + cdodj3(nused-4) + cupdj3(nused-4) + cdodj4(nused-4)
    eqcol(nused-3,nused-2) = - cdodj1(nused-3)
    eqcol(nused-3,nused-1) = - cdodj2(nused-2)
    eqcol(nused-3,nused)   = - cdodj3(nused-1)

    eqcol(nused-2,nused-6) = - cupdj4(nused-7)
    eqcol(nused-2,nused-5) = - cupdj3(nused-6)
    eqcol(nused-2,nused-4) = - cupdj2(nused-5)
    eqcol(nused-2,nused-3) = - cupdj1(nused-4)
    eqcol(nused-2,nused-2) = cdodj1(nused-3) + cupdj1(nused-3) + cdodj2(nused-3) &
                           + cupdj2(nused-3) + cdodj3(nused-3) + cdodj4(nused-3)
    eqcol(nused-2,nused-1) = - cdodj1(nused-2)
    eqcol(nused-2,nused)   = - cdodj2(nused-1)

    eqcol(nused-1,nused-5) = - cupdj4(nused-6)
    eqcol(nused-1,nused-4) = - cupdj3(nused-5)
    eqcol(nused-1,nused-3) = - cupdj2(nused-4)
    eqcol(nused-1,nused-2) = - cupdj1(nused-3)
    eqcol(nused-1,nused-1) = cdodj1(nused-2) + cupdj1(nused-2) + cdodj2(nused-2) &
                           + cdodj3(nused-2) + cdodj4(nused-2)
    eqcol(nused-1,nused) = - cdodj1(nused-1)


    eqcol(nused,nused-4) = - cupdj4(nused-5)
    eqcol(nused,nused-3) = - cupdj3(nused-4)
    eqcol(nused,nused-2) = - cupdj2(nused-3)
    eqcol(nused,nused-1) = - cupdj1(nused-2)
    eqcol(nused,nused)   = cdodj1(nused-1) + cdodj2(nused-1) + cdodj3(nused-1) + cdodj4(nused-1)

    !-- Compute H2 rates ---
    IF (logttry <= tc_co_h2(1)) THEN
       i0 = 1
    ELSE IF (logttry >= tc_co_h2(nt_co_h2)) THEN
       i0 = nt_co_h2
    ELSE
       DO i = 2, nt_co_h2
          IF (logttry <= tc_co_h2(i)) THEN
             i0 = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact = (tc_co_h2(i0) - logttry) / (tc_co_h2(i0) - tc_co_h2(i0+1))
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_ph2 = q_co_ph2(i0,levu,levl) + fact * (q_co_ph2(i0+1,levu,levl) - q_co_ph2(i0,levu,levl))
          r_oh2 = q_co_oh2(i0,levu,levl) + fact * (q_co_oh2(i0+1,levu,levl) - q_co_oh2(i0,levu,levl))
          rdo_ph2 = 10.0_dp**r_ph2
          rdo_oh2 = 10.0_dp**r_oh2
!         print *, levu, levl, rdo_ph2, rdo_oh2
!         print *, "   ", logttry, r_ph2, r_oh2

          ratdo = (rdo_ph2 * h2para + rdo_oh2 * h2orth) * ab(i_h2)
          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO

END SUBROUTINE COLCO0N

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLCO0 (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    INTEGER                                 :: j_sp

    REAL (KIND=dp)                          :: delten
    REAL (KIND=dp)                          :: logttry
    REAL (KIND=dp)                          :: r_h, r_he, rdo_h, rdo_he
    REAL (KIND=dp)                          :: r_oh2, r_ph2, rdo_ph2, rdo_oh2
    REAL (KIND=dp)                          :: ratup, ratdo
    INTEGER                                 :: levu, levl
    INTEGER                                 :: i

    j_sp = in_sp(i_co)
    logttry = LOG10(ttry)
    eqcol(:,:) = 0.0_dp

! JLB - 19 dec 2010 - Introduce collisions with H2 by interpolation through Yang et al. data
! JLB - 19 oct 2011 - Introduce collisions with H and He from Balakrishnan 2002 (corrected)

    ! Find positions in temperature grids
    IF (logttry <= tc_co_h(1)) THEN
       i0_h = 1
    ELSE IF (logttry >= tc_co_h(nt_co_h)) THEN
       i0_h = nt_co_h
    ELSE
       DO i = 2, nt_co_h
          IF (logttry <= tc_co_h(i)) THEN
             i0_h = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    f_h = (tc_co_h(i0_h) - logttry) / (tc_co_h(i0_h) - tc_co_h(i0_h+1))

    IF (logttry <= tc_co_he(1)) THEN
       i0_he = 1
    ELSE IF (logttry >= tc_co_he(nt_co_he)) THEN
       i0_he = nt_co_he
    ELSE
       DO i = 2, nt_co_he
          IF (logttry <= tc_co_he(i)) THEN
             i0_he = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    f_he = (tc_co_he(i0_he) - logttry) / (tc_co_he(i0_he) - tc_co_he(i0_he+1))

    IF (logttry <= tc_co_h2(1)) THEN
       i0_h2 = 1
    ELSE IF (logttry >= tc_co_h2(nt_co_h2)) THEN
       i0_h2 = nt_co_h2
    ELSE
       DO i = 2, nt_co_h2
          IF (logttry <= tc_co_h2(i)) THEN
             i0_h2 = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    f_h2 = (tc_co_h2(i0_h2) - logttry) / (tc_co_h2(i0_h2) - tc_co_h2(i0_h2+1))

    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_h   = q_co_h(i0_h,levu,levl) &
                + f_h * (q_co_h(i0_h+1,levu,levl) - q_co_h(i0_h,levu,levl))
          r_he  = q_co_he(i0_he,levu,levl) &
                + f_he * (q_co_he(i0_he+1,levu,levl) - q_co_he(i0_he,levu,levl))
          r_ph2 = q_co_ph2(i0_h2,levu,levl) &
                + f_h2 * (q_co_ph2(i0_h2+1,levu,levl) - q_co_ph2(i0_h2,levu,levl))
          r_oh2 = q_co_oh2(i0_h2,levu,levl) &
                + f_h2 * (q_co_oh2(i0_h2+1,levu,levl) - q_co_oh2(i0_h2,levu,levl))
          rdo_h   = 10.0_dp**r_h
          rdo_he  = 10.0_dp**r_he
          rdo_ph2 = 10.0_dp**r_ph2
          rdo_oh2 = 10.0_dp**r_oh2
!         print *, levu, levl, rdo_h, rdo_he, rdo_ph2, rdo_oh2
!         print *, "   ", logttry, r_h, r_he, r_ph2, r_oh2

          ratdo = (rdo_ph2 * h2para + rdo_oh2 * h2orth) * ab(i_h2) &
                + rdo_h * ab(i_h) + rdo_he * ab(i_he)
          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO

END SUBROUTINE COLCO0

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLCO1N (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    REAL (KIND=dp), DIMENSION (2:nused)     :: cdodj1      ! CO collision rate J -> J-1
    REAL (KIND=dp), DIMENSION (1:nused-1)   :: cupdj1      ! CO collision rate J -> J+1
    REAL (KIND=dp), DIMENSION (3:nused)     :: cdodj2      ! CO collision rate J -> J-2
    REAL (KIND=dp), DIMENSION (1:nused-2)   :: cupdj2      ! CO collision rate J -> J+2
    REAL (KIND=dp), DIMENSION (4:nused)     :: cdodj3      ! CO collision rate J -> J-3
    REAL (KIND=dp), DIMENSION (1:nused-3)   :: cupdj3      ! CO collision rate J -> J+3
    REAL (KIND=dp), DIMENSION (5:nused)     :: cdodj4      ! CO collision rate J -> J-4
    REAL (KIND=dp), DIMENSION (1:nused-4)   :: cupdj4      ! CO collision rate J -> J+4
    INTEGER                                 :: j_sp, j, ij

!       nouveaux taux (correctes?)
    REAL (KIND=dp)                          :: tcohe1 = 3.3e-11_dp
    REAL (KIND=dp)                          :: tcoh1  = 1.0e-11_dp
    REAL (KIND=dp)                          :: tcohe2 = 6.0e-11_dp
    REAL (KIND=dp)                          :: tcoh2  = 1.0e-11_dp
    REAL (KIND=dp)                          :: tcohe3 = 1.6e-11_dp
    REAL (KIND=dp)                          :: tcoh3  = 3.0e-13_dp
    REAL (KIND=dp)                          :: tcohe4 = 1.3e-11_dp
    REAL (KIND=dp)                          :: tcoh4  = 1.0e-13_dp

    REAL (KIND=dp)                          :: delten
    REAL (KIND=dp)                          :: logttry
    REAL (KIND=dp)                          :: r_oh2, r_ph2
    REAL (KIND=dp)                          :: rdo_ph2, rdo_oh2
    REAL (KIND=dp)                          :: ratup, ratdo
    INTEGER                                 :: levu, levl
    INTEGER                                 :: i, i0
    REAL (KIND=dp)                          :: fact

    j_sp = in_sp(j_c13o)
    logttry = LOG10(ttry)

!         *************transfert deltaj = 1 *************

    cdodj1(2) = tcoh1*ab(i_h) * 0.6_dp + tcohe1*ab(i_he) * 2.0_dp / 3.0_dp
    DO j = 3, nused
       cdodj1(j) = tcoh1*ab(i_h) + tcohe1*ab(i_he)
    ENDDO

    DO j = 1, nused-1
       delten = spec_lin(j_sp)%elk(j+1) - spec_lin(j_sp)%elk(j)
       cupdj1(j) = cdodj1(j+1) * (2*j+1) * EXPBOR(-delten / ttry) / (2*j-1)
    ENDDO

!       *************transfert deltaj = 2 *************

    cdodj2(3) = tcoh2*ab(i_h) * 0.5_dp + tcohe2*ab(i_he) / 2.0_dp
    cdodj2(4) = tcoh2*ab(i_h) * 0.5_dp * SQRT(2.0_dp) + tcohe2*ab(i_he) / 1.33_dp

    DO j = 5, nused
       cdodj2(j) = tcoh2*ab(i_h) + tcohe2*ab(i_he)
    ENDDO

    DO j = 1, nused-2
       delten = spec_lin(j_sp)%elk(j+2) - spec_lin(j_sp)%elk(j)
       cupdj2(j) = cdodj2(j+2) * (2*j+3) * EXPBOR(-delten / ttry) / (2*j-1)
    ENDDO

!       *************transfert deltaj = 3 *************

    cdodj3(4) = tcoh3*ab(i_h) / 3.0_dp + tcohe3*ab(i_he) * 0.3_dp
    cdodj3(5) = tcoh3*ab(i_h) + tcohe3*ab(i_he) / 2.0_dp
    DO j = 6, nused
       cdodj3(j) = tcoh3*ab(i_h) + tcohe3*ab(i_he)
    ENDDO

    DO j = 1, nused-3
       delten = spec_lin(j_sp)%elk(j+3) - spec_lin(j_sp)%elk(j)
       cupdj3(j) = cdodj3(j+3) * (2*j+5) * EXPBOR(-delten / ttry) / (2*j-1)
    ENDDO


!       *************transfert deltaj = 4 ************************

    cdodj4(5) = tcoh4*ab(i_h) / 2.0_dp + 0.5e-11_dp*ab(i_he)
    cdodj4(6) = tcoh4*ab(i_h) * 0.8_dp + 1.0e-11_dp*ab(i_he)
    DO j = 7, nused
       cdodj4(j) = tcoh4*ab(i_h) + tcohe4*ab(i_he)
    ENDDO

    DO j = 1, nused-4
       delten = spec_lin(j_sp)%elk(j+4) - spec_lin(j_sp)%elk(j)
       cupdj4(j) = cdodj4(j+4) * (2*j+7) * EXPBOR(-delten / ttry) / (2*j-1)
    ENDDO

!       ************ matrice d'equilibre collisionnel************

    eqcol = 0.0_dp

    eqcol(1,1) = cupdj1(1) + cupdj2(1) + cupdj3(1) + cupdj4(1)
    eqcol(1,2) = - cdodj1(2)
    eqcol(1,3) = - cdodj2(3)
    eqcol(1,4) = - cdodj3(4)
    eqcol(1,5) = - cdodj4(5)

    eqcol(2,1) = - cupdj1(1)
    eqcol(2,2) = cupdj1(2) + cupdj2(2) + cupdj3(2) + cupdj4(2) + cdodj1(2)
    eqcol(2,3) = - cdodj1(3)
    eqcol(2,4) = - cdodj2(4)
    eqcol(2,5) = - cdodj3(5)
    eqcol(2,6) = - cdodj4(6)


    eqcol(3,1) = - cupdj2(1)
    eqcol(3,2) = - cupdj1(2)
    eqcol(3,3) = cupdj1(3) + cupdj2(3) + cupdj3(3) + cupdj4(3) + cdodj1(3) + cdodj2(3)
    eqcol(3,4) = - cdodj1(4)
    eqcol(3,5) = - cdodj2(5)
    eqcol(3,6) = - cdodj3(6)
    eqcol(3,7) = - cdodj4(7)

    eqcol(4,1) = - cupdj3(1)
    eqcol(4,2) = - cupdj2(2)
    eqcol(4,3) = - cupdj1(3)
    eqcol(4,4) = cupdj1(4) + cupdj2(4) + cupdj3(4) + cupdj4(4) + cdodj1(4) + cdodj2(4) + cdodj3(4)
    eqcol(4,5) = - cdodj1(5)
    eqcol(4,6) = - cdodj2(6)
    eqcol(4,7) = - cdodj3(7)
    eqcol(4,8) = - cdodj4(8)

    DO ij = 5, nused-4
       eqcol(ij,ij-4) = - cupdj4(ij-4)
       eqcol(ij,ij-3) = - cupdj3(ij-3)
       eqcol(ij,ij-2) = - cupdj2(ij-2)
       eqcol(ij,ij-1) = - cupdj1(ij-1)
       eqcol(ij,ij) = cdodj1(ij) + cupdj1(ij) + cdodj2(ij) + cupdj2(ij) &
                    + cdodj3(ij) + cupdj3(ij) + cdodj4(ij) + cupdj4(ij)
       eqcol(ij,ij+1) = - cdodj1(ij+1)
       eqcol(ij,ij+2) = - cdodj2(ij+2)
       eqcol(ij,ij+3) = - cdodj3(ij+3)
       eqcol(ij,ij+4) = - cdodj4(ij+4)
    ENDDO


    eqcol(nused-3,nused-7) = - cupdj4(nused-8)
    eqcol(nused-3,nused-6) = - cupdj3(nused-7)
    eqcol(nused-3,nused-5) = - cupdj2(nused-6)
    eqcol(nused-3,nused-4) = - cupdj1(nused-5)
    eqcol(nused-3,nused-3) = cdodj1(nused-4) + cupdj1(nused-4) + cdodj2(nused-4) &
                           + cupdj2(nused-4) + cdodj3(nused-4) + cupdj3(nused-4) + cdodj4(nused-4)
    eqcol(nused-3,nused-2) = - cdodj1(nused-3)
    eqcol(nused-3,nused-1) = - cdodj2(nused-2)
    eqcol(nused-3,nused)   = - cdodj3(nused-1)

    eqcol(nused-2,nused-6) = - cupdj4(nused-7)
    eqcol(nused-2,nused-5) = - cupdj3(nused-6)
    eqcol(nused-2,nused-4) = - cupdj2(nused-5)
    eqcol(nused-2,nused-3) = - cupdj1(nused-4)
    eqcol(nused-2,nused-2) = cdodj1(nused-3) + cupdj1(nused-3) + cdodj2(nused-3) &
                           + cupdj2(nused-3) + cdodj3(nused-3) + cdodj4(nused-3)
    eqcol(nused-2,nused-1) = - cdodj1(nused-2)
    eqcol(nused-2,nused)   = - cdodj2(nused-1)

    eqcol(nused-1,nused-5) = - cupdj4(nused-6)
    eqcol(nused-1,nused-4) = - cupdj3(nused-5)
    eqcol(nused-1,nused-3) = - cupdj2(nused-4)
    eqcol(nused-1,nused-2) = - cupdj1(nused-3)
    eqcol(nused-1,nused-1) = cdodj1(nused-2) + cupdj1(nused-2) + cdodj2(nused-2) &
                           + cdodj3(nused-2) + cdodj4(nused-2)
    eqcol(nused-1,nused) = - cdodj1(nused-1)


    eqcol(nused,nused-4) = - cupdj4(nused-5)
    eqcol(nused,nused-3) = - cupdj3(nused-4)
    eqcol(nused,nused-2) = - cupdj2(nused-3)
    eqcol(nused,nused-1) = - cupdj1(nused-2)
    eqcol(nused,nused)   = cdodj1(nused-1) + cdodj2(nused-1) + cdodj3(nused-1) + cdodj4(nused-1)

    !-- Compute H2 rates ---
    IF (logttry <= tc_co_h2(1)) THEN
       i0 = 1
    ELSE IF (logttry >= tc_co_h2(nt_co_h2)) THEN
       i0 = nt_co_h2
    ELSE
       DO i = 2, nt_co_h2
          IF (logttry <= tc_co_h2(i)) THEN
             i0 = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact = (tc_co_h2(i0) - logttry) / (tc_co_h2(i0) - tc_co_h2(i0+1))
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_ph2 = q_c13o_ph2(i0,levu,levl) + fact * (q_c13o_ph2(i0+1,levu,levl) - q_c13o_ph2(i0,levu,levl))
          r_oh2 = q_c13o_oh2(i0,levu,levl) + fact * (q_c13o_oh2(i0+1,levu,levl) - q_c13o_oh2(i0,levu,levl))
          rdo_ph2 = 10.0_dp**r_ph2
          rdo_oh2 = 10.0_dp**r_oh2
!         print *, levu, levl, rdo_ph2, rdo_oh2
!         print *, "   ", logttry, r_ph2, r_oh2

          ratdo = (rdo_ph2 * h2para + rdo_oh2 * h2orth) * ab(i_h2)
          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO

END SUBROUTINE COLCO1N

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLCO1 (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    INTEGER                                 :: j_sp

    REAL (KIND=dp)                          :: delten
    REAL (KIND=dp)                          :: logttry
    REAL (KIND=dp)                          :: r_h, r_he, rdo_h, rdo_he
    REAL (KIND=dp)                          :: r_oh2, r_ph2, rdo_ph2, rdo_oh2
    REAL (KIND=dp)                          :: ratup, ratdo
    INTEGER                                 :: levu, levl

    j_sp = in_sp(j_c13o)
    logttry = LOG10(ttry)

    ! Collisions exist for H2, but not for H and He: use CO
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_h   = q_co_h(i0_h,levu,levl) &
                + f_h * (q_co_h(i0_h+1,levu,levl) - q_co_h(i0_h,levu,levl))
          r_he  = q_co_he(i0_he,levu,levl) &
                + f_he * (q_co_he(i0_he+1,levu,levl) - q_co_he(i0_he,levu,levl))
          r_ph2 = q_c13o_ph2(i0_h2,levu,levl) &
                + f_h2 * (q_c13o_ph2(i0_h2+1,levu,levl) - q_c13o_ph2(i0_h2,levu,levl))
          r_oh2 = q_c13o_oh2(i0_h2,levu,levl) &
                + f_h2 * (q_c13o_oh2(i0_h2+1,levu,levl) - q_c13o_oh2(i0_h2,levu,levl))
          rdo_h   = 10.0_dp**r_h
          rdo_he  = 10.0_dp**r_he
          rdo_ph2 = 10.0_dp**r_ph2
          rdo_oh2 = 10.0_dp**r_oh2
!         print *, levu, levl, rdo_ph2, rdo_oh2
!         print *, "   ", logttry, r_ph2, r_oh2

          ratdo = (rdo_ph2 * h2para + rdo_oh2 * h2orth) * ab(i_h2) &
                + rdo_h * ab(i_h) + rdo_he * ab(i_he)
          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO

END SUBROUTINE COLCO1

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLCO2N (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    REAL (KIND=dp), DIMENSION (2:nused)     :: cdodj1      ! CO collision rate J -> J-1
    REAL (KIND=dp), DIMENSION (1:nused-1)   :: cupdj1      ! CO collision rate J -> J+1
    REAL (KIND=dp), DIMENSION (3:nused)     :: cdodj2      ! CO collision rate J -> J-2
    REAL (KIND=dp), DIMENSION (1:nused-2)   :: cupdj2      ! CO collision rate J -> J+2
    REAL (KIND=dp), DIMENSION (4:nused)     :: cdodj3      ! CO collision rate J -> J-3
    REAL (KIND=dp), DIMENSION (1:nused-3)   :: cupdj3      ! CO collision rate J -> J+3
    REAL (KIND=dp), DIMENSION (5:nused)     :: cdodj4      ! CO collision rate J -> J-4
    REAL (KIND=dp), DIMENSION (1:nused-4)   :: cupdj4      ! CO collision rate J -> J+4
    INTEGER                                 :: j_sp, j, ij

!       nouveaux taux (correctes?)
    REAL (KIND=dp)                          :: tcohe1 = 3.3e-11_dp
    REAL (KIND=dp)                          :: tcoh1  = 1.0e-11_dp
    REAL (KIND=dp)                          :: tcohe2 = 6.0e-11_dp
    REAL (KIND=dp)                          :: tcoh2  = 1.0e-11_dp
    REAL (KIND=dp)                          :: tcohe3 = 1.6e-11_dp
    REAL (KIND=dp)                          :: tcoh3  = 3.0e-13_dp
    REAL (KIND=dp)                          :: tcohe4 = 1.3e-11_dp
    REAL (KIND=dp)                          :: tcoh4  = 1.0e-13_dp

    REAL (KIND=dp)                          :: delten
    REAL (KIND=dp)                          :: logttry
    REAL (KIND=dp)                          :: r_oh2, r_ph2
    REAL (KIND=dp)                          :: rdo_ph2, rdo_oh2
    REAL (KIND=dp)                          :: ratup, ratdo
    INTEGER                                 :: levu, levl
    INTEGER                                 :: i, i0
    REAL (KIND=dp)                          :: fact

    j_sp = in_sp(j_co18)
    logttry = LOG10(ttry)

!         *************transfert deltaj = 1 *************

    cdodj1(2) = tcoh1*ab(i_h) * 0.6_dp + tcohe1*ab(i_he) * 2.0_dp / 3.0_dp
    DO j = 3, nused
       cdodj1(j) = tcoh1*ab(i_h) + tcohe1*ab(i_he)
    ENDDO

    DO j = 1, nused-1
       delten = spec_lin(j_sp)%elk(j+1) - spec_lin(j_sp)%elk(j)
       cupdj1(j) = cdodj1(j+1) * (2*j+1) * EXPBOR(-delten / ttry) / (2*j-1)
    ENDDO

!       *************transfert deltaj = 2 *************

    cdodj2(3) = tcoh2*ab(i_h) * 0.5_dp + tcohe2*ab(i_he) / 2.0_dp
    cdodj2(4) = tcoh2*ab(i_h) * 0.5_dp * SQRT(2.0_dp) + tcohe2*ab(i_he) / 1.33_dp

    DO j = 5, nused
       cdodj2(j) = tcoh2*ab(i_h) + tcohe2*ab(i_he)
    ENDDO

    DO j = 1, nused-2
       delten = spec_lin(j_sp)%elk(j+2) - spec_lin(j_sp)%elk(j)
       cupdj2(j) = cdodj2(j+2) * (2*j+3) * EXPBOR(-delten / ttry) / (2*j-1)
    ENDDO

!       *************transfert deltaj = 3 *************

    cdodj3(4) = tcoh3*ab(i_h) / 3.0_dp + tcohe3*ab(i_he) * 0.3_dp
    cdodj3(5) = tcoh3*ab(i_h) + tcohe3*ab(i_he) / 2.0_dp
    DO j = 6, nused
       cdodj3(j) = tcoh3*ab(i_h) + tcohe3*ab(i_he)
    ENDDO

    DO j = 1, nused-3
       delten = spec_lin(j_sp)%elk(j+3) - spec_lin(j_sp)%elk(j)
       cupdj3(j) = cdodj3(j+3) * (2*j+5) * EXPBOR(-delten / ttry) / (2*j-1)
    ENDDO


!       *************transfert deltaj = 4 ************************

    cdodj4(5) = tcoh4*ab(i_h) / 2.0_dp + 0.5e-11_dp*ab(i_he)
    cdodj4(6) = tcoh4*ab(i_h) * 0.8_dp + 1.0e-11_dp*ab(i_he)
    DO j = 7, nused
       cdodj4(j) = tcoh4*ab(i_h) + tcohe4*ab(i_he)
    ENDDO

    DO j = 1, nused-4
       delten = spec_lin(j_sp)%elk(j+4) - spec_lin(j_sp)%elk(j)
       cupdj4(j) = cdodj4(j+4) * (2*j+7) * EXPBOR(-delten / ttry) / (2*j-1)
    ENDDO


!       ************ matrice d'equilibre collisionnel************

    eqcol = 0.0_dp

    eqcol(1,1) = cupdj1(1) + cupdj2(1) + cupdj3(1) + cupdj4(1)
    eqcol(1,2) = - cdodj1(2)
    eqcol(1,3) = - cdodj2(3)
    eqcol(1,4) = - cdodj3(4)
    eqcol(1,5) = - cdodj4(5)

    eqcol(2,1) = - cupdj1(1)
    eqcol(2,2) = cupdj1(2) + cupdj2(2) + cupdj3(2) + cupdj4(2) + cdodj1(2)
    eqcol(2,3) = - cdodj1(3)
    eqcol(2,4) = - cdodj2(4)
    eqcol(2,5) = - cdodj3(5)
    eqcol(2,6) = - cdodj4(6)


    eqcol(3,1) = - cupdj2(1)
    eqcol(3,2) = - cupdj1(2)
    eqcol(3,3) = cupdj1(3) + cupdj2(3) + cupdj3(3) + cupdj4(3) + cdodj1(3) + cdodj2(3)
    eqcol(3,4) = - cdodj1(4)
    eqcol(3,5) = - cdodj2(5)
    eqcol(3,6) = - cdodj3(6)
    eqcol(3,7) = - cdodj4(7)

    eqcol(4,1) = - cupdj3(1)
    eqcol(4,2) = - cupdj2(2)
    eqcol(4,3) = - cupdj1(3)
    eqcol(4,4) = cupdj1(4) + cupdj2(4) + cupdj3(4) + cupdj4(4) + cdodj1(4) + cdodj2(4) + cdodj3(4)
    eqcol(4,5) = - cdodj1(5)
    eqcol(4,6) = - cdodj2(6)
    eqcol(4,7) = - cdodj3(7)
    eqcol(4,8) = - cdodj4(8)

    DO ij = 5, nused-4
       eqcol(ij,ij-4) = - cupdj4(ij-4)
       eqcol(ij,ij-3) = - cupdj3(ij-3)
       eqcol(ij,ij-2) = - cupdj2(ij-2)
       eqcol(ij,ij-1) = - cupdj1(ij-1)
       eqcol(ij,ij) = cdodj1(ij) + cupdj1(ij) + cdodj2(ij) + cupdj2(ij) + cdodj3(ij) &
                    + cupdj3(ij) + cdodj4(ij) + cupdj4(ij)
       eqcol(ij,ij+1) = - cdodj1(ij+1)
       eqcol(ij,ij+2) = - cdodj2(ij+2)
       eqcol(ij,ij+3) = - cdodj3(ij+3)
       eqcol(ij,ij+4) = - cdodj4(ij+4)
    ENDDO


    eqcol(nused-3,nused-7) = - cupdj4(nused-8)
    eqcol(nused-3,nused-6) = - cupdj3(nused-7)
    eqcol(nused-3,nused-5) = - cupdj2(nused-6)
    eqcol(nused-3,nused-4) = - cupdj1(nused-5)
    eqcol(nused-3,nused-3) = cdodj1(nused-4) + cupdj1(nused-4) + cdodj2(nused-4) &
                           + cupdj2(nused-4) + cdodj3(nused-4) + cupdj3(nused-4) + cdodj4(nused-4)
    eqcol(nused-3,nused-2) = - cdodj1(nused-3)
    eqcol(nused-3,nused-1) = - cdodj2(nused-2)
    eqcol(nused-3,nused)   = - cdodj3(nused-1)

    eqcol(nused-2,nused-6) = - cupdj4(nused-7)
    eqcol(nused-2,nused-5) = - cupdj3(nused-6)
    eqcol(nused-2,nused-4) = - cupdj2(nused-5)
    eqcol(nused-2,nused-3) = - cupdj1(nused-4)
    eqcol(nused-2,nused-2) = cdodj1(nused-3) + cupdj1(nused-3) + cdodj2(nused-3) &
                           + cupdj2(nused-3) + cdodj3(nused-3) + cdodj4(nused-3)
    eqcol(nused-2,nused-1) = - cdodj1(nused-2)
    eqcol(nused-2,nused)   = - cdodj2(nused-1)

    eqcol(nused-1,nused-5) = - cupdj4(nused-6)
    eqcol(nused-1,nused-4) = - cupdj3(nused-5)
    eqcol(nused-1,nused-3) = - cupdj2(nused-4)
    eqcol(nused-1,nused-2) = - cupdj1(nused-3)
    eqcol(nused-1,nused-1) = cdodj1(nused-2) + cupdj1(nused-2) + cdodj2(nused-2) &
                           + cdodj3(nused-2) + cdodj4(nused-2)
    eqcol(nused-1,nused) = - cdodj1(nused-1)


    eqcol(nused,nused-4) = - cupdj4(nused-5)
    eqcol(nused,nused-3) = - cupdj3(nused-4)
    eqcol(nused,nused-2) = - cupdj2(nused-3)
    eqcol(nused,nused-1) = - cupdj1(nused-2)
    eqcol(nused,nused)   = cdodj1(nused-1) + cdodj2(nused-1) + cdodj3(nused-1) + cdodj4(nused-1)

    !-- Compute H2 rates ---
    IF (logttry <= tc_co_h2(1)) THEN
       i0 = 1
    ELSE IF (logttry >= tc_co_h2(nt_co_h2)) THEN
       i0 = nt_co_h2
    ELSE
       DO i = 2, nt_co_h2
          IF (logttry <= tc_co_h2(i)) THEN
             i0 = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact = (tc_co_h2(i0) - logttry) / (tc_co_h2(i0) - tc_co_h2(i0+1))
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_ph2 = q_co18_ph2(i0,levu,levl) + fact * (q_co18_ph2(i0+1,levu,levl) - q_co18_ph2(i0,levu,levl))
          r_oh2 = q_co18_oh2(i0,levu,levl) + fact * (q_co18_oh2(i0+1,levu,levl) - q_co18_oh2(i0,levu,levl))
          rdo_ph2 = 10.0_dp**r_ph2
          rdo_oh2 = 10.0_dp**r_oh2
!         print *, levu, levl, rdo_ph2, rdo_oh2
!         print *, "   ", logttry, r_ph2, r_oh2

          ratdo = (rdo_ph2 * h2para + rdo_oh2 * h2orth) * ab(i_h2)
          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO

END SUBROUTINE COLCO2N

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLCO2 (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    INTEGER                                 :: j_sp

    REAL (KIND=dp)                          :: delten
    REAL (KIND=dp)                          :: logttry
    REAL (KIND=dp)                          :: r_h, r_he, rdo_h, rdo_he
    REAL (KIND=dp)                          :: r_oh2, r_ph2, rdo_ph2, rdo_oh2
    REAL (KIND=dp)                          :: ratup, ratdo
    INTEGER                                 :: levu, levl

    j_sp = in_sp(j_co18)
    logttry = LOG10(ttry)

    ! Collisions exist for H2, but not for H and He: use CO
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_h   = q_co_h(i0_h,levu,levl) &
                + f_h * (q_co_h(i0_h+1,levu,levl) - q_co_h(i0_h,levu,levl))
          r_he  = q_co_he(i0_he,levu,levl) &
                + f_he * (q_co_he(i0_he+1,levu,levl) - q_co_he(i0_he,levu,levl))
          r_ph2 = q_co18_ph2(i0_h2,levu,levl) &
                + f_h2 * (q_co18_ph2(i0_h2+1,levu,levl) - q_co18_ph2(i0_h2,levu,levl))
          r_oh2 = q_co18_oh2(i0_h2,levu,levl) &
                + f_h2 * (q_co18_oh2(i0_h2+1,levu,levl) - q_co18_oh2(i0_h2,levu,levl))
          rdo_h   = 10.0_dp**r_h
          rdo_he  = 10.0_dp**r_he
          rdo_ph2 = 10.0_dp**r_ph2
          rdo_oh2 = 10.0_dp**r_oh2
!         print *, levu, levl, rdo_ph2, rdo_oh2
!         print *, "   ", logttry, r_ph2, r_oh2

          ratdo = (rdo_ph2 * h2para + rdo_oh2 * h2orth) * ab(i_h2) &
                + rdo_h * ab(i_h) + rdo_he * ab(i_he)
          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO

END SUBROUTINE COLCO2

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLCO3N (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    REAL (KIND=dp), DIMENSION (2:nused)     :: cdodj1      ! CO collision rate J -> J-1
    REAL (KIND=dp), DIMENSION (1:nused-1)   :: cupdj1      ! CO collision rate J -> J+1
    REAL (KIND=dp), DIMENSION (3:nused)     :: cdodj2      ! CO collision rate J -> J-2
    REAL (KIND=dp), DIMENSION (1:nused-2)   :: cupdj2      ! CO collision rate J -> J+2
    REAL (KIND=dp), DIMENSION (4:nused)     :: cdodj3      ! CO collision rate J -> J-3
    REAL (KIND=dp), DIMENSION (1:nused-3)   :: cupdj3      ! CO collision rate J -> J+3
    REAL (KIND=dp), DIMENSION (5:nused)     :: cdodj4      ! CO collision rate J -> J-4
    REAL (KIND=dp), DIMENSION (1:nused-4)   :: cupdj4      ! CO collision rate J -> J+4
    INTEGER                                 :: j_sp, j, ij

!       nouveaux taux (correctes?)
    REAL (KIND=dp)                          :: tcohe1 = 3.3e-11_dp
    REAL (KIND=dp)                          :: tcoh1  = 1.0e-11_dp
    REAL (KIND=dp)                          :: tcohe2 = 6.0e-11_dp
    REAL (KIND=dp)                          :: tcoh2  = 1.0e-11_dp
    REAL (KIND=dp)                          :: tcohe3 = 1.6e-11_dp
    REAL (KIND=dp)                          :: tcoh3  = 3.0e-13_dp
    REAL (KIND=dp)                          :: tcohe4 = 1.3e-11_dp
    REAL (KIND=dp)                          :: tcoh4  = 1.0e-13_dp

    REAL (KIND=dp)                          :: delten
    REAL (KIND=dp)                          :: logttry
    REAL (KIND=dp)                          :: r_oh2, r_ph2
    REAL (KIND=dp)                          :: rdo_ph2, rdo_oh2
    REAL (KIND=dp)                          :: ratup, ratdo
    INTEGER                                 :: levu, levl
    INTEGER                                 :: i, i0
    REAL (KIND=dp)                          :: fact

    j_sp = in_sp(j_c13o18)
    logttry = LOG10(ttry)

!         *************transfert deltaj = 1 *************

    cdodj1(2) = tcoh1*ab(i_h) * 0.6_dp + tcohe1*ab(i_he) * 2.0_dp / 3.0_dp
    DO j = 3, nused
       cdodj1(j) = tcoh1*ab(i_h) + tcohe1*ab(i_he)
    ENDDO

    DO j = 1, nused-1
       delten = spec_lin(j_sp)%elk(j+1) - spec_lin(j_sp)%elk(j)
       cupdj1(j) = cdodj1(j+1) * (2*j+1) * EXPBOR(-delten / ttry) / (2*j-1)
    ENDDO

!       *************transfert deltaj = 2 *************

    cdodj2(3) = tcoh2*ab(i_h) * 0.5_dp + tcohe2*ab(i_he) / 2.0_dp
    cdodj2(4) = tcoh2*ab(i_h) * 0.5_dp * SQRT(2.0_dp) + tcohe2*ab(i_he) / 1.33_dp

    DO j = 5, nused
       cdodj2(j) = tcoh2*ab(i_h) + tcohe2*ab(i_he)
    ENDDO

    DO j = 1, nused-2
       delten = spec_lin(j_sp)%elk(j+2) - spec_lin(j_sp)%elk(j)
       cupdj2(j) = cdodj2(j+2) * (2*j+3) * EXPBOR(-delten / ttry) / (2*j-1)
    ENDDO

!       *************transfert deltaj = 3 *************

    cdodj3(4) = tcoh3*ab(i_h) / 3.0_dp + tcohe3*ab(i_he) * 0.3_dp
    cdodj3(5) = tcoh3*ab(i_h) + tcohe3*ab(i_he) / 2.0_dp
    DO j = 6, nused
       cdodj3(j) = tcoh3*ab(i_h) + tcohe3*ab(i_he)
    ENDDO

    DO j = 1, nused-3
       delten = spec_lin(j_sp)%elk(j+3) - spec_lin(j_sp)%elk(j)
       cupdj3(j) = cdodj3(j+3) * (2*j+5) * EXPBOR(-delten / ttry) / (2*j-1)
    ENDDO


!       *************transfert deltaj = 4 ************************

    cdodj4(5) = tcoh4*ab(i_h) / 2.0_dp + 0.5e-11_dp*ab(i_he)
    cdodj4(6) = tcoh4*ab(i_h) * 0.8_dp + 1.0e-11_dp*ab(i_he)
    DO j = 7, nused
       cdodj4(j) = tcoh4*ab(i_h) + tcohe4*ab(i_he)
    ENDDO

    DO j = 1, nused-4
       delten = spec_lin(j_sp)%elk(j+4) - spec_lin(j_sp)%elk(j)
       cupdj4(j) = cdodj4(j+4) * (2*j+7) * EXPBOR(-delten / ttry) / (2*j-1)
    ENDDO


!       ************ matrice d'equilibre collisionnel************

    eqcol = 0.0_dp

    eqcol(1,1) = cupdj1(1) + cupdj2(1) + cupdj3(1) + cupdj4(1)
    eqcol(1,2) = - cdodj1(2)
    eqcol(1,3) = - cdodj2(3)
    eqcol(1,4) = - cdodj3(4)
    eqcol(1,5) = - cdodj4(5)

    eqcol(2,1) = - cupdj1(1)
    eqcol(2,2) = cupdj1(2) + cupdj2(2) + cupdj3(2) + cupdj4(2) + cdodj1(2)
    eqcol(2,3) = - cdodj1(3)
    eqcol(2,4) = - cdodj2(4)
    eqcol(2,5) = - cdodj3(5)
    eqcol(2,6) = - cdodj4(6)


    eqcol(3,1) = - cupdj2(1)
    eqcol(3,2) = - cupdj1(2)
    eqcol(3,3) = cupdj1(3) + cupdj2(3) + cupdj3(3) + cupdj4(3) + cdodj1(3) + cdodj2(3)
    eqcol(3,4) = - cdodj1(4)
    eqcol(3,5) = - cdodj2(5)
    eqcol(3,6) = - cdodj3(6)
    eqcol(3,7) = - cdodj4(7)

    eqcol(4,1) = - cupdj3(1)
    eqcol(4,2) = - cupdj2(2)
    eqcol(4,3) = - cupdj1(3)
    eqcol(4,4) = cupdj1(4) + cupdj2(4) + cupdj3(4) + cupdj4(4) + cdodj1(4) + cdodj2(4) + cdodj3(4)
    eqcol(4,5) = - cdodj1(5)
    eqcol(4,6) = - cdodj2(6)
    eqcol(4,7) = - cdodj3(7)
    eqcol(4,8) = - cdodj4(8)

    DO ij = 5, nused-4
       eqcol(ij,ij-4) = - cupdj4(ij-4)
       eqcol(ij,ij-3) = - cupdj3(ij-3)
       eqcol(ij,ij-2) = - cupdj2(ij-2)
       eqcol(ij,ij-1) = - cupdj1(ij-1)
       eqcol(ij,ij) = cdodj1(ij) + cupdj1(ij) + cdodj2(ij) + cupdj2(ij) + cdodj3(ij) &
                    + cupdj3(ij) + cdodj4(ij) + cupdj4(ij)
       eqcol(ij,ij+1) = - cdodj1(ij+1)
       eqcol(ij,ij+2) = - cdodj2(ij+2)
       eqcol(ij,ij+3) = - cdodj3(ij+3)
       eqcol(ij,ij+4) = - cdodj4(ij+4)
    ENDDO


    eqcol(nused-3,nused-7) = - cupdj4(nused-8)
    eqcol(nused-3,nused-6) = - cupdj3(nused-7)
    eqcol(nused-3,nused-5) = - cupdj2(nused-6)
    eqcol(nused-3,nused-4) = - cupdj1(nused-5)
    eqcol(nused-3,nused-3) = cdodj1(nused-4) + cupdj1(nused-4) + cdodj2(nused-4) &
                           + cupdj2(nused-4) + cdodj3(nused-4) + cupdj3(nused-4) + cdodj4(nused-4)
    eqcol(nused-3,nused-2) = - cdodj1(nused-3)
    eqcol(nused-3,nused-1) = - cdodj2(nused-2)
    eqcol(nused-3,nused)   = - cdodj3(nused-1)

    eqcol(nused-2,nused-6) = - cupdj4(nused-7)
    eqcol(nused-2,nused-5) = - cupdj3(nused-6)
    eqcol(nused-2,nused-4) = - cupdj2(nused-5)
    eqcol(nused-2,nused-3) = - cupdj1(nused-4)
    eqcol(nused-2,nused-2) = cdodj1(nused-3) + cupdj1(nused-3) + cdodj2(nused-3) &
                           + cupdj2(nused-3) + cdodj3(nused-3) + cdodj4(nused-3)
    eqcol(nused-2,nused-1) = - cdodj1(nused-2)
    eqcol(nused-2,nused)   = - cdodj2(nused-1)

    eqcol(nused-1,nused-5) = - cupdj4(nused-6)
    eqcol(nused-1,nused-4) = - cupdj3(nused-5)
    eqcol(nused-1,nused-3) = - cupdj2(nused-4)
    eqcol(nused-1,nused-2) = - cupdj1(nused-3)
    eqcol(nused-1,nused-1) = cdodj1(nused-2) + cupdj1(nused-2) + cdodj2(nused-2) &
                           + cdodj3(nused-2) + cdodj4(nused-2)
    eqcol(nused-1,nused) = - cdodj1(nused-1)


    eqcol(nused,nused-4) = - cupdj4(nused-5)
    eqcol(nused,nused-3) = - cupdj3(nused-4)
    eqcol(nused,nused-2) = - cupdj2(nused-3)
    eqcol(nused,nused-1) = - cupdj1(nused-2)
    eqcol(nused,nused)   = cdodj1(nused-1) + cdodj2(nused-1) + cdodj3(nused-1) + cdodj4(nused-1)

    !-- Compute H2 rates ---
    IF (logttry <= tc_co_h2(1)) THEN
       i0 = 1
    ELSE IF (logttry >= tc_co_h2(nt_co_h2)) THEN
       i0 = nt_co_h2
    ELSE
       DO i = 2, nt_co_h2
          IF (logttry <= tc_co_h2(i)) THEN
             i0 = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact = (tc_co_h2(i0) - logttry) / (tc_co_h2(i0) - tc_co_h2(i0+1))
    ! NOTE: there are no rates for c13o18, so we use here co18 instead.
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_ph2 = q_co18_ph2(i0,levu,levl) + fact * (q_co18_ph2(i0+1,levu,levl) - q_co18_ph2(i0,levu,levl))
          r_oh2 = q_co18_oh2(i0,levu,levl) + fact * (q_co18_oh2(i0+1,levu,levl) - q_co18_oh2(i0,levu,levl))
          rdo_ph2 = 10.0_dp**r_ph2
          rdo_oh2 = 10.0_dp**r_oh2
!         print *, levu, levl, rdo_ph2, rdo_oh2
!         print *, "   ", logttry, r_ph2, r_oh2

          ratdo = (rdo_ph2 * h2para + rdo_oh2 * h2orth) * ab(i_h2)
          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO

END SUBROUTINE COLCO3N

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLCO3 (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    INTEGER                                 :: j_sp

    REAL (KIND=dp)                          :: delten
    REAL (KIND=dp)                          :: logttry
    REAL (KIND=dp)                          :: r_h, r_he, rdo_h, rdo_he
    REAL (KIND=dp)                          :: r_oh2, r_ph2, rdo_ph2, rdo_oh2
    REAL (KIND=dp)                          :: ratup, ratdo
    INTEGER                                 :: levu, levl

    j_sp = in_sp(j_c13o18)
    logttry = LOG10(ttry)

    ! Collisions do not exist
    ! Use C18O for H2, and CO for H and He
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_h   = q_co_h(i0_h,levu,levl) &
                + f_h * (q_co_h(i0_h+1,levu,levl) - q_co_h(i0_h,levu,levl))
          r_he  = q_co_he(i0_he,levu,levl) &
                + f_he * (q_co_he(i0_he+1,levu,levl) - q_co_he(i0_he,levu,levl))
          r_ph2 = q_co18_ph2(i0_h2,levu,levl) &
                + f_h2 * (q_co18_ph2(i0_h2+1,levu,levl) - q_co18_ph2(i0_h2,levu,levl))
          r_oh2 = q_co18_oh2(i0_h2,levu,levl) &
                + f_h2 * (q_co18_oh2(i0_h2+1,levu,levl) - q_co18_oh2(i0_h2,levu,levl))
          rdo_h   = 10.0_dp**r_h
          rdo_he  = 10.0_dp**r_he
          rdo_ph2 = 10.0_dp**r_ph2
          rdo_oh2 = 10.0_dp**r_oh2
!         print *, levu, levl, rdo_ph2, rdo_oh2
!         print *, "   ", logttry, r_ph2, r_oh2

          ratdo = (rdo_ph2 * h2para + rdo_oh2 * h2orth) * ab(i_h2) &
                + rdo_h * ab(i_h) + rdo_he * ab(i_he)
          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO

END SUBROUTINE COLCO3

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLCS0 (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    INTEGER                                 :: j_sp, jji, jjf
    INTEGER                                 :: ntc
    REAL (KIND=dp)                          :: tcse1, teffcs, xncol
    REAL (KIND=dp)                          :: ratdo, ratup, energ

    j_sp = in_sp(i_cs)

    tcse1 = 3.0e-6_dp

!-- initialisation de la matrice --
    eqcol= 0.0_dp

!  On limite l intervalle de temperature dans lequel
!     le fit est "valable"

    teffcs = MAX(5.0_dp,ttry)
    teffcs = MIN(teffcs,400.0_dp)

    xncol = ab(i_h2) + 0.5_dp * SQRT(2.0_dp) * ab(i_he)

    DO jji = 1, nused-1
       DO jjf = 0, jji-1
          ntc = jji * (jji-1) / 2 + jjf + 1
          ratdo = cdocs(1,ntc) * teffcs + cdocs(2,ntc) + cdocs(3,ntc) * EXPBOR(-teffcs/cdocs(4,ntc))
          ratdo = ratdo * xncol

          IF ((jji-jjf) == 1) THEN
             ratdo = ratdo + tcse1 * ab(nspec)
          ENDIF

          energ = spec_lin(j_sp)%elk(jji+1)-spec_lin(j_sp)%elk(jjf+1)
          ratup = ratdo * (2.0_dp*jji+1.0_dp) * EXPBOR(-energ / ttry) / (2.0_dp*jjf+1)

          eqcol(jji+1,jji+1) = eqcol(jji+1,jji+1) + ratdo
          eqcol(jji+1,jjf+1) = eqcol(jji+1,jjf+1) - ratup
          eqcol(jjf+1,jjf+1) = eqcol(jjf+1,jjf+1) + ratup
          eqcol(jjf+1,jji+1) = eqcol(jjf+1,jji+1) - ratdo

       ENDDO
    ENDDO

END SUBROUTINE COLCS0

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLHCOP (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!---------------------------------------------------------------------
!       ttry  :temperature du gaz

!       tient compte de 20 niveaux de HCO+
!---------------------------------------------------------------------

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    INTEGER                                 :: j_sp, ju, jl
    REAL (KIND=dp)                          :: teffhco, xncol
    REAL (KIND=dp)                          :: ratdo, ratup, energ
    REAL (KIND=dp)                          :: a1, a2, a3, a4

    j_sp = in_sp(i_hcop)

!-- initialisation de la matrice --
    eqcol= 0.0_dp

!  On limite l intervalle de temperature dans lequel
!     le fit est "valable" (entre 10 et 400 K)

    teffhco = MAX(10.0_dp,ttry)
    teffhco = MIN(teffhco,400.0_dp)

!  comme sur le modele de CS, on ne tient pas cpte du H atomique
! de toute facon, la ou il y a du HCO+, tout l hydrogene est molecul.

! le 0.7 correspond a la vitesse relative de l helium/ H2
    xncol = ab(i_h2) + 0.5_dp * SQRT(2.0_dp) * ab(i_he)

    DO ju = 2, nused
       DO jl = 1, ju-1
          a1 = q_hcop_h2(1,ju,jl)
          a2 = q_hcop_h2(2,ju,jl)
          a3 = q_hcop_h2(3,ju,jl)
          a4 = q_hcop_h2(4,ju,jl)
          ratdo = a1 * teffhco + a2 + a3 * EXPBOR(-teffhco/a4)
          ratdo = ratdo * xncol

          energ = spec_lin(j_sp)%elk(ju) - spec_lin(j_sp)%elk(jl)
          ratup = ratdo * spec_lin(j_sp)%gst(ju) / spec_lin(j_sp)%gst(jl) * EXPBOR(-energ / ttry)

          eqcol(ju,ju) = eqcol(ju,ju) + ratdo
          eqcol(ju,jl) = eqcol(ju,jl) - ratup
          eqcol(jl,jl) = eqcol(jl,jl) + ratup
          eqcol(jl,ju) = eqcol(jl,ju) - ratdo
       ENDDO
    ENDDO

END SUBROUTINE COLHCOP

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLCHP (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!---------------------------------------------------------------------
!       ttry  :temperature du gaz
!       tient compte de 11 niveaux de CH+
!---------------------------------------------------------------------

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    INTEGER                                 :: levl, levu
    INTEGER                                 :: i, j_sp
    REAL (KIND=dp)                          :: fact_he
    REAL (KIND=dp)                          :: fact_e
    REAL (KIND=dp)                          :: delten, logttry
    REAL (KIND=dp)                          :: r_he
    REAL (KIND=dp)                          :: rdo_he
    REAL (KIND=dp)                          :: r_e
    REAL (KIND=dp)                          :: rdo_e
    REAL (KIND=dp)                          :: ratdo, ratup

    j_sp = in_sp(i_chp)
    logttry = LOG10(ttry)

    !-- Compute He rates. H2 estimated by mass scaling
    !-- Find the temperature point in CH+ collisions with He
    IF (logttry <= tempcchp_he(1)) THEN
       i0_he = 1
    ELSE IF (logttry >= tempcchp_he(nttchp_he)) THEN
       i0_he = nttchp_he
    ELSE
       DO i = 2, nttchp_he
          IF (logttry <= tempcchp_he(i)) THEN
             i0_he = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact_he = (tempcchp_he(i0_he) - logttry) / (tempcchp_he(i0_he) - tempcchp_he(i0_he+1))

    !--- Find the temperature point in CH+ collisions with electrons
    IF (logttry <= tempcchp_e(1)) THEN
       i0_e = 1
    ELSE IF (logttry >= tempcchp_e(nttchp_e)) THEN
       i0_e = nttchp_e
    ELSE
       DO i = 2, nttchp_e
          IF (logttry <= tempcchp_e(i)) THEN
             i0_e = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact_e = (tempcchp_e(i0_e) - logttry) / (tempcchp_e(i0_e) - tempcchp_e(i0_e+1))

    !--- Compute collision rates
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_he = q_chp_he(i0_he,levu,levl) + fact_he * (q_chp_he(i0_he+1,levu,levl) - q_chp_he(i0_he,levu,levl))
          rdo_he = 10.0_dp**r_he

          r_e  = q_chp_e(i0_e,levu,levl) + fact_e * (q_chp_e(i0_e+1,levu,levl) - q_chp_e(i0_e,levu,levl))
          rdo_e = 10.0_dp**r_e

          ratdo = rdo_he * ab(i_he) + rdo_he * SQRT(2.0_dp) * ab(i_h2) + rdo_e * ab(nspec)
          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO
END SUBROUTINE COLCHP

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLOH (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!---------------------------------------------------------------------
!       ttry  :temperature du gaz

!       tient compte de 11 niveaux de CH+
!---------------------------------------------------------------------

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    INTEGER                                 :: levl, levu
    INTEGER                                 :: i, i0, j_sp
    REAL (KIND=dp)                          :: fact, delten, logttry
    REAL (KIND=dp)                          :: r_ph2, rdo_ph2
    REAL (KIND=dp)                          :: r_oh2, rdo_oh2
    REAL (KIND=dp)                          :: ratdo, ratup

    j_sp = in_sp(i_oh)
    logttry = LOG10(ttry)

    IF (logttry <= tempcoh(1)) THEN
       i0 = 1
    ELSE IF (logttry >= tempcoh(nttoh)) THEN
       i0 = nttoh
    ELSE
       DO i = 2, nttoh
          IF (logttry <= tempcoh(i)) THEN
             i0 = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact = (tempcoh(i0) - logttry) / (tempcoh(i0) - tempcoh(i0+1))

    ! Only collision with H2 are given up to now
    !      Collisions with He estimated by a simple scaling
    !      Collisions with H unknown...
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_ph2 = q_oh_ph2(i0,levu,levl) + fact * (q_oh_ph2(i0+1,levu,levl) - q_oh_ph2(i0,levu,levl))
          r_oh2 = q_oh_oh2(i0,levu,levl) + fact * (q_oh_oh2(i0+1,levu,levl) - q_oh_oh2(i0,levu,levl))
          rdo_ph2 = 10.0_dp**r_ph2
          rdo_oh2 = 10.0_dp**r_oh2

          ratdo = rdo_ph2 * (h2para  * ab(i_h2) + 0.5_dp * SQRT(2.0_dp) * ab(i_he)) &
                + rdo_oh2 * h2orth * ab(i_h2)
          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO

END SUBROUTINE COLOH

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLH2O (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_He
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec_H2
    REAL (KIND=dp), DIMENSION (nused,nused) :: ec
    INTEGER                                 :: j_sp, jl, ju

    j_sp = in_sp(i_h2o)

    ec_H2 = colr_min
    ec_He = colr_min

!  a-collisions with H2
! We have made our own fit

    DO jl = 1, nused-1
       DO ju = jl+1, nused
          ec_H2(jl,ju) = 10.0_dp**(q_h2o_h2_1(ju,jl) + q_h2o_h2_2(ju,jl) / (q_h2o_h2_3(ju,jl) + ttry * 1e-3_dp))
       ENDDO
    ENDDO

!  b-collisions with He
! We have made our own fit with the dates from Green et al. (1993)

    DO jl = 1, nused-1
       DO ju = jl+1, nused
          ec_He(jl,ju) = 10.0_dp**(q_h2o_he_1(ju,jl) + q_h2o_he_2(ju,jl) / (q_h2o_he_3(ju,jl) + ttry * 1e-3_dp))
       ENDDO
    ENDDO

!  Bring em together

   ec = 0.0_dp
   DO jl = 1, nused-1
      DO ju = jl+1, nused
         ec(jl,ju) = ec_H2(jl,ju) * ab(i_h2) + ec_He(jl,ju) * ab(i_he)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         ec(ju,jl) = ec(jl,ju) * (spec_lin(j_sp)%gst(ju)/spec_lin(j_sp)%gst(jl)) &
                   * EXPBOR(-(spec_lin(j_sp)%elk(ju)-spec_lin(j_sp)%elk(jl))/ttry)
      ENDDO
   ENDDO

   eqcol = 0.0_dp

   DO jl = 1, nused-1
      DO ju = jl+1, nused
         eqcol(jl,ju) = eqcol(jl,ju) - ec(jl,ju)
         eqcol(ju,ju) = eqcol(ju,ju) + ec(jl,ju)
      ENDDO
   ENDDO

   DO ju = 2, nused
      DO jl = 1, ju-1
         eqcol(ju,jl) = eqcol(ju,jl) - ec(ju,jl)
         eqcol(jl,jl) = eqcol(jl,jl) + ec(ju,jl)
      ENDDO
   ENDDO

END SUBROUTINE COLH2O

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLH3P (ttry, nused, iopt)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

    IMPLICIT NONE

    REAL(KIND=dp), INTENT (IN) :: ttry     ! temperature en Kelvins
    INTEGER,       INTENT (IN) :: nused    ! Number of H3+ levels used
    INTEGER,       INTENT (IN) :: iopt

    REAL (KIND=dp), PARAMETER :: C_lange = 2.0e-09_dp   ! Langevin H3+ + H2
   !REAL (KIND=dp), PARAMETER :: C_lange = 2.0e-10_dp   ! Langevin H3+ + H2 / 10
   !REAL (KIND=dp), PARAMETER :: C_lange = 2.0e-11_dp   ! Langevin H3+ + H2 / 100

    REAL(KIND=dp)             :: xncol     ! densite de collisionneurs (en cm-3)
    INTEGER                   :: levu      ! numero du niveau haut
    INTEGER                   :: levl      ! numero du niveau bas
    INTEGER                   :: levint    ! numero d'un niveau intermediaire
    REAL(KIND=dp)             :: gu, gl    ! Degenerescences des niveaux hauts et bas
    REAL(KIND=dp)             :: E         ! E etat haut moins E etat bas en Kelvin
    REAL(KIND=dp)             :: c_ul      ! intermediaire de calcul Oka
    REAL(KIND=dp)             :: prod_g, rap_g, fact_g, ener_moy ! intermediaires
                                                     ! de calcul
    REAL(KIND=dp)             :: ratup     ! taux de coll du bas vers le haut (cm3 s-1)
    REAL(KIND=dp)             :: ratdo     ! taux de coll du haut vers le bas (cm3 s-1)
    INTEGER                   :: j_sp

    REAL(KIND=dp)             :: delten    ! Difference of energy upper - lower [K]
    REAL(KIND=dp)             :: logttry   ! log 10 of the temperature
    INTEGER                   :: i0_ph2    ! Index of the temperature in coll. data - para case
    INTEGER                   :: i0_oh2    ! Index of the temperature in coll. data - ortho case
    REAL(KIND=dp)             :: fact_ph2  ! Used for linear interpolation
    REAL(KIND=dp)             :: fact_oh2  ! Used for linear interpolation
    REAL(KIND=dp)             :: r_ph2     ! Collision rate H3+ + H2-para  at temperature ttry [cm+3 s-1]
    REAL(KIND=dp)             :: r_oh2     ! Collision rate H3+ + H2-ortho at temperature ttry [cm+3 s-1]
    REAL(KIND=dp)             :: nh2J0     ! Density of H2 in J=0 [cm-3]
    REAL(KIND=dp)             :: nh2J1     ! Density of H2 in J=1 [cm-3]

    INTEGER                   :: i

    j_sp = in_sp(i_h3p)

    !-- initialisation de la matrice --
    eqcol(:,:) = 0.0_dp

    SELECT CASE (F_COLL_H3p)
       CASE (0) ! Collision rates by Roncero et al.
                ! Roncera data are provided up to level 24 of H3+
                ! If there are more than 24 levels in the model, we complete collision rates with
                ! Oka and Epp (2004) prescription.

            logttry = LOG10(ttry)

            !--------------------------------------------------------------------------------------------
            ! Build collisionnal matrix with Roncerao collision rates
            !--------------------------------------------------------------------------------------------

            nh2J0 = xreh2(1,iopt) * ab(i_h2)  ! density of H2 in J = 0 [cm-3]
            nh2J1 = xreh2(2,iopt) * ab(i_h2)  ! density of H2 in J = 1 [cm-3]

            !-- Find the temperature point in H3+ collisions with para-H2
            IF (logttry <= tempch3p_ph2(1)) THEN
               i0_ph2 = 1
            ELSE IF (logttry >= tempch3p_ph2(ntth3p_ph2)) THEN
               i0_ph2 = ntth3p_ph2
            ELSE
               DO i = 2, ntth3p_ph2
                  IF (logttry <= tempch3p_ph2(i)) THEN
                     i0_ph2 = i-1
                     EXIT
                  ENDIF
               ENDDO
            ENDIF
            fact_ph2 = (tempch3p_ph2(i0_ph2) - logttry) / (tempch3p_ph2(i0_ph2) - tempch3p_ph2(i0_ph2+1))

            !--- Find the temperature point in H3+ collisions with ortho-H2
            IF (logttry <= tempch3p_oh2(1)) THEN
               i0_oh2 = 1
            ELSE IF (logttry >= tempch3p_oh2(ntth3p_oh2)) THEN
               i0_oh2 = ntth3p_oh2
            ELSE
               DO i = 2, ntth3p_oh2
                  IF (logttry <= tempch3p_oh2(i)) THEN
                     i0_oh2 = i-1
                     EXIT
                  ENDIF
               ENDDO
            ENDIF
            fact_oh2 = (tempch3p_oh2(i0_oh2) - logttry) / (tempch3p_oh2(i0_oh2) - tempch3p_oh2(i0_oh2+1))

            !--- Compute collision rates
            DO levu = 2, MIN(n_H3p_Roncero, nused)  ! initial level
               DO levl = 1, levu-1                  ! final level

                  delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

                  r_ph2 = q_h3p_ph2(i0_ph2,levu,levl) &
                        + fact_ph2 * (q_h3p_ph2(i0_ph2+1,levu,levl) - q_h3p_ph2(i0_ph2,levu,levl))
                  r_ph2 = 10.0_dp**r_ph2

                  r_oh2 = q_h3p_oh2(i0_oh2,levu,levl) &
                        + fact_oh2 * (q_h3p_oh2(i0_oh2+1,levu,levl) - q_h3p_oh2(i0_oh2,levu,levl))
                  r_oh2 = 10.0_dp**r_oh2

                  ratdo = r_ph2 * nh2J0 + r_oh2 * nh2J1   &
                        + r_ph2 / SQRT(2.0_dp) * ab(i_he) &
                        + r_ph2 * ab(i_h) ! ??? more complex because of reactive collisions

                  ratup = ratdo * EXPBOR(-delten / ttry) &
                        * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

                  eqcol(levu,levu) = eqcol(levu,levu) + ratdo
                  eqcol(levu,levl) = eqcol(levu,levl) - ratup
                  eqcol(levl,levl) = eqcol(levl,levl) + ratup
                  eqcol(levl,levu) = eqcol(levl,levu) - ratdo

               ENDDO
            ENDDO

            !--------------------------------------------------------------------------------------------
            ! Complete the collisionnal matrix with Oka and Epp (2004) prescription
            !--------------------------------------------------------------------------------------------
            DO levu = n_H3p_Roncero + 1, nused
               DO levl = 1, levu-1
                  gl = spec_lin(j_sp)%gst(levl)
                  gu = spec_lin(j_sp)%gst(levu)
                  prod_g = gl * gu
                  ener_moy = (spec_lin(j_sp)%elk(levl) + spec_lin(j_sp)%elk(levu)) / 2.0_dp
                  c_ul = 0.0_dp
                  DO levint = 1, nused
                     IF (      (levint /= levl) .AND. (levint /= levu)) THEN
                        fact_g = SQRT(spec_lin(j_sp)%gst(levint) / SQRT(prod_g))
                        c_ul = c_ul + fact_g * EXPBOR(- (spec_lin(j_sp)%elk(levint) - ener_moy) / (2.0_dp * ttry))
                     ENDIF
                  ENDDO

                  ! calcul du taux d'excitation
                  c_ul = C_lange / (1.0_dp + c_ul)
                  rap_g = gu / gl
                  E     = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)
                  ratup = c_ul * SQRT(rap_g) * EXPBOR(-(E / 2.0 / ttry))

                  ! calcul du taux de desexcitation
                  ! rap_g = gl / gu
                  ! E     = spec_lin(j_sp)%elk(levl) - spec_lin(j_sp)%elk(levu)
                  !         eqcolp(levu,levl) = c_ul * SQRT(rap_g) * EXPBOR(-(E / 2.0/ ttry))
                  E     = spec_lin(j_sp)%elk(levl) - spec_lin(j_sp)%elk(levu)
                  ratdo = ratup * gl / gu * EXPBOR(-(E)/ttry)

                  eqcol(levu,levu) = eqcol(levu,levu) + ratdo
                  eqcol(levu,levl) = eqcol(levu,levl) - ratup
                  eqcol(levl,levl) = eqcol(levl,levl) + ratup
                  eqcol(levl,levu) = eqcol(levl,levu) - ratdo

               ENDDO
            ENDDO

       CASE (1) ! Les taux de desexcitation valent la constante de Langevin
            DO levu = 2, nused
               DO levl = 1, levu-1
                  ratdo = C_lange
                  gu = spec_lin(j_sp)%gst(levu)
                  gl = spec_lin(j_sp)%gst(levl)
                  E  = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)
                  ratup = C_lange * gu / gl * EXPBOR(-(E/ttry))

                  eqcol(levu,levu) = eqcol(levu,levu) + ratdo
                  eqcol(levu,levl) = eqcol(levu,levl) - ratup
                  eqcol(levl,levl) = eqcol(levl,levl) + ratup
                  eqcol(levl,levu) = eqcol(levl,levu) - ratdo

               ENDDO
            ENDDO

           ! ATTENTION : La constante de Langevin n'est pas la meme pour ces trois especes
           !             Il faudrait faire quelque chose de mieux
           !             Le 0.7 correspond a la vitesse relative de l'helium/ H2
           xncol = ab(i_h2) + ab(i_h) + 0.5_dp * SQRT(2.0_dp) *ab(i_he)
           eqcol(:,:) = eqcol(:,:) * xncol

       CASE (2) ! Taux d'apres Oka et Epp ApJ, 613, 2004
            DO levl = 1, nused-1
               DO levu = levl+1, nused
                  gl = spec_lin(j_sp)%gst(levl)
                  gu = spec_lin(j_sp)%gst(levu)
                  prod_g = gl * gu
                  ener_moy = (spec_lin(j_sp)%elk(levl) + spec_lin(j_sp)%elk(levu)) / 2.0_dp
                  c_ul = 0.0_dp
                  DO levint = 1, nused
                     IF (      (levint /= levl) .AND. (levint /= levu)) THEN
                        fact_g = SQRT(spec_lin(j_sp)%gst(levint) / SQRT(prod_g))
                        c_ul = c_ul + fact_g * EXPBOR(- (spec_lin(j_sp)%elk(levint) - ener_moy) / (2.0_dp * ttry))
                     ENDIF
                  ENDDO

                  ! calcul du taux d'excitation
                  c_ul = C_lange / (1.0_dp + c_ul)
                  rap_g = gu / gl
                  E     = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)
                  ratup = c_ul * SQRT(rap_g) * EXPBOR(-(E / 2.0 / ttry))

                  ! calcul du taux de desexcitation
                  ! rap_g = gl / gu
                  ! E     = spec_lin(j_sp)%elk(levl) - spec_lin(j_sp)%elk(levu)
                  !         eqcolp(levu,levl) = c_ul * SQRT(rap_g) * EXPBOR(-(E / 2.0/ ttry))
                  E     = spec_lin(j_sp)%elk(levl) - spec_lin(j_sp)%elk(levu)
                  ratdo = ratup * gl / gu * EXPBOR(-(E)/ttry)

                  eqcol(levu,levu) = eqcol(levu,levu) + ratdo
                  eqcol(levu,levl) = eqcol(levu,levl) - ratup
                  eqcol(levl,levl) = eqcol(levl,levl) + ratup
                  eqcol(levl,levu) = eqcol(levl,levu) - ratdo

               ENDDO
            ENDDO

           ! ATTENTION : La constante de Langevin n'est pas la meme pour ces trois especes
           !             Il faudrait faire quelque chose de mieux
           !             Le 0.7 correspond a la vitesse relative de l'helium/ H2
           xncol = ab(i_h2) + ab(i_h) + 0.5_dp * SQRT(2.0_dp) *ab(i_he)
           eqcol(:,:) = eqcol(:,:) * xncol

       CASE (3) ! JLB - 9 VII 2008 - Simpler complete redistribution

            DO levu = 2, nused
               gu = spec_lin(j_sp)%gst(levu)
               c_ul = 0.0_dp
               DO levint = 1, levu-1
                  c_ul = c_ul + spec_lin(j_sp)%gst(levint)
               ENDDO
               DO levl = 1, levu-1
                  gl = spec_lin(j_sp)%gst(levl)
                  ratdo = C_lange * gl / c_ul
                  E     = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)
                  ratup = ratdo * gu / gl * EXPBOR(-(E)/ttry)

                  eqcol(levu,levu) = eqcol(levu,levu) + ratdo
                  eqcol(levu,levl) = eqcol(levu,levl) - ratup
                  eqcol(levl,levl) = eqcol(levl,levl) + ratup
                  eqcol(levl,levu) = eqcol(levl,levu) - ratdo
               ENDDO
            ENDDO

           ! ATTENTION : La constante de Langevin n'est pas la meme pour ces trois especes
           !             Il faudrait faire quelque chose de mieux
           !             Le 0.7 correspond a la vitesse relative de l'helium/ H2
           xncol = ab(i_h2) + ab(i_h) + 0.5_dp * SQRT(2.0_dp) *ab(i_he)
           eqcol(:,:) = eqcol(:,:) * xncol

    END SELECT

END SUBROUTINE COLH3P

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLHCN (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!---------------------------------------------------------------------
!       ttry  :temperature du gaz
!       tient compte des niveaux de HCN
!---------------------------------------------------------------------

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

    IMPLICIT NONE

    REAL(KIND=dp), INTENT (IN) :: ttry     ! temperature en Kelvins
    INTEGER,       INTENT (IN) :: nused

    CHARACTER(len=4)          :: s_ju, s_jl, s_fu, s_fl
    INTEGER                   :: j_sp, ju, jl
    INTEGER                   :: fu, fl, nu, nl
    REAL (KIND=dp)            :: t_red, xncol, ratdo, ratup, energ
    REAL (KIND=dp)            :: a1, a2, a3, a4, a5, a6

    j_sp = in_sp(i_hcn)

!-- initialisation de la matrice --
    eqcol= 0.0_dp

    t_red = MAX(ttry,10.0_dp) * 1.0e-3_dp

!  comme sur le modele de CS, on ne tient pas cpte du H atomique
! de toute facon, la ou il y a du HCN, tout l'hydrogene est molecul.

! le 0.7 correspond a la vitesse relative de l'helium/ H2
    xncol = ab(i_h2) + 0.5_dp * SQRT(2.0_dp) * ab(i_he)

    DO nu = 2, nused
       DO nl = 1, nu-1
          s_ju = spec_lin(j_sp)%quant(nu,1)
          s_jl = spec_lin(j_sp)%quant(nl,1)
          CALL STR_INT(s_ju, ju)
          CALL STR_INT(s_jl, jl)

          IF (ju > jl) THEN
             a1 = q_hcn_h2(1,ju,jl)
             a2 = q_hcn_h2(2,ju,jl)
             a3 = q_hcn_h2(3,ju,jl)
             a4 = q_hcn_h2(4,ju,jl)
             a5 = q_hcn_h2(5,ju,jl)
             a6 = q_hcn_h2(6,ju,jl)
             ratdo = a1 + a2/(t_red+a3) + (a4*t_red+a5)/(t_red+a6)
             ratdo = EXPBOR(ratdo*l_10)            ! l_10 = LOG(10.0_dp)
             IF (jl <= 2) THEN                     ! J level is split into hyperfine levels
                s_fl = spec_lin(j_sp)%quant(nl,2)
                CALL STR_INT(s_fl, fl)
                ratdo = ratdo * (2.0_dp * fl + 1.0_dp) / (3.0_dp * (2.0_dp * jl + 1.0_dp))
             ENDIF
          ELSE IF (ju == 1) THEN
             s_fu = spec_lin(j_sp)%quant(nu,2)
             s_fl = spec_lin(j_sp)%quant(nl,2)
             CALL STR_INT(s_fu, fu)
             CALL STR_INT(s_fl, fl)

             IF (fl == 1 .AND. fu == 2) THEN
                ratdo = 1.55e-10_dp * ttry**(-0.214_dp) * (2.0_dp * fl + 1.0_dp) / (2.0_dp * fu + 1.0_dp)
             ELSE IF (fl == 1 .AND. fu == 0) THEN
                ratdo = 9.53e-11_dp * ttry**(-0.372_dp) * (2.0_dp * fl + 1.0_dp) / (2.0_dp * fu + 1.0_dp)
             ELSE IF (fl == 2 .AND. fu == 0) THEN
                ratdo = 1.45e-11_dp * ttry**(-0.080_dp) * (2.0_dp * fl + 1.0_dp) / (2.0_dp * fu + 1.0_dp)
             ENDIF
          ELSE IF (ju == 2) THEN
             s_fu = spec_lin(j_sp)%quant(nu,2)
             s_fl = spec_lin(j_sp)%quant(nl,2)
             CALL STR_INT(s_fu, fu)
             CALL STR_INT(s_fl, fl)

             IF (fl == 2 .AND. fu == 3) THEN
                ratdo = 1.41e-10_dp * ttry**(-0.229_dp) * (2.0_dp * fl + 1.0_dp) / (2.0_dp * fu + 1.0_dp)
             ELSE IF (fl == 2 .AND. fu == 1) THEN
                ratdo = 1.11e-10_dp * ttry**(-0.262_dp) * (2.0_dp * fl + 1.0_dp) / (2.0_dp * fu + 1.0_dp)
             ELSE IF (fl == 3 .AND. fu == 1) THEN
                ratdo = 2.61e-11_dp * ttry**(-0.197_dp) * (2.0_dp * fl + 1.0_dp) / (2.0_dp * fu + 1.0_dp)
             ENDIF
          ENDIF
          ratdo = ratdo * xncol

          energ = spec_lin(j_sp)%elk(nu) - spec_lin(j_sp)%elk(nl)
          ratup = ratdo * spec_lin(j_sp)%gst(nu) / spec_lin(j_sp)%gst(nl) * EXPBOR(-energ / ttry)

          eqcol(nu,nu) = eqcol(nu,nu) + ratdo
          eqcol(nu,nl) = eqcol(nu,nl) - ratup
          eqcol(nl,nl) = eqcol(nl,nl) + ratup
          eqcol(nl,nu) = eqcol(nl,nu) - ratdo
       ENDDO
    ENDDO

END SUBROUTINE COLHCN

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLO2 (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

   IMPLICIT NONE

   REAL(KIND=dp), INTENT (IN) :: ttry     ! temperature en Kelvins
   INTEGER,       INTENT (IN) :: nused

   INTEGER                    :: levu, levl            ! Index of lower and upper level
   INTEGER                    :: j_sp                  ! Index of O2 in spec_lin
   REAL(KIND=DP)              :: ratup_he, ratdo_he    ! Excitation and de-excitation rate with He
   REAL(KIND=DP)              :: ratup_h2, ratdo_h2    ! Excitation and de-excitation rate with H2
   REAL(KIND=DP)              :: ratup, ratdo          ! Total excitation and de-excitation rates
   REAL(KIND=DP)              :: gu, gl                ! Upper and lower level degeneracies
   REAL(KIND=DP)              :: Eup, Elow             ! Upper and lower level energy in Kelvin
   REAL(KIND=DP)              :: eps, a0, a1, a2, a3   ! Fit coefficients of the BASECOL formula
   REAL(KIND=DP)              :: a4, a5, a6            ! Fit coefficients of the BASECOL formula

   j_sp = in_sp(i_o2 )

   !-- Compute rates ---
   eqcol(:,:) = 0.0_dp
   DO levu = 2, nused
      DO levl = 1, levu-1

         ! Fit following BASECOL formula with N = 6 (FLP)
         eps = q_o2_he(1,levu,levl)
         a0  = q_o2_he(2,levu,levl)
         a1  = q_o2_he(3,levu,levl)
         a2  = q_o2_he(4,levu,levl)
         a3  = q_o2_he(5,levu,levl)
         a4  = q_o2_he(6,levu,levl)
         a5  = q_o2_he(7,levu,levl)
         a6  = q_o2_he(8,levu,levl)
         ratdo_he = a0 + a1 * (LOG10(ttry/eps))             &
                       + a2 * (LOG10(ttry/eps))**(2.0_dp)   &
                       + a3 * (LOG10(ttry/eps))**(3.0_dp)   &
                       + a4 * (LOG10(ttry/eps))**(4.0_dp)   &
                       + a5 * (LOG10(ttry/eps))**(5.0_dp)   &
                  + a6 * (1.0_dp / (ttry/eps + eps) - 1.0_dp)   ! cm+3 s-1
         ratdo_he = 10.0_dp**(ratdo_he)

         gu   = spec_lin(j_sp)%gst(levu)
         gl   = spec_lin(j_sp)%gst(levl)
         Eup  = spec_lin(j_sp)%Elk(levu)
         Elow = spec_lin(j_sp)%Elk(levl)
         ratup_he = ratdo_he * gu / gl * EXP(-(Eup - Elow)/ttry)

         ratup_h2 = ratup_he * SQRT(2.0_dp)
         ratdo_h2 = ratdo_he * SQRT(2.0_dp)

         ratup = ratup_he * ab(i_he) + ratup_h2 * ab(i_h2)
         ratdo = ratdo_he * ab(i_he) + ratdo_h2 * ab(i_h2)

         eqcol(levu,levu) = eqcol(levu,levu) + ratdo
         eqcol(levu,levl) = eqcol(levu,levl) - ratup
         eqcol(levl,levl) = eqcol(levl,levl) + ratup
         eqcol(levl,levu) = eqcol(levl,levu) - ratdo
      ENDDO
   ENDDO

END SUBROUTINE COLO2

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLOHP (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!---------------------------------------------------------------------
!       ttry  :temperature du gaz
!---------------------------------------------------------------------

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    INTEGER                                 :: levl, levu
    INTEGER                                 :: i, j_sp
    REAL (KIND=dp)                          :: fact_h2
    REAL (KIND=dp)                          :: fact_e
    REAL (KIND=dp)                          :: delten, logttry
    REAL (KIND=dp)                          :: r_h2
    REAL (KIND=dp)                          :: rdo_h2
    REAL (KIND=dp)                          :: r_e
    REAL (KIND=dp)                          :: rdo_e
    REAL (KIND=dp)                          :: ratdo, ratup

    j_sp = in_sp(i_ohp)
    logttry = LOG10(ttry)

    !-- Find the temperature point in OH+ collisions with H2
    IF (logttry <= tempcohp_h2(1)) THEN
       i0_h2 = 1
    ELSE IF (logttry >= tempcohp_h2(nttohp_h2)) THEN
       i0_h2 = nttohp_h2
    ELSE
       DO i = 2, nttohp_h2
          IF (logttry <= tempcohp_h2(i)) THEN
             i0_h2 = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact_h2 = (tempcohp_h2(i0_h2) - logttry) / (tempcohp_h2(i0_h2) - tempcohp_h2(i0_h2+1))

    !--- Find the temperature point in CH+ collisions with electrons
    IF (logttry <= tempcohp_e(1)) THEN
       i0_e = 1
    ELSE IF (logttry >= tempcohp_e(nttohp_e)) THEN
       i0_e = nttohp_e
    ELSE
       DO i = 2, nttohp_e
          IF (logttry <= tempcohp_e(i)) THEN
             i0_e = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact_e = (tempcohp_e(i0_e) - logttry) / (tempcohp_e(i0_e) - tempcohp_e(i0_e+1))

    !--- Compute collision rates
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_h2 = q_ohp_h2(i0_h2,levu,levl) + fact_h2 * (q_ohp_h2(i0_h2+1,levu,levl) - q_ohp_h2(i0_h2,levu,levl))
          rdo_h2 = 10.0_dp**r_h2

          r_e  = q_ohp_e(i0_e,levu,levl) + fact_e * (q_ohp_e(i0_e+1,levu,levl) - q_ohp_e(i0_e,levu,levl))
          rdo_e = 10.0_dp**r_e

          ratdo = rdo_h2 * ab(i_h2) + rdo_h2 / SQRT(2.0_dp) * ab(i_he) + rdo_e * ab(nspec)

          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo

       ENDDO
    ENDDO
END SUBROUTINE COLOHP

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLSHP (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!---------------------------------------------------------------------
!       ttry  :temperature du gaz
!---------------------------------------------------------------------

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    INTEGER                                 :: levl, levu
    INTEGER                                 :: i, j_sp
    REAL (KIND=dp)                          :: fact_h2
    REAL (KIND=dp)                          :: fact_e
    REAL (KIND=dp)                          :: delten, logttry
    REAL (KIND=dp)                          :: r_h2
    REAL (KIND=dp)                          :: rdo_h2
    REAL (KIND=dp)                          :: r_e
    REAL (KIND=dp)                          :: rdo_e
    REAL (KIND=dp)                          :: ratdo, ratup

    j_sp = in_sp(i_shp)
    logttry = LOG10(ttry)

    !-- Find the temperature point in SH+ collisions with H2
    IF (logttry <= tempcshp_h2(1)) THEN
       i0_h2 = 1
    ELSE IF (logttry >= tempcshp_h2(nttshp_h2)) THEN
       i0_h2 = nttshp_h2
    ELSE
       DO i = 2, nttshp_h2
          IF (logttry <= tempcshp_h2(i)) THEN
             i0_h2 = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact_h2 = (tempcshp_h2(i0_h2) - logttry) / (tempcshp_h2(i0_h2) - tempcshp_h2(i0_h2+1))

    !--- Find the temperature point in CH+ collisions with electrons
    IF (logttry <= tempcshp_e(1)) THEN
       i0_e = 1
    ELSE IF (logttry >= tempcshp_e(nttshp_e)) THEN
       i0_e = nttshp_e
    ELSE
       DO i = 2, nttshp_e
          IF (logttry <= tempcshp_e(i)) THEN
             i0_e = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact_e = (tempcshp_e(i0_e) - logttry) / (tempcshp_e(i0_e) - tempcshp_e(i0_e+1))

    !--- Compute collision rates
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_h2 = q_shp_h2(i0_h2,levu,levl) + fact_h2 * (q_shp_h2(i0_h2+1,levu,levl) - q_shp_h2(i0_h2,levu,levl))
          rdo_h2 = 10.0_dp**r_h2

          r_e  = q_shp_e(i0_e,levu,levl) + fact_e * (q_shp_e(i0_e+1,levu,levl) - q_shp_e(i0_e,levu,levl))
          rdo_e = 10.0_dp**r_e

          ratdo = rdo_h2 * ab(i_h2) + rdo_h2 / SQRT(2.0_dp) * ab(i_he) + rdo_e * ab(nspec)

          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO
END SUBROUTINE COLSHP

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLARHP (ttry, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!---------------------------------------------------------------------
!       ttry  :temperature du gaz
!       tient compte de 14 niveaux de ArH+
!---------------------------------------------------------------------

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

    IMPLICIT NONE

    REAL (KIND=dp), INTENT (IN)             :: ttry
    INTEGER, INTENT (IN)                    :: nused

    INTEGER                                 :: levl, levu
    INTEGER                                 :: i, j_sp
    REAL (KIND=dp)                          :: fact_he
    REAL (KIND=dp)                          :: fact_e
    REAL (KIND=dp)                          :: delten, logttry
    REAL (KIND=dp)                          :: r_he
    REAL (KIND=dp)                          :: rdo_he
    REAL (KIND=dp)                          :: r_e
    REAL (KIND=dp)                          :: rdo_e
    REAL (KIND=dp)                          :: ratdo, ratup

    j_sp = in_sp(i_arhp)
    logttry = LOG10(ttry)

    !-- Compute He rates. H2 and H estimated by mass scaling.
    !-- Find the temperature point in ArH+ collisions with He
    IF (logttry <= tempcarhp_he(1)) THEN
       i0_he = 1
    ELSE IF (logttry >= tempcarhp_he(nttarhp_he)) THEN
       i0_he = nttarhp_he
    ELSE
       DO i = 2, nttarhp_he
          IF (logttry <= tempcarhp_he(i)) THEN
             i0_he = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact_he = (tempcarhp_he(i0_he) - logttry) / (tempcarhp_he(i0_he) - tempcarhp_he(i0_he+1))

    !--- Find the temperature point in ArH+ collisions with electrons
    IF (logttry <= tempcarhp_e(1)) THEN
       i0_e = 1
    ELSE IF (logttry >= tempcarhp_e(nttarhp_e)) THEN
       i0_e = nttarhp_e
    ELSE
       DO i = 2, nttarhp_e
          IF (logttry <= tempcarhp_e(i)) THEN
             i0_e = i-1
             EXIT
          ENDIF
       ENDDO
    ENDIF
    fact_e = (tempcarhp_e(i0_e) - logttry) / (tempcarhp_e(i0_e) - tempcarhp_e(i0_e+1))

    !--- Compute collision rates
    DO levu = 2, nused
       DO levl = 1, levu-1
          delten = spec_lin(j_sp)%elk(levu) - spec_lin(j_sp)%elk(levl)

          r_he = q_arhp_he(i0_he,levu,levl) + fact_he * (q_arhp_he(i0_he+1,levu,levl) - q_arhp_he(i0_he,levu,levl))
          rdo_he = 10.0_dp**r_he

          r_e  = q_arhp_e(i0_e,levu,levl) + fact_e * (q_arhp_e(i0_e+1,levu,levl) - q_arhp_e(i0_e,levu,levl))
          rdo_e = 10.0_dp**r_e

          ratdo = rdo_he * ab(i_he) &
                + rdo_he * SQRT(4.0_dp) * ab(i_h) &
                + rdo_he * SQRT(2.0_dp) * ab(i_h2) &
                + rdo_e * ab(nspec)
          ratup = ratdo * EXPBOR(-delten / ttry) &
                * spec_lin(j_sp)%gst(levu) / spec_lin(j_sp)%gst(levl)

          eqcol(levu,levu) = eqcol(levu,levu) + ratdo
          eqcol(levu,levl) = eqcol(levu,levl) - ratup
          eqcol(levl,levl) = eqcol(levl,levl) + ratup
          eqcol(levl,levu) = eqcol(levl,levu) - ratdo
       ENDDO
    ENDDO
END SUBROUTINE COLARHP

END MODULE PXDR_COLSPE
