
! 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.


MODULE PXDR_STR_DATA

! Structure and transfer related quantities for:
!     CO, 13CO, C18O, 13C18O, CS, HCO+, H2O, H3+
!     C, N, O, S, Si, C+, N+, O+, S+, Si+

USE PXDR_CONSTANTES

  TYPE (SPECTRA), PUBLIC, DIMENSION (:), ALLOCATABLE    :: spec_lin    ! Full spectra
  INTEGER, PUBLIC                                       :: nspl        ! Number of species with detailed balance computed
  INTEGER, PUBLIC, DIMENSION (:), ALLOCATABLE           :: in_sp       ! index in spec_lin of species

  REAL (KIND=dp), PUBLIC                                :: L1b_0       ! Value of L1b for 0.0 argument

  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrehat      ! current iteration populations of H
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xreh2       ! current iteration populations of H2
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xreh2c      ! current iteration populations of H2 by pure collisions and A_quad
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrehd       ! current iteration populations of HD
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrecat      ! current iteration populations of C I
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrenat      ! current iteration populations of N I
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xreoat      ! current iteration populations of O I
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xresat      ! current iteration populations of S I
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xresia      ! current iteration populations of Si I
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrecpl      ! current iteration populations of C II
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrecpp      ! current iteration populations of C III
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrenpl      ! current iteration populations of N II
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrenpp      ! current iteration populations of N III
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xreopl      ! current iteration populations of O II
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xreopp      ! current iteration populations of O III
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrespl      ! current iteration populations of S II
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrespp      ! current iteration populations of S III
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xresip      ! current iteration populations of Si II
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrenep      ! current iteration populations of Ne II
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrenepp     ! current iteration populations of Ne III
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xreco       ! current iteration populations of CO
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrec13o     ! current iteration populations of 13CO
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xreco18     ! current iteration populations of C18O
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrec13o18   ! current iteration populations of 13C18O
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrecs0      ! current iteration populations of CS
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrehcop     ! current iteration populations of HCO+
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrechp      ! current iteration populations of CH+
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrehcn      ! current iteration populations of HCN
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xreoh       ! current iteration populations of OH
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xreh2o      ! current iteration populations of H2O
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xreh3p      ! current iteration populations of H3+
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xreo2       ! current iteration populations of O2
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xreohp      ! current iteration populations of OH+
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xreshp      ! current iteration populations of SH+
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: xrearhp     ! current iteration populations of ArH+

  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refhat      ! current iteration cooling by H
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: rfjh2t      ! H2 total cooling
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: rfjh2c      ! H2 cooling due to pure collisions
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: f_h2hot     ! Fraction of suprthermal H2
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: rfjhdt      ! HD total cooling
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refcat      ! current iteration cooling by C I
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refnat      ! current iteration cooling by N I
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refoat      ! current iteration cooling by O I
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refsat      ! current iteration cooling by S I
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refsia      ! current iteration cooling by Si I
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refcpl      ! current iteration cooling by C II
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refcpp      ! current iteration cooling by C III
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refnpl      ! current iteration cooling by N II
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refnpp      ! current iteration cooling by N III
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refopl      ! current iteration cooling by O II
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refopp      ! current iteration cooling by O III
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refspl      ! current iteration cooling by S II
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refspp      ! current iteration cooling by S III
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refsip      ! current iteration cooling by Si II
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refnep      ! current iteration cooling by Ne II
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refnepp     ! current iteration cooling by Ne III
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refco       ! current iteration cooling by CO
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refc13o     ! current iteration cooling by 13CO
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refco18     ! current iteration cooling by C18O
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refc13o18   ! current iteration cooling by 13C18O
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refcs0      ! current iteration cooling by CS
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refhcop     ! current iteration cooling by HCO+
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refchp      ! current iteration cooling by CH+
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refhcn      ! current iteration cooling by HCN
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refoh       ! current iteration cooling by OH
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refh2o      ! current iteration cooling by H2O
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refh3p      ! current iteration cooling by H3+
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refo2       ! current iteration cooling by O2
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refohp      ! current iteration cooling by OH+
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refshp      ! current iteration cooling by SH+
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: refarhp     ! current iteration cooling by ArH+

  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: cdth2       ! H2 weighted column density (by T)
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: cdthd       ! HD weighted column density (by T)
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: cdtco       ! CO0 weighted column density (by T)
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: cdtc13o     ! CO1 weighted column density (by T)
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: cdtco18     ! CO2 weighted column density (by T)
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: cdtc13o18   ! CO3 weighted column density (by T)
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: eqrco       ! CO radiative destruction
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: eqrc13o     ! 13CO radiative destruction
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: eqrco18     ! C18O radiative destruction
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE   :: eqrc13o18   ! 13C18O radiative destruction

! Cooling and heating rates

  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: reftot      ! Total cooling
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: chotot      ! Total heating

  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: reffep      ! Fe+ cooling
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: refhd       ! HD  cooling
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: ref_ff      ! Free-free cooling
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: refrec      ! Recombination cooling (upper bound)

  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: chophg      ! Photoelectric effect on grains
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: chophg_c    ! Photoelectric effect on grains (cooling part)
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: chophg_h    ! Photoelectric effect on grains (heating part)
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: chochi      ! Chemical exothermicity
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: choeqg      ! Gaz-grains equilibrium
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: chopht      ! Direct Photoprocesses
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: chorc       ! Cosmic rays
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: chophs      ! Secondary photons
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: choh2g      ! H2 formation on grains
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: chohdg      ! HD formation on grains
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: choxray     ! thermalization of X ray induced secondary electrons
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)            :: chotur      ! Disspation of turbulence

! This is the minimum collision rate (used when nothing else is known)

  REAL (KIND=dp), PUBLIC, PARAMETER                     :: colr_min = 1.0e-30_dp

  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: eqcol       ! Collisional equilibrium
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: eqrspe      ! Radiative equilibrium
  REAL (KIND=dp), PUBLIC, DIMENSION(:), ALLOCATABLE     :: create      ! State specific formation
  REAL (KIND=dp), PUBLIC, DIMENSION(:), ALLOCATABLE     :: remove      ! State specific destruction

  REAL (KIND=dp), PUBLIC, DIMENSION(4,210)              :: cdocs       ! CS collision rates
  INTEGER, PUBLIC                                       :: ntccs       ! number of CS collisional transitions included

  ! Collisions with interpolation in file
  REAL (KIND=dp), PUBLIC, DIMENSION(:), ALLOCATABLE     :: tc_co_h2    ! CO collision Temperatures (H2)
  INTEGER, PUBLIC                                       :: nt_co_h2    ! numb of interp temperatures (H2)
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_co_ph2    ! CO collision rates (with p_H2)
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_co_oh2    ! CO collision rates (with o_H2)
  REAL (KIND=dp), PUBLIC, DIMENSION(:), ALLOCATABLE     :: tc_co_h     ! CO collision Temperatures (H)
  INTEGER, PUBLIC                                       :: nt_co_h     ! numb of interp temperatures (H)
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_co_h      ! CO collision rates (with H)
  REAL (KIND=dp), PUBLIC, DIMENSION(:), ALLOCATABLE     :: tc_co_he    ! CO collision Temperatures (He)
  INTEGER, PUBLIC                                       :: nt_co_he    ! numb of interp temperatures (He)
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_co_he     ! CO collision rates (with H)
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_c13o_ph2  ! 13CO collision rates (with p_H2)
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_c13o_oh2  ! 13CO collision rates (with o_H2)
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_co18_ph2  ! C18O collision rates (with p_H2)
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_co18_oh2  ! C18O collision rates (with o_H2)
  REAL (KIND=dp), PUBLIC                                :: f_h, f_he, f_h2
  INTEGER, PUBLIC                                       :: i0_h, i0_he, i0_h2, i0_e

  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_chp_he    ! CH+ collision rates with He
  REAL (KIND=dp), PUBLIC, DIMENSION(:),     ALLOCATABLE :: tempcchp_he ! Temperatures of CH+ + He collision
  INTEGER, PUBLIC                                       :: nttchp_he   ! Number of temperatures for collisions CH+ + He
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_chp_e     ! CH+ collision rates with electrons
  REAL (KIND=dp), PUBLIC, DIMENSION(:),     ALLOCATABLE :: tempcchp_e  ! Temperatures of CH+ + e collision
  INTEGER, PUBLIC                                       :: nttchp_e    ! Number of temperatures for collision with e

  REAL (KIND=dp), PUBLIC, DIMENSION(:), ALLOCATABLE     :: tempcoh     ! OH collision Temperatures
  INTEGER, PUBLIC                                       :: nttoh       ! number of interpolation temperatures
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_oh_ph2    ! OH collision rate with para-H2
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_oh_oh2    ! OH collision rate with ortho-H2

  ! Collisions with fitting formulae
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2_h_1    ! H2 collision rate with H
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2_h_2    ! H2 collision rate with H
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2_h_3    ! H2 collision rate with H
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2_h_4    ! H2 collision rate with H
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2_he_1   ! H2 collision rate with He
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2_he_2   ! H2 collision rate with He
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2_he_3   ! H2 collision rate with He
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2_ph2_1  ! H2 collision rate with pH2
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2_ph2_2  ! H2 collision rate with pH2
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2_ph2_3  ! H2 collision rate with pH2
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2_oh2_1  ! H2 collision rate with oH2
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2_oh2_2  ! H2 collision rate with oH2
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2_oh2_3  ! H2 collision rate with oH2

  REAL (KIND=dp), PUBLIC, DIMENSION (4,0:njthd,0:njthd) :: q_hd_h      ! HD collision rate with H
  REAL (KIND=dp), PUBLIC, DIMENSION (4,0:njthd,0:njthd) :: q_hd_he     ! HD collision rate with He
  REAL (KIND=dp), PUBLIC, DIMENSION (4,0:njthd,0:njthd) :: q_hd_ph2    ! HD collision rate with pH2
  REAL (KIND=dp), PUBLIC, DIMENSION (4,0:njthd,0:njthd) :: q_hd_oh2    ! HD collision rate with oH2

  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_hcop_h2   ! HCO+ collision rates (with H2)

  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2o_he_1  ! H2O collision rate with Helium
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2o_he_2  ! H2O collision rate with Helium
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2o_he_3  ! H2O collision rate with Helium
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2o_h2_1  ! H2O collision rate with H2
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2o_h2_2  ! H2O collision rate with H2
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE   :: q_h2o_h2_3  ! H2O collision rate with H2

  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_hcn_h2    ! HCN collision rate with H2

  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_o2_he     ! O2  collision rate with He

  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_ohp_h2    ! OH+ collision rates with H2
  REAL (KIND=dp), PUBLIC, DIMENSION(:),     ALLOCATABLE :: tempcohp_h2 ! Temperatures of OH+ + H2 collision
  INTEGER, PUBLIC                                       :: nttohp_h2   ! Number of temperatures for collisions OH+ + H2
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_ohp_e     ! OH+ collision rates with electrons
  REAL (KIND=dp), PUBLIC, DIMENSION(:),     ALLOCATABLE :: tempcohp_e  ! Temperatures of OH+ + e collision
  INTEGER, PUBLIC                                       :: nttohp_e    ! Number of temperatures for collisions OH+ + e

  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_shp_h2    ! SH+ collision rates with H2
  REAL (KIND=dp), PUBLIC, DIMENSION(:),     ALLOCATABLE :: tempcshp_h2 ! Temperatures of SH+ + H2 collision
  INTEGER, PUBLIC                                       :: nttshp_h2   ! Number of temperatures for collisions SH+ + H2
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_shp_e     ! SH+ collision rates with electrons
  REAL (KIND=dp), PUBLIC, DIMENSION(:),     ALLOCATABLE :: tempcshp_e  ! Temperatures of SH+ + e collision
  INTEGER, PUBLIC                                       :: nttshp_e    ! Number of temperatures for collisions SH+ + e

  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_arhp_he   ! ArH+ collision rates with He
  REAL (KIND=dp), PUBLIC, DIMENSION(:),     ALLOCATABLE :: tempcarhp_he! Temperatures of ArH+ + He collision
  INTEGER, PUBLIC                                       :: nttarhp_he  ! Number of temperatures for collisions ArH+ + He
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_arhp_e    ! ArH+ collision rates with electrons
  REAL (KIND=dp), PUBLIC, DIMENSION(:),     ALLOCATABLE :: tempcarhp_e ! Temperatures of ArH+ + e collision
  INTEGER, PUBLIC                                       :: nttarhp_e   ! Number of temperatures for collision with e

  INTEGER,        PUBLIC                                :: ntth3p_ph2  ! Number of temp. in the H3+ + H2 para  collision datafile
  INTEGER,        PUBLIC                                :: ntth3p_oh2  ! Number of temp. in the H3+ + H2 ortho collision datafile
  REAL (KIND=dp), PUBLIC, DIMENSION(:), ALLOCATABLE     :: tempch3p_ph2! List of temperatures for H3+ + H2 para
  REAL (KIND=dp), PUBLIC, DIMENSION(:), ALLOCATABLE     :: tempch3p_oh2! List of temperatures for H3+ + H2 ortho
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_h3p_ph2   ! Collision rates H3+ + H2 para
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_h3p_oh2   ! Collision rates H3+ + H2 ortho
                                                                       ! (k, i, j) with k : index of the temperature
                                                                       !                i : index of initial level
                                                                       !                j : index of final level

  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_nep_e     ! Ne+ collision rates with electrons
  REAL (KIND=dp), PUBLIC, DIMENSION(:),     ALLOCATABLE :: tempcnep_e  ! Temperatures of Ne+ + e collision
  INTEGER, PUBLIC                                       :: nttnep_e    ! Number of temperatures for collision with e

  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_nepp_e    ! Ne++ collision rates with electrons
  REAL (KIND=dp), PUBLIC, DIMENSION(:),     ALLOCATABLE :: tempcnepp_e ! Temperatures of Ne++ + e collision
  INTEGER, PUBLIC                                       :: nttnepp_e   ! Number of temperatures for collision with e

  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_cpp_e     ! C++ collision rates with electrons
  REAL (KIND=dp), PUBLIC, DIMENSION(:),     ALLOCATABLE :: tempccpp_e  ! Temperatures of C++ + e collision
  INTEGER, PUBLIC                                       :: nttcpp_e    ! Number of temperatures for collision with e

  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_npp_e     ! N++ collision rates with electrons
  REAL (KIND=dp), PUBLIC, DIMENSION(:),     ALLOCATABLE :: tempcnpp_e  ! Temperatures of N++ + e collision
  INTEGER, PUBLIC                                       :: nttnpp_e    ! Number of temperatures for collision with e

  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_spp_e     ! S++ collision rates with electrons
  REAL (KIND=dp), PUBLIC, DIMENSION(:),     ALLOCATABLE :: tempcspp_e  ! Temperatures of S++ + e collision
  INTEGER, PUBLIC                                       :: nttspp_e    ! Number of temperatures for collision with e

  REAL (KIND=dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: q_h_e       ! H collision rates with electrons
  REAL (KIND=dp), PUBLIC, DIMENSION(:),     ALLOCATABLE :: tempch_e    ! Temperatures of H + e collision
  INTEGER, PUBLIC                                       :: ntth_e      ! Number of temperatures for collision with e

PRIVATE

PUBLIC :: INIT_LINES, FEED_CDT, CDT_WRAP
PUBLIC :: ESCAP, EXPINT, ALLOC_SPECTRA, READ_DATALINE, READ_DATALEVEL
PUBLIC :: RF_LOCATE, NEW_DET_B, FDENS

!===============================================================================
!                               CONTAINS
! 1  - ALLOC_SPECTRA    : memory allocation and allocation of a SPECTRA type
! 4  - ARTH
! 5  - INIT_LINES
! 6  - READ_DATALEVEL
! 7  - READ_DATALINE
! 8  - INI_SPECTRA
! 10 - FEED_CDT
! 15 - VERIF_SPECTRA
!===============================================================================
CONTAINS

!===============================================================================
! SUBROUTINE : ALLOC_SPECTRA
! Dynamical allocation of memory for all arrays of a structure
! Arguments : spelin, nlv, ntr, nqn, ALL
!   - spelin : Struture of type SPECTRA
!   - nlv : nber of levels of the species
!   - ntr : nber of transitions
!   - nqn : nber of quantum numbers to define a level
!   - ALL : Flag. IF 1 all tabular are ALLOCATEd.
!                 If not 1, some arrays are not ALLOCATEd here
! Arrays are initialized with stupid values to create a bug if something is wrong
!===============================================================================
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE ALLOC_SPECTRA(spelin, nlv, ntr)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

   USE PXDR_PROFIL, ONLY : npo

   IMPLICIT NONE
   TYPE(SPECTRA), INTENT (INOUT) :: spelin
   INTEGER,       INTENT (IN)    :: nlv
   INTEGER,       INTENT (IN)    :: ntr

   ALLOCATE(spelin%abu(0:npo))          ; spelin%abu(:)       = -10000.0_dp
   ALLOCATE(spelin%ref(0:npo))          ; spelin%ref(:)       = -10000.0_dp
   ALLOCATE(spelin%vel(0:npo))          ; spelin%vel(:)       = -10000.0_dp
   ALLOCATE(spelin%int(ntr,nangle))     ; spelin%int(:,:)     = -10000.0_dp
   ALLOCATE(spelin%abso(ntr,nangle))    ; spelin%abso(:,:)    = -10000.0_dp
   ALLOCATE(spelin%cont(ntr,nangle))    ; spelin%cont(:,:)    = -10000.0_dp
   ALLOCATE(spelin%lvl_ctr(ntr,nangle)) ; spelin%lvl_ctr(:,:) = -10000.0_dp
   ALLOCATE(spelin%pos_ctr(ntr,nangle)) ; spelin%pos_ctr(:,:) = -10000.0_dp
   ALLOCATE(spelin%moy_ctr(ntr,nangle)) ; spelin%moy_ctr(:,:) = -10000.0_dp
   ALLOCATE(spelin%rms_ctr(ntr,nangle)) ; spelin%rms_ctr(:,:) = -10000.0_dp
   ALLOCATE(spelin%bkgd_ctr_cont(ntr,nangle)) ; spelin%bkgd_ctr_cont(:,:) = -10000.0_dp
   ALLOCATE(spelin%dust_ctr_cont(ntr,nangle)) ; spelin%dust_ctr_cont(:,:) = -10000.0_dp
   ALLOCATE(spelin%xre_o(nlv,0:npo))    ; spelin%xre_o(:,:)   = -10000.0_dp
   ALLOCATE(spelin%xre(nlv,0:npo))      ; spelin%xre(:,:)     = -10000.0_dp
   ALLOCATE(spelin%XXl(nlv,0:npo))      ; spelin%XXl(:,:)     = -10000.0_dp
   ALLOCATE(spelin%XXr(nlv,0:npo))      ; spelin%XXr(:,:)     = -10000.0_dp
   ALLOCATE(spelin%CoD(nlv,0:npo))      ; spelin%CoD(:,:)     = -10000.0_dp
   ALLOCATE(spelin%hot(ntr))            ; spelin%hot(:)       = -10000
   ALLOCATE(spelin%lac(ntr))            ; spelin%lac(:)       = -10000.0_dp
   ALLOCATE(spelin%exl(ntr))            ; spelin%exl(:)       = -10000.0_dp
   ALLOCATE(spelin%exr(ntr))            ; spelin%exr(:)       = -10000.0_dp
   ALLOCATE(spelin%siD(ntr))            ; spelin%siD(:)       = -10000.0_dp
   ALLOCATE(spelin%odl(ntr,0:npo))      ; spelin%odl(:,:)     = -10000.0_dp
   ALLOCATE(spelin%odr(ntr,0:npo))      ; spelin%odr(:,:)     = -10000.0_dp
   ALLOCATE(spelin%dnu(ntr,0:npo))      ; spelin%dnu(:,:)     = -10000.0_dp
   ALLOCATE(spelin%emi(ntr,0:npo))      ; spelin%emi(:,:)     = -10000.0_dp
   ALLOCATE(spelin%optdep(ntr,0:npo))   ; spelin%optdep(:,:)  = -10000.0_dp
   ALLOCATE(spelin%dint(ntr,0:npo))     ; spelin%dint(:,:)    = -10000.0_dp
   ALLOCATE(spelin%pum(0:npo,ntr))      ; spelin%pum(:,:)     = -10000.0_dp
   ALLOCATE(spelin%jiD(ntr,0:npo))      ; spelin%jiD(:,:)     = -10000.0_dp
   ALLOCATE(spelin%bel(ntr,0:npo))      ; spelin%bel(:,:)     = -10000.0_dp
   ALLOCATE(spelin%ber(ntr,0:npo))      ; spelin%ber(:,:)     = -10000.0_dp

END SUBROUTINE ALLOC_SPECTRA

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
FUNCTION ARTH(first,increment,n)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES

  IMPLICIT NONE

  INTEGER, PARAMETER          :: NPAR_ARTH = 16
  INTEGER, PARAMETER          :: NPAR2_ARTH = 8
  REAL(KIND=dp), INTENT (IN)  :: first, increment
  INTEGER, INTENT (IN)        :: n
  REAL(KIND=dp), DIMENSION(n) :: ARTH
  INTEGER                     :: k, k2
  REAL(KIND=dp)               :: temp

  IF (n > 0) ARTH(1)=first
  IF (n <= NPAR_ARTH) THEN
     DO k = 2, n
        ARTH(k) = ARTH(k-1)+increment
     ENDDO
  ELSE
     DO k = 2, NPAR2_ARTH
        ARTH(k) = ARTH(k-1)+increment
     ENDDO
     temp = increment*NPAR2_ARTH
     k = NPAR2_ARTH
     DO
        IF (k >= n) EXIT
        k2 = k+k
        ARTH(k+1:MIN(k2,n)) = temp+ARTH(1:MIN(k,n-k))
        temp = temp+temp
        k = k2
     ENDDO
  ENDIF

END FUNCTION ARTH

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
REAL(KIND=dp) FUNCTION EXPINT(n, x)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES
  USE PXDR_AUXILIAR

  IMPLICIT NONE
  INTEGER, INTENT (IN)         :: n
  REAL (KIND=dp), INTENT (IN)  :: x
  INTEGER, PARAMETER          :: MAXIT = 200
  REAL (KIND=dp), PARAMETER   :: EPS = epsilon(x)
  REAL (KIND=dp), PARAMETER   :: BIG = huge(x)*EPS
  INTEGER                     :: i, nm1
  REAL (KIND=dp)              :: a, b, c, d, del, fact, h

  IF (n == 0) THEN
     EXPINT=EXP(-x)/x
     RETURN
  ENDIF

  nm1 = n-1
  IF ( ISNAN(x) ) THEN
     PRINT *, " Argument ISNAN: "
     EXPINT = 0.0_dp
  ELSE IF (x == 0.0) THEN
     IF (nm1 == 0) THEN
       PRINT *, "E_1 infinite at 0", n, x
       STOP
     ELSE
       EXPINT = 1.0_dp / nm1
     ENDIF
  ELSE IF (x > 1.0_dp) THEN
     b = x+n
     c = BIG
     d = 1.0_dp/b
     h = d
     DO i = 1, MAXIT
        a = -i*(nm1+i)
        b = b+2.0_dp
        d = 1.0_dp/(a*d+b)
        c = b+a/c
        del = c*d
        h = h*del
        IF (ABS(del-1.0_dp) <= EPS) EXIT
     ENDDO
     IF (i > MAXIT) PRINT *,"EXPINT: continued fraction failed", n, x
     EXPINT = h*EXP(-x)
  ELSE
     IF (nm1 /= 0) THEN
        EXPINT = 1.0_dp/nm1
     ELSE
        EXPINT = -LOG(x)-g_euler
     ENDIF
     fact = 1.0
     DO i = 1, MAXIT
        fact = -fact*x/i
        IF (i /= nm1) THEN
           del = -fact/(i-nm1)
        ELSE
!          del = fact*(-LOG(x)-g_euler+SUM(1.0_dp/ARTH(1,1,nm1)))
           del = fact*(-LOG(x)-g_euler+SUM(1.0_dp/ARTH(1.0_dp,1.0_dp,nm1)))
        ENDIF
        EXPINT = EXPINT+del
        IF (ABS(del) < ABS(EXPINT)*EPS) EXIT
     ENDDO
     IF (i > MAXIT) PRINT *,"EXPINT: series failed", n, x
  ENDIF

  END FUNCTION EXPINT

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
REAL(KIND=dp) FUNCTION ESCAP(opd)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES

  IMPLICIT NONE

  REAL (KIND=dp), INTENT (IN) :: opd
  REAL (KIND=dp)              :: bbetar

  IF (opd < 0.0_dp) THEN
     bbetar = 0.5_dp
  ELSE IF (opd < 1.0e-2_dp) THEN
     bbetar = (1.0_dp - 1.17_dp * opd + 0.9126_dp * opd * opd) * 0.5_dp
  ELSE IF (opd < 7.0_dp) THEN
     bbetar = (1.0_dp - EXP(-2.34_dp * opd)) / (4.68_dp * opd)
  ELSE
     bbetar = 1.0_dp / (4.0_dp * opd * SQRT(LOG(opd/sqpi)))
  ENDIF

  ESCAP = bbetar

END FUNCTION ESCAP

!%%%%%%%%%%%%%%%%%%%%
SUBROUTINE INIT_LINES
!%%%%%%%%%%%%%%%%%%%%

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES
  USE PXDR_CHEM_DATA
  USE PXDR_PROFIL

  IMPLICIT NONE

  INTEGER                                   :: nused, nu_min
  INTEGER                                   :: f_spec_lin, ns
  CHARACTER(len=lenSpeci)                   :: sp_nam
  REAL (KIND=dp)                            :: mass
  INTEGER                                   :: k, j, found
  INTEGER                                   :: nlvco, njco, nvco
  REAL (KIND=dp)                            :: summ

  ! Read how many species must be solved for detailed balance
  WRITE (iscrn,*) "    * Get the list of species for which level populations are computed"
  fichier = TRIM(data_dir)//'spectre.flag'
  OPEN (iwrtmp, file = fichier, status = 'old')

  ! in_sp(i) gives the index of species i in array spec_lin
  !          special case: CO isotopes which should always
  !          be computed. If they are included in the chemistry
  !          then, their index is used. Else, they are included
  !          as "pseudo-species" after nspec. We use j_c13o, j_co18
  !          j_c13o18 for that
  ALLOCATE (in_sp(0:nspec+3)) ! index 0 is special. It is used to identify a specy that is not in the chemistry
  in_sp(:) = 0
  nspl = 0
  READ (iwrtmp,*) ! commentaire
  DO k = 1, 10000
     READ (iwrtmp,"(i1,1x,a8,i3,1x,i3,f5.1)",END=100) f_spec_lin, sp_nam, nused, nu_min, mass
     IF (f_spec_lin == 1) THEN
        DO j = 1, nspec
           IF (speci(j) == TRIM(sp_nam)) THEN
              nspl = nspl + 1
              in_sp(j) = nspl
              EXIT
           ENDIF
        ENDDO
        IF (TRIM(sp_nam) == "c*o" .AND. i_co /= 0) THEN
           IF (i_c13o == 0) THEN
              j_c13o = nspec + 1
              nspl = nspl + 1
           ELSE
              j_c13o = i_c13o
           ENDIF
           in_sp(j_c13o) = nspl
        ENDIF
        IF (TRIM(sp_nam) == "co*" .AND. i_co /= 0) THEN
           IF (i_co18 == 0) THEN
              j_co18 = nspec + 2
              nspl = nspl + 1
           ELSE
              j_co18 = i_co18
           ENDIF
           in_sp(j_co18) = nspl
        ENDIF
        IF (TRIM(sp_nam) == "c*o*" .AND. i_co /= 0) THEN
           IF (i_c13o18 == 0) THEN
              j_c13o18 = nspec + 3
              nspl = nspl + 1
           ELSE
              j_c13o18 = i_c13o18
           ENDIF
           in_sp(j_c13o18) = nspl
        ENDIF
     ENDIF
  ENDDO
100 ns = k - 1
  PRINT *, " Number of detailed balanced to check:", nspl

  ALLOCATE (spec_lin(nspl))
  REWIND (iwrtmp)
  READ (iwrtmp,*)

  ! Now read name, mass and number of level used
  nspl = 0
  DO k = 1, ns
     READ (iwrtmp,"(i1,1x,a8,i3,1x,i3,f5.1)") f_spec_lin, sp_nam, nused, nu_min, mass
     IF (f_spec_lin == 1) THEN
        found = 0
        DO j = 1, nspec
           IF (speci(j) == TRIM(sp_nam)) THEN
              nspl = nspl + 1
              found = 1
              EXIT
           ENDIF
        ENDDO
        ! For CO isotopes, compute excitation even if species is not in chemistry
        IF (TRIM(sp_nam) == "c*o" .AND. i_co /= 0) THEN
           IF (i_c13o == 0) THEN
              j_c13o = nspec + 1
              nspl = nspl + 1
           ELSE
              j_c13o = i_c13o
           ENDIF
           j = j_c13o
           found = 1
        ENDIF
        IF (TRIM(sp_nam) == "co*" .AND. i_co /= 0) THEN
           IF (i_co18 == 0) THEN
              j_co18 = nspec + 2
              nspl = nspl + 1
           ELSE
              j_co18 = i_co18
           ENDIF
           j = j_co18
           found = 1
        ENDIF
        IF (TRIM(sp_nam) == "c*o*" .AND. i_co /= 0) THEN
           IF (i_c13o18 == 0) THEN
              j_c13o18 = nspec + 3
              nspl = nspl + 1
           ELSE
              j_c13o18 = i_c13o18
           ENDIF
           j = j_c13o18
           found = 1
        ENDIF

        IF (found == 1) THEN
           CALL NEW_DET_B(spec_lin(nspl), sp_nam, nused, nu_min, mass, j)
        ENDIF
     ENDIF
  ENDDO
  CLOSE (iwrtmp)

  ! Those quantities may be replaced by a generic one (verify)
  !--- Atomic Hydrogen -------------------------------------------------------
  IF (i_h /= 0) THEN
     IF (in_sp(i_h) /= 0) THEN
        ALLOCATE (xrehat(spec_lin(in_sp(i_h))%nlv,0:noptm))
        ALLOCATE (refhat(0:noptm))
        xrehat = 0.0_dp
        refhat = 0.0_dp
     ENDIF
  ENDIF

  !--- Atomic Carbon ---------------------------------------------------------
  IF (i_c /= 0) THEN
     IF (in_sp(i_c) /= 0) THEN
        ALLOCATE (xrecat(spec_lin(in_sp(i_c))%nlv,0:noptm))
        ALLOCATE (refcat(0:noptm))
        xrecat = 0.0_dp
        refcat = 0.0_dp
     ENDIF
  ENDIF

  !--- N I : nat ------------------------------------------------------------
  IF (i_n /= 0) THEN
     IF (in_sp(i_n) /= 0) THEN
        ALLOCATE (xrenat(spec_lin(in_sp(i_n))%nlv,0:noptm))
        ALLOCATE (refnat(0:noptm))
        xrenat = 0.0_dp
        refnat = 0.0_dp
     ENDIF
  ENDIF

  !--- O I : oat -------------------------------------------------------------
  IF (i_o /= 0) THEN
     IF (in_sp(i_o) /= 0) THEN
        ALLOCATE (xreoat(spec_lin(in_sp(i_o))%nlv,0:noptm))
        ALLOCATE (refoat(0:noptm))
        xreoat = 0.0_dp
        refoat = 0.0_dp
     ENDIF
  ENDIF

  !--- S I : sat -----------------------------------------------------------------------
  IF (i_s /= 0) THEN
     IF (in_sp(i_s) /= 0) THEN
        ALLOCATE (xresat(spec_lin(in_sp(i_s))%nlv,0:noptm))
        ALLOCATE (refsat(0:noptm))
        xresat = 0.0_dp
        refsat = 0.0_dp
     ENDIF
  ENDIF

  !--- Si I : sia ----------------------------------------------------------------------
  IF (i_si /= 0) THEN
     IF (in_sp(i_si) /= 0) THEN
        ALLOCATE (xresia(spec_lin(in_sp(i_si))%nlv,0:noptm))
        ALLOCATE (refsia(0:noptm))
        xresia = 0.0_dp
        refsia = 0.0_dp
     ENDIF
  ENDIF

  !--- C II : cpl ----------------------------------------------------------------------
  IF (i_cp /= 0) THEN
     IF (in_sp(i_cp) /= 0) THEN
        ALLOCATE (xrecpl(spec_lin(in_sp(i_cp))%nlv,0:noptm))
        ALLOCATE (refcpl(0:noptm))
        xrecpl = 0.0_dp
        refcpl = 0.0_dp
     ENDIF
  ENDIF

  !--- C III : cpp ---------------------------------------------------------------------
  IF (i_cpp /= 0) THEN
     IF (in_sp(i_cpp) /= 0) THEN
        ALLOCATE (xrecpp(spec_lin(in_sp(i_cpp))%nlv,0:noptm))
        ALLOCATE (refcpp(0:noptm))
        xrecpp = 0.0_dp
        refcpp = 0.0_dp
     ENDIF
  ENDIF

  !--- N II : npl ----------------------------------------------------------------------
  IF (i_np /= 0) THEN
     IF (in_sp(i_np) /= 0) THEN
        ALLOCATE (xrenpl(spec_lin(in_sp(i_np))%nlv,0:noptm))
        ALLOCATE (refnpl(0:noptm))
        xrenpl = 0.0_dp
        refnpl = 0.0_dp
     ENDIF
  ENDIF

  !--- N III : npp ---------------------------------------------------------------------
  IF (i_npp /= 0) THEN
     IF (in_sp(i_npp) /= 0) THEN
        ALLOCATE (xrenpp(spec_lin(in_sp(i_npp))%nlv,0:noptm))
        ALLOCATE (refnpp(0:noptm))
        xrenpp = 0.0_dp
        refnpp = 0.0_dp
     ENDIF
  ENDIF

  !--- O II : opl ----------------------------------------------------------------------
  IF (i_op /= 0) THEN
     IF (in_sp(i_op) /= 0) THEN
        ALLOCATE (xreopl(spec_lin(in_sp(i_op))%nlv,0:noptm))
        ALLOCATE (refopl(0:noptm))
        xreopl = 0.0_dp
        refopl = 0.0_dp
     ENDIF
  ENDIF

  !--- O III : opp ---------------------------------------------------------------------
  IF (i_opp /= 0) THEN
     IF (in_sp(i_opp) /= 0) THEN
        ALLOCATE (xreopp(spec_lin(in_sp(i_opp))%nlv,0:noptm))
        ALLOCATE (refopp(0:noptm))
        xreopp = 0.0_dp
        refopp = 0.0_dp
     ENDIF
  ENDIF

  !--- S II : spl ----------------------------------------------------------------------
  IF (i_sp /= 0) THEN
     IF (in_sp(i_sp) /= 0) THEN
        ALLOCATE (xrespl(spec_lin(in_sp(i_sp))%nlv,0:noptm))
        ALLOCATE (refspl(0:noptm))
        xrespl = 0.0_dp
        refspl = 0.0_dp
     ENDIF
  ENDIF

  !--- S III : spp ---------------------------------------------------------------------
  IF (i_spp /= 0) THEN
     IF (in_sp(i_spp) /= 0) THEN
        ALLOCATE (xrespp(spec_lin(in_sp(i_spp))%nlv,0:noptm))
        ALLOCATE (refspp(0:noptm))
        xrespp = 0.0_dp
        refspp = 0.0_dp
     ENDIF
  ENDIF

  !--- Si II : sip ---------------------------------------------------------------------
  IF (i_sip /= 0) THEN
     IF (in_sp(i_sip) /= 0) THEN
        ALLOCATE (xresip(spec_lin(in_sp(i_sip))%nlv,0:noptm))
        ALLOCATE (refsip(0:noptm))
        xresip = 0.0_dp
        refsip = 0.0_dp
     ENDIF
  ENDIF

  !--- Ne II : nep ---------------------------------------------------------------------
  IF (i_nep /= 0) THEN
     IF (in_sp(i_nep) /= 0) THEN
        ALLOCATE (xrenep(spec_lin(in_sp(i_nep))%nlv,0:noptm))
        ALLOCATE (refnep(0:noptm))
        xrenep = 0.0_dp
        refnep = 0.0_dp
     ENDIF
  ENDIF

  !--- Ne III : nepp -------------------------------------------------------------------
  IF (i_nepp /= 0) THEN
     IF (in_sp(i_nepp) /= 0) THEN
        ALLOCATE (xrenepp(spec_lin(in_sp(i_nepp))%nlv,0:noptm))
        ALLOCATE (refnepp(0:noptm))
        xrenepp = 0.0_dp
        refnepp = 0.0_dp
     ENDIF
  ENDIF

  !--- CO : co -------------------------------------------------------------------------
  IF (i_co /= 0) THEN
     IF (in_sp(i_co) /= 0) THEN
        ALLOCATE (eqrco(spec_lin(in_sp(i_co))%use))
        ALLOCATE (xreco(spec_lin(in_sp(i_co))%nlv,0:noptm))
        ALLOCATE (refco(0:noptm))
        xreco = 0.0_dp
        refco = 0.0_dp
        ! Fill level to quantum numbers index here
        OPEN (iwrtmp, FILE="../data/Levels/level_co.dat", STATUS="old")
        READ (iwrtmp,'(/,1x,i4)') nlvco
        READ (iwrtmp,'(//,40x,i4,/40x,i4)') nvco, njco
        READ (iwrtmp,'(/)')
        ALLOCATE (lev_co(0:nvco,0:njco))
        ALLOCATE (nvl_co(nlvco))
        ALLOCATE (njl_co(nlvco))
        DO k = 1, nlvco
           READ (iwrtmp,'(45x)', ADVANCE="NO")  ! Jump over num, g, Energy
           READ (iwrtmp,*) nvl_co(k), njl_co(k) ! Read v and J in free format
           lev_co(nvl_co(k),njl_co(k)) = k
        ENDDO
        CLOSE (iwrtmp)
     ENDIF
  ENDIF

  !--- 13CO : c13o ---------------------------------------------------------------------
  IF (i_co /= 0 .AND. j_c13o /= 0) THEN
     IF (in_sp(j_c13o) /= 0) THEN
        ALLOCATE (eqrc13o(spec_lin(in_sp(j_c13o))%use))
        ALLOCATE (xrec13o(spec_lin(in_sp(j_c13o))%nlv,0:noptm))
        ALLOCATE (refc13o(0:noptm))
        xrec13o = 0.0_dp
        refc13o = 0.0_dp
     ENDIF
  ENDIF

  !--- C18O : co18 ---------------------------------------------------------------------
  IF (i_co /= 0 .AND. j_co18 /= 0) THEN
     IF (in_sp(j_co18) /= 0) THEN
        ALLOCATE (eqrco18(spec_lin(in_sp(j_co18))%use))
        ALLOCATE (xreco18(spec_lin(in_sp(j_co18))%nlv,0:noptm))
        ALLOCATE (refco18(0:noptm))
        xreco18 = 0.0_dp
        refco18 = 0.0_dp
     ENDIF
  ENDIF

  !--- 13C18O : c13o18 -----------------------------------------------------------------
  IF (i_co /= 0 .AND. j_c13o18 /= 0) THEN
     IF (in_sp(j_c13o18) /= 0) THEN
        ALLOCATE (eqrc13o18(spec_lin(in_sp(j_c13o18))%use))
        ALLOCATE (xrec13o18(spec_lin(in_sp(j_c13o18))%nlv,0:noptm))
        ALLOCATE (refc13o18(0:noptm))
        xrec13o18 = 0.0_dp
        refc13o18 = 0.0_dp
     ENDIF
  ENDIF

  !--- CS : cs0 ------------------------------------------------------------------------
  IF (i_cs /= 0) THEN
     IF (in_sp(i_cs) /= 0) THEN
        ALLOCATE (xrecs0(spec_lin(in_sp(i_cs))%nlv,0:noptm))
        ALLOCATE (refcs0(0:noptm))
        xrecs0 = 0.0_dp
        refcs0 = 0.0_dp
     ENDIF
  ENDIF

  !--- HCO+ : hcop ---------------------------------------------------------------------
  IF (i_hcop /= 0) THEN
     IF (in_sp(i_hcop) /= 0) THEN
        ALLOCATE (xrehcop(spec_lin(in_sp(i_hcop))%nlv,0:noptm))
        ALLOCATE (refhcop(0:noptm))
        xrehcop = 0.0_dp
        refhcop = 0.0_dp
     ENDIF
  ENDIF

  !--- CH+ : chp -----------------------------------------------------------------------
  IF (i_chp /= 0) THEN
     IF (in_sp(i_chp) /= 0) THEN
        ALLOCATE (xrechp(spec_lin(in_sp(i_chp))%nlv,0:noptm))
        ALLOCATE (refchp(0:noptm))
        xrechp = 0.0_dp
        refchp = 0.0_dp
     ENDIF
  ENDIF

  !--- HCN : hcn -----------------------------------------------------------------------
  IF (i_hcn /= 0) THEN
     IF (in_sp(i_hcn) /= 0) THEN
        ALLOCATE (xrehcn(spec_lin(in_sp(i_hcn))%nlv,0:noptm))
        ALLOCATE (refhcn(0:noptm))
        xrehcn = 0.0_dp
        refhcn = 0.0_dp
     ENDIF
  ENDIF

  !--- OH : oh -------------------------------------------------------------------------
  IF (i_oh /= 0) THEN
     IF (in_sp(i_oh) /= 0) THEN
        ALLOCATE (xreoh(spec_lin(in_sp(i_oh))%nlv,0:noptm))
        ALLOCATE (refoh(0:noptm))
        xreoh = 0.0_dp
        refoh = 0.0_dp
     ENDIF
  ENDIF

  !--- H2O : h2o -----------------------------------------------------------------------
  IF (i_h2o /= 0) THEN
     IF (in_sp(i_h2o) /= 0) THEN
        ALLOCATE (xreh2o(spec_lin(in_sp(i_h2o))%nlv,0:noptm))
        ALLOCATE (refh2o(0:noptm))
        xreh2o = 0.0_dp
        refh2o = 0.0_dp
     ENDIF
  ENDIF

  !--- H3+ : h3p -----------------------------------------------------------------------
  IF (i_h3p /= 0) THEN
     IF (in_sp(i_h3p) /= 0) THEN
        ALLOCATE (xreh3p(spec_lin(in_sp(i_h3p))%nlv,0:noptm))
        ALLOCATE (refh3p(0:noptm))
        xreh3p = 0.0_dp
        refh3p = 0.0_dp
     ENDIF
  ENDIF

  !--- O2 : o2 -------------------------------------------------------------------------
  IF (i_o2 /= 0) THEN
     IF (in_sp(i_o2) /= 0) THEN
        ALLOCATE (xreo2(spec_lin(in_sp(i_o2))%nlv,0:noptm))
        ALLOCATE (refo2(0:noptm))
        xreo2 = 0.0_dp
        refo2 = 0.0_dp
     ENDIF
  ENDIF

  !--- OH+ : ohp -----------------------------------------------------------------------
  IF (i_ohp /= 0) THEN
     IF (in_sp(i_ohp) /= 0) THEN
        ALLOCATE (xreohp(spec_lin(in_sp(i_ohp))%nlv,0:noptm))
        ALLOCATE (refohp(0:noptm))
        xreohp = 0.0_dp
        refohp = 0.0_dp
     ENDIF
  ENDIF

  !--- SH+ : shp -----------------------------------------------------------------------
  IF (i_shp /= 0) THEN
     IF (in_sp(i_shp) /= 0) THEN
        ALLOCATE (xreshp(spec_lin(in_sp(i_shp))%nlv,0:noptm))
        ALLOCATE (refshp(0:noptm))
        xreshp = 0.0_dp
        refshp = 0.0_dp
     ENDIF
  ENDIF

  !--- ArH+ : arhp ----------------------------------------------------------------------
  IF (i_arhp /= 0) THEN
     IF (in_sp(i_arhp) /= 0) THEN
        ALLOCATE (xrearhp(spec_lin(in_sp(i_arhp))%nlv,0:noptm))
        ALLOCATE (refarhp(0:noptm))
        xrearhp = 0.0_dp
        refarhp = 0.0_dp
     ENDIF
  ENDIF

  !--- H2 : h2 -------------------------------------------------------------------------
  IF (i_h2 /= 0) THEN
     IF (in_sp(i_h2) /= 0) THEN
        ALLOCATE (xreh2(spec_lin(in_sp(i_h2))%nlv,0:noptm))
        ALLOCATE (xreh2c(spec_lin(in_sp(i_h2))%nlv,0:noptm))
        ALLOCATE (rfjh2t(0:noptm))
        ALLOCATE (rfjh2c(0:noptm))
        ALLOCATE (f_h2hot(0:noptm))
        xreh2  = 0.0_dp
        xreh2c = 0.0_dp
        rfjh2t = 0.0_dp
        rfjh2c = 0.0_dp
        f_h2hot = 0.0_dp
     ENDIF
  ENDIF

  !--- HD : hd -------------------------------------------------------------------------
  IF (i_hd /= 0) THEN
     IF (in_sp(i_hd) /= 0) THEN
        ALLOCATE (xrehd(spec_lin(in_sp(i_hd))%nlv,0:noptm))
        ALLOCATE (rfjhdt(0:noptm))
        xrehd = 0.0_dp
        rfjhdt = 0.0_dp
     ELSE
        PRINT *, " WARNING: You cannot have HD in the chemistry"
        PRINT *, "          without computing the lowest rotational J"
        PRINT *, " Please edit file spectre.flag accordingly"
        STOP
     ENDIF
  ENDIF

  !--- Verification -------------------------------------------------------------------
  DO j = 1, nspl
     IF (spec_lin(j)%verif  == 1) CALL VERIF_SPECTRA(spec_lin(j))
  ENDDO

  PRINT *, "Levels and lines in memory"

  ! TODO : FAIRE MIEUX EN FONCTION DE CE QU'IL Y A DANS LA CHIMIE
  ! Prepare here line specific quantities involved in CO excitation by chemical formation
  IF (i_co /= 0 .AND. i_oh /= 0 .AND. F_CO_CH_pum == 1) THEN
     ! Identify some hard to find reactions
     ! CO formation by C + OH (used for formation - excitation) - JLB 10 VI 2011
     k_fco_c_oh = 0
     t_fco_c_oh = 0.0_dp
     DO k = 1, xmatk(i_co)%nbt
       IF (xmatk(i_co)%fdt(k)%r1 == i_c .AND. xmatk(i_co)%fdt(k)%r2 == i_oh) THEN
          k_fco_c_oh = k
          t_fco_c_oh = (enth(i_c) + enth(i_oh) - enth(i_co) - enth(i_h)) * calev * everg / xk
          print *, " C + OH -> CO + H", k_fco_c_oh, t_fco_c_oh
          ! EXIT
       ENDIF
     ENDDO

     nused = spec_lin(in_sp(i_co))%use
     ALLOCATE (bfact_co(nused))
     summ = 0.0_dp
     DO k = 1, nused
        bfact_co(k) = spec_lin(in_sp(i_co))%gst(k)
        summ = summ + bfact_co(k)
     ENDDO
     bfact_co = bfact_co / summ
     summ = 0.0_dp
     DO k = 1, nused
        summ = summ + bfact_co(k) * spec_lin(in_sp(i_co))%elk(k)
     ENDDO
     e_int_co = summ * xk / everg ! Exothermicity put in internal energy [eV]
  ENDIF

END SUBROUTINE INIT_LINES

!**********************************************************************************************
! SUBROUTINE : READ_DATALEVEL                                                                 *
!                                                                                             *
! Fill the fields :                                                                           *
! - nlv   : number of levels in data file                                                     *
! - use   : number of levels effectively used in the code                                     *
! - nqn   : number of quantum numbers to define a level                                       *
! - qnam  : name of the quantum numbers (string len=5)                                        *
! - quant : quantum numbers of each level                                                     *
! - gst   : degeneracy                                                                        *
! - elk   : energy of levels in K                                                             *
!**********************************************************************************************
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE READ_DATALEVEL(fichdata, spelin, nused)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES, ONLY : hcsurk

  IMPLICIT NONE

  CHARACTER(len=128), INTENT (IN)    :: fichdata
  TYPE(SPECTRA),      INTENT (INOUT) :: spelin
  INTEGER,            INTENT (IN)    :: nused

  CHARACTER(len=5)                   :: en_unit
  INTEGER                            :: i, j, n
  INTEGER, PARAMETER                 :: iread1 = 1
  INTEGER                            :: nlv
  CHARACTER(len=1)                   :: caract
  CHARACTER(len=45)                  :: dataline
  INTEGER                            :: num
  INTEGER                            :: pos_space
  INTEGER                            :: pos_slash
  INTEGER                            :: pos_dot
  INTEGER                            :: pos_minus
  INTEGER                            :: pos_plus

  !--- Open file ---------------------------------------------------------------
  OPEN(iread1,file=fichdata,status="OLD",action="READ")
  READ(iread1,*) ! used by Jonathan's client

  !--- Read properties of data -------------------------------------------------
  ! Format in the file : #value       commentary
  ! Jonathan prefers to have the "#" to begin each line which is not line data
  READ(iread1,"(A1)",ADVANCE="NO") caract ! Read "#"
  READ(iread1,*) spelin%nlv               ! number of levels
  READ(iread1,"(A1)",ADVANCE="NO") caract ! Read "#"
  READ(iread1,*) en_unit                  ! unit of energy
  READ(iread1,"(A1)",ADVANCE="NO") caract ! Read "#"
  READ(iread1,*) spelin%nqn               ! number of quantum numbers to define a level

  !PRINT *,"Number of levels :",spelin%nlv or user defined
  IF (nused == -1) THEN
     spelin%use = spelin%nlv
  ELSE
     ! JLB - 17 Oct 2011 - Bug!
!    spelin%use = nused
     spelin%use = MIN(nused, spelin%nlv)
  ENDIF

  !--- Dynamical allocation ----------------------------------------------------
  ALLOCATE(spelin%gst(spelin%nlv))
  ALLOCATE(spelin%elk(spelin%nlv))
  ALLOCATE(spelin%LeHname(spelin%nlv))
  ALLOCATE(spelin%LeID(spelin%nlv))
  ALLOCATE(spelin%qnam(spelin%nqn))

  !--- Read data ----------------------------------------------------------------
  DO i = 1, spelin%nqn
     READ(iread1,"(A1)",ADVANCE="NO") caract ! Read "#"
     READ(iread1,*) spelin%qnam(i)           ! quantum number names
  ENDDO
  ALLOCATE(spelin%quant(spelin%nlv,spelin%nqn))

  READ(iread1,*) ! Commentaire
  READ(iread1,*) ! Commentaire

  !--- Read energies ------------------------------------------------------------
  nlv = 0
  spelin%LeHname(:) = ""  ! Create Human readable names of levels
  spelin%LeID(:)    = ""  ! Create Human readable names of levels
  pos_slash       = 0     ! Initialization
  pos_dot         = 0     ! Initialization
  pos_plus        = 0     ! Initialization
  pos_minus       = 0     ! Initialization

  DO i = 1, spelin%nlv
     ! Read the first part of the line that contains index, degeneracy and energy
     READ(iread1,"(A45)",ADVANCE="NO") dataline
     READ(dataline,*) num, spelin%gst(i), spelin%elk(i)

     ! Read the second part of the line that contains quantum numbers (read as strings)
     dataline=""
     READ(iread1,"(A)") dataline

     ! Parse the string to extract the quantum numbers. Separator is a blank
     dataline=TRIM(ADJUSTL(dataline))
     DO j = 1, spelin%nqn
        pos_space = INDEX(dataline," ")
        spelin%quant(i,j) = dataline(1:pos_space)
        dataline=TRIM(ADJUSTL(dataline(pos_space+1:)))
     ENDDO

     ! Create Human readable names and IDs for levels
     DO n = 1, spelin%nqn-1
        spelin%LEHname(i) = TRIM(spelin%LeHname(i))//TRIM(spelin%qnam(n))//"=" &
                          //(TRIM(spelin%quant(i,n)))//","
        spelin%LeID(i)    = TRIM(spelin%LeID(i))//TRIM(spelin%qnam(n)) &
                          //(TRIM(spelin%quant(i,n)))//"_"
        pos_slash         = INDEX(spelin%LeID(i),"/")  ! If there is a "/" in quantum number value it will be replaced by "_"
        IF (pos_slash > 0)spelin%LeID(i)(pos_slash:pos_slash) = "_"
        pos_dot           = INDEX(spelin%LeID(i),".")  ! If there is a "." in quantum number value it will be replaced by "d"
        IF (pos_dot > 0)  spelin%LeID(i)(pos_dot:pos_dot) = "d"
     ENDDO
     spelin%LeHname(i) = TRIM(spelin%LeHname(i))//TRIM(spelin%qnam(spelin%nqn))//"=" &
                       //(TRIM(spelin%quant(i,spelin%nqn)))
     spelin%LeID(i)    = TRIM(spelin%LeID(i))//TRIM(spelin%qnam(n)) &
                       //(TRIM(spelin%quant(i,n)))
     pos_slash         = INDEX(spelin%LeID(i),"/")  ! If there is a "/" in quantum number value it will be replaced by "_"
     IF (pos_slash > 0)spelin%LeID(i)(pos_slash:pos_slash) = "_"
     pos_dot           = INDEX(spelin%LeID(i),".")  ! If there is a "." in quantum number value it will be replaced by "d"
     IF (pos_dot > 0)  spelin%LeID(i)(pos_dot:pos_dot) = "d"
     pos_plus          = INDEX(spelin%LeID(i),"+")  ! If there is a "+" in quantum number value it will be replaced by "p"
     IF (pos_plus > 0)spelin%LeID(i)(pos_plus:pos_plus) = "p"
     pos_minus         = INDEX(spelin%LeID(i),"-")  ! If there is a "-" in quantum number value it will be replaced by "m"
     IF (pos_minus > 0)spelin%LeID(i)(pos_minus:pos_minus) = "m"
  ENDDO
  CLOSE(10)

  !--- Transform energies in Kelvin if required ---------------------------------
  en_unit = TRIM(ADJUSTL(en_unit))
  SELECT CASE (en_unit)
     CASE("cm-1")
        DO i = 1, spelin%nlv
           spelin%elk(i) = spelin%elk(i) * hcsurk
        ENDDO
  END SELECT

END SUBROUTINE READ_DATALEVEL

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE READ_DATALINE(fichdata,spelin)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES, ONLY : hcsurk, iread1

  IMPLICIT NONE

  CHARACTER(len=128), INTENT (IN)     :: fichdata
  TYPE(SPECTRA),      INTENT (INOUT)  :: spelin

  CHARACTER(len=5)                   :: en_unit
  CHARACTER(len=5)                   :: unit
  INTEGER                            :: i, j

  INTEGER                            :: ntr
  CHARACTER(len=1)                   :: caract
  CHARACTER(len=200)                 :: the_line

  INTEGER                            :: num
  INTEGER                            :: ntruse
  INTEGER                            :: indup
  INTEGER                            :: indlo
  REAL (KIND=dp)                     :: wlk
  REAL (KIND=dp)                     :: aij

  CHARACTER(len=lenIDLEV)            :: Hname_up
  CHARACTER(len=lenIDLEV)            :: Hname_lo
  CHARACTER(len=lenIDLEV)            :: ID_up
  CHARACTER(len=lenIDLEV)            :: ID_lo

  INTEGER                            :: pos_info

    !--- Open file with data -------------------------------------------
    OPEN(iread1,file=fichdata,status="OLD",action="READ")

    !--- Read data descriptor ------------------------------------------
    ! Each line of description begins by a "#"
    ! Get the number of radiative transitions in the data file
    READ(iread1,"(A1)",ADVANCE="NO") caract ! Read "#" CHARACTER
    READ(iread1,*) ntr                      ! number of transitions in data
    ! Get the unit of the radiative transition
    READ(iread1,"(A1)",ADVANCE="NO") caract ! Read "#" CHARACTER
    READ(iread1,*) unit                     ! unit of energy transition
    en_unit = TRIM(ADJUSTL(unit))

    READ(iread1,*)                          ! commentaire
    READ(iread1,*)                          ! commentaire

    !--- Determine number of lines to keep -----------------------------
    ntruse = 0 ! Number of transitions used in the simulation
    ! We only keep lines with upper level below or equal to the maximum
    ! level for which we want to solve statistical equilibrium
    DO i = 1, ntr
       READ(iread1,'(a200)',END = 110) the_line
       READ(the_line,*,END=110) num, indup, indlo, wlk, aij
       IF (indup <= spelin%use) ntruse = ntruse + 1
    ENDDO
110 CONTINUE
    spelin%ntr = ntruse

    !--- Allocation ----------------------------------------------------
    ALLOCATE(spelin%iup(spelin%ntr))
    ALLOCATE(spelin%jlo(spelin%ntr))
    ALLOCATE(spelin%wlk(spelin%ntr))
    ALLOCATE(spelin%aij(spelin%ntr))
    ALLOCATE(spelin%inftr(spelin%ntr))
    ALLOCATE(spelin%LiHName(spelin%ntr))
    ALLOCATE(spelin%LiID(spelin%ntr))
    ALLOCATE(spelin%int(spelin%ntr,nangle))
    ALLOCATE(spelin%lvl_ctr(ntr,nangle))
    ALLOCATE(spelin%pos_ctr(ntr,nangle))
    ALLOCATE(spelin%moy_ctr(ntr,nangle))
    ALLOCATE(spelin%rms_ctr(ntr,nangle))

    !--- REWIND --------------------------------------------------------
    REWIND(iread1)
    !--- Go back to the position of data -------------------------------
    READ(iread1,"(A1)",ADVANCE="NO") caract ! Read "#" CHARACTER
    READ(iread1,*) ntr                      ! number of transitions in data
    READ(iread1,"(A1)",ADVANCE="NO") caract ! Read "#" CHARACTER
    READ(iread1,*) unit                     ! unit of energy transition
    en_unit = TRIM(ADJUSTL(unit))
    READ(iread1,*)                          ! commentaire
    READ(iread1,*)                          ! commentaire

    !--- Fill data -----------------------------------------------------
    j = 0
    spelin%LiHName = ""
    spelin%LiID    = ""
    DO i = 1, ntr ! Read the whole file again
       READ(iread1,'(a200)') the_line
       READ(the_line,*) ntr, indup, indlo, wlk, aij
       IF (indup <= spelin%use) THEN ! Keep only lines corresponding to used levels
          j = j + 1
          spelin%iup(j) = indup
          spelin%jlo(j) = indlo
          spelin%wlk(j) = wlk
          spelin%aij(j) = aij

          !--- Create Human readable name and ID of lines
          Hname_up = spelin%LeHname(indup)
          Hname_lo = spelin%LeHname(indlo)
          spelin%LiHName(j) = TRIM(Hname_up)//"->"//TRIM(Hname_lo)
          ID_up = spelin%LeID(indup)
          ID_lo = spelin%LeID(indlo)
          spelin%LiID(j)     = TRIM(ID_up)//"__"//Trim(ID_lo)

          !--- Get informations on the line ----
          pos_info = INDEX(the_line, "info:")
          spelin%inftr(j) = TRIM(ADJUSTL(the_line(pos_info+5:)))
      ENDIF
    ENDDO
    CLOSE(iread1)

    WRITE(iscrn,'(" Data read for : ",A8," nlevel = ",I4,", ntrans = ",I5)') &
          spelin%nam, spelin%use, spelin%ntr

    !--- Change unit in Kelvin if necessary ----------------------------
    en_unit = TRIM(ADJUSTL(en_unit))
    SELECT CASE (en_unit)
       CASE("cm-1")
          DO i = 1, spelin%ntr
             spelin%wlk(i) = spelin%wlk(i) * hcsurk
          ENDDO
    END SELECT

END SUBROUTINE READ_DATALINE

!**********************************************************************************************
! SUBROUTINE : INI_SPECTRA - Initialize quantities other than levels and lines
!**********************************************************************************************
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE INI_SPECTRA(spelin)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

   USE PXDR_FLAGS
   USE PXDR_CONSTANTES
   USE PXDR_CHEM_DATA
   USE PXDR_PROFIL

   IMPLICIT NONE

   TYPE(SPECTRA), INTENT (INOUT)              :: spelin

   REAL (KIND=dp), DIMENSION(:), ALLOCATABLE :: fnpart
   REAL (KIND=dp)                            :: summ
   REAL (KIND=dp)                            :: temper
   REAL (KIND=dp)                            :: temper_lim
   REAL (KIND=dp)                            :: vt2
   INTEGER                                   :: j

   temper = tgaz(1)
   vt2 = vturb * vturb

   spelin%vel = SQRT(vt2 + deksamu * tgaz_o(0:npo) / spelin%mom)

   ALLOCATE (fnpart(spelin%nlv))
   temper_lim = MAX(temper,50.0_dp)
   DO j = 1, spelin%nlv
      fnpart(j) = MAX(1.0e-100_dp/DBLE(2*j+1),spelin%gst(j) * EXP(-spelin%elk(j) / temper_lim))
   ENDDO
   summ = SUM(fnpart(1:spelin%nlv))
   DO j = 1, spelin%nlv
      spelin%xre(j,:) = MAX(fnpart(j) / summ, 1.0e-60_dp)
   ENDDO
   DEALLOCATE (fnpart)

   spelin%jiD = 0.0_dp
   DO j = 1, spelin%ntr
      spelin%lac(j) = hcsurk / spelin%wlk(j)
   ENDDO

   spelin%ref = 0.0_dp

END SUBROUTINE INI_SPECTRA

!%%%%%%%%%%%%%%%%%%
SUBROUTINE CDT_WRAP
!%%%%%%%%%%%%%%%%%%

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES
  USE PXDR_PROFIL
  USE PXDR_CHEM_DATA

  IMPLICIT NONE

  ! Used to call FEED_CDT only when needed (i.e. just before call to FGK routines)

  IF (i_co /= 0) THEN
     IF (in_sp(i_co) /= 0) THEN
        IF (ALLOCATED(cdtco)) THEN
           DEALLOCATE (cdtco)
        ENDIF
        ALLOCATE (cdtco(spec_lin(in_sp(i_co))%use,0:npo))
        CALL FEED_CDT(cdtco,spec_lin(in_sp(i_co)),spec_lin(in_sp(i_co))%use)
     ENDIF
  ENDIF
  IF (i_co /= 0 .AND. j_c13o /= 0) THEN
     IF (in_sp(j_c13o) /= 0) THEN
        IF (ALLOCATED(cdtc13o)) THEN
           DEALLOCATE (cdtc13o)
        ENDIF
        ALLOCATE (cdtc13o(spec_lin(in_sp(j_c13o))%use,0:npo))
        CALL FEED_CDT(cdtc13o,spec_lin(in_sp(j_c13o)),spec_lin(in_sp(j_c13o))%use)
     ENDIF
  ENDIF
  IF (i_co /= 0 .AND. j_co18 /= 0) THEN
     IF (in_sp(j_co18) /= 0) THEN
        IF (ALLOCATED(cdtco18)) THEN
           DEALLOCATE (cdtco18)
        ENDIF
        ALLOCATE (cdtco18(spec_lin(in_sp(j_co18))%use,0:npo))
        CALL FEED_CDT(cdtco18,spec_lin(in_sp(j_co18)),spec_lin(in_sp(j_co18))%use)
     ENDIF
  ENDIF
  IF (i_co /= 0 .AND. j_c13o18 /= 0) THEN
     IF (in_sp(j_c13o18) /= 0) THEN
        IF (ALLOCATED(cdtc13o18)) THEN
           DEALLOCATE (cdtc13o18)
        ENDIF
        ALLOCATE (cdtc13o18(spec_lin(in_sp(j_c13o18))%use,0:npo))
        CALL FEED_CDT(cdtc13o18,spec_lin(in_sp(j_c13o18)),spec_lin(in_sp(j_c13o18))%use)
     ENDIF
  ENDIF
  IF (i_h2 /= 0) THEN
     IF (in_sp(i_h2) /= 0) THEN
        IF (ALLOCATED(cdth2)) THEN
           DEALLOCATE (cdth2)
        ENDIF
        ALLOCATE (cdth2(spec_lin(in_sp(i_h2))%use,0:npo))
        CALL FEED_CDT(cdth2,spec_lin(in_sp(i_h2)),spec_lin(in_sp(i_h2))%use)
     ENDIF
  ENDIF
  IF (i_hd /= 0) THEN
     IF (in_sp(i_hd) /= 0) THEN
        IF (ALLOCATED(cdthd)) THEN
           DEALLOCATE (cdthd)
        ENDIF
        ALLOCATE (cdthd(spec_lin(in_sp(i_hd))%use,0:npo))
        CALL FEED_CDT(cdthd,spec_lin(in_sp(i_hd)),spec_lin(in_sp(i_hd))%use)
     ENDIF
  ENDIF

END SUBROUTINE CDT_WRAP

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE FEED_CDT (cdtc, spelin, nnv)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES
  USE PXDR_PROFIL

  IMPLICIT NONE

  TYPE (SPECTRA), INTENT (IN)                          :: spelin
  INTEGER, INTENT (IN)                                 :: nnv
  REAL (KIND=dp), DIMENSION(nnv,0:npo), INTENT (INOUT) :: cdtc
  INTEGER                                              :: i, j
  REAL (KIND=dp)                                       :: vt2, am, summ
  REAL (KIND=dp)                                       :: b0sb_p, b0sb_i
  REAL (KIND=dp)                                       :: xx_p, xx_i

  vt2 = vturb * vturb
  am = spelin%mom
  cdtc = 0.0_dp

  ! 17 Oct 2011: integrate over dd_cm (ds)
  DO i = 1, spelin%use
    summ = 0.0_dp
    cdtc(i,0) = 0.0_dp
    b0sb_p = vturb / SQRT(vt2 + deksamu * tgaz_o(0) / am)
    xx_p = spelin%abu(0) * spelin%xre(i,0)
    DO j = 1, npo
      b0sb_i = vturb / SQRT(vt2 + deksamu * tgaz_o(j) / am)
      xx_i = spelin%abu(j) * spelin%xre(i,j)
      summ = summ + dd_cm(j) * (xx_i * b0sb_i + xx_p * b0sb_p)
      cdtc(i,j) = summ * 0.5_dp
      b0sb_p = b0sb_i
      xx_p = xx_i
    ENDDO
  ENDDO

END SUBROUTINE FEED_CDT

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE VERIF_SPECTRA(spelin)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

   IMPLICIT NONE

   TYPE(SPECTRA), INTENT (IN) :: spelin
   INTEGER                   :: i, j
   CHARACTER(LEN=128)        :: fichout
   CHARACTER(LEN=4)          :: E_K = "E(K)"
   CHARACTER(LEN=1)          :: ld='(', rd=')'
   CHARACTER(LEN=20)         :: frmt

   PRINT *,"Data verification for : ",TRIM(spelin%nam)

   !--- Creation of the output file
   fichout  = "check_"//TRIM(ADJUSTL(spelin%nam))//".dat"
   PRINT *, " Verifications in:", TRIM(fichout)
   OPEN(iwrtmp,file=fichout,status="unknown",action="WRITE")

   WRITE(iwrtmp,*) "Data verification for"
   WRITE(iwrtmp,*) "------------------------------"
   WRITE(iwrtmp,*) "Name = ",spelin%nam
   WRITE(iwrtmp,*) "Mass = ",spelin%mom
   WRITE(iwrtmp,*) "------------------------------"
   WRITE(iwrtmp,*) " LEVELS                       "
   WRITE(iwrtmp,*) "------------------------------"
   WRITE(iwrtmp,*) "Number of levels in data file : ", spelin%nlv
   WRITE(iwrtmp,*) "Number of levels used         : ", spelin%use
   WRITE(iwrtmp,"(10x,A3)",ADVANCE="NO") "n "
   DO i = 1, spelin%nqn
      WRITE(iwrtmp,"(2x,A5)",ADVANCE="NO") spelin%qnam(i)
   ENDDO
   WRITE(iwrtmp,"(2x,A8,A4)") '  g     ', E_K
   DO i = 1, spelin%use
      WRITE(iwrtmp,*) i, (spelin%quant(i,j),j=1,spelin%nqn), spelin%gst(i), spelin%elk(i)
   ENDDO
   WRITE(iwrtmp,*) "------------------------------"
   WRITE(iwrtmp,*) " LINES                        "
   WRITE(iwrtmp,*) "------------------------------"
   WRITE(iwrtmp,*) "Number of lines in data file : ", spelin%ntr
   WRITE(iwrtmp,*) " n,    iup,    jlo,    wlk(K),    lam_cent,    Aij,    Info"
   DO i = 1, spelin%ntr
      WRITE(frmt,'(a1,"a",i2,a1)') ld, LEN_TRIM(spelin%inftr(i)), rd
      WRITE(iwrtmp,"(3(i3,2x))", ADVANCE="NO") i, spelin%iup(i), spelin%jlo(i)
      WRITE(iwrtmp,"(3(1p,E12.4,2x))", ADVANCE="NO") spelin%wlk(i), spelin%lac(i), spelin%aij(i)
      WRITE(iwrtmp,frmt) spelin%inftr(i)
   ENDDO
   CLOSE(iwrtmp)

END SUBROUTINE VERIF_SPECTRA

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE RF_LOCATE (rf_xx, x, j)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!  purpose : locate index j of rf_xx%Val such that
!            rf_xx%Val(j) <= x < rf_xx%Val(j+1)
!  need : rf_xx%Val should be sorted in ASCENDING order
!  Note : if x is outside rf_xx%Val, THEN RETURN jl or ju

  IMPLICIT NONE

  TYPE (RF_TYPE), INTENT (IN) :: rf_xx
  REAL (KIND=dp), INTENT (IN) :: x
  INTEGER, INTENT (OUT)       :: j

  INTEGER                     :: jl, ju, jm

  jl = rf_xx%lower
  ju = rf_xx%upper

  IF (x >= rf_xx%Val(ju)) THEN
    j = ju
  ELSE IF (x < rf_xx%Val(jl)) THEN
    ! -----------------------------------------
    ! Bug correction (BG). j=jl-1 and not jl.
    ! Necessary to implement wavelength below
    ! the 911 A cut off. It also concords more
    ! with the goal of the function written in
    ! the above definition
    ! 08 / 04 / 2013
    ! --------------------------------------
    j = jl-1
  ELSE

    DO WHILE ((ju-jl) > 1)
      jm = (ju + jl) / 2
      IF (x < rf_xx%Val(jm)) THEN
        ju = jm
      ELSE
        jl = jm
      ENDIF
    ENDDO
    j = jl

  ENDIF

  END SUBROUTINE RF_LOCATE

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE NEW_DET_B(spelin, sp_nam, nused, nu_min, mass, ind)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES
  USE PXDR_CHEM_DATA
  USE PXDR_PROFIL

  IMPLICIT NONE

  TYPE (SPECTRA),           INTENT (INOUT) :: spelin
  CHARACTER (LEN=lenSpeci), INTENT (IN)    :: sp_nam
  INTEGER,                  INTENT (IN)    :: nused
  INTEGER,                  INTENT (IN)    :: nu_min
  REAL (KIND=dp),           INTENT (IN)    :: mass
  INTEGER,                  INTENT (IN)    :: ind     ! Index of specy in speci array

  REAL (KIND=dp)     :: abt_in
  CHARACTER(len=128) :: fichin
  INTEGER            :: j

   spelin%nam     = sp_nam

   ! TODO : Add a test and do the special CO case only if it has not been done
   !        in the chemistry
   IF (sp_nam == "c*o") THEN
      spelin%spHname = "13CO"
      spelin%spID    = "13C_O"
   ELSE IF (sp_nam == "co*") THEN
      spelin%spHname = "C_18O"
      spelin%spID    = "C_18O"
   ELSE IF (sp_nam == "c*o*") THEN
      spelin%spHname = "13C_18O"
      spelin%spID    = "13C_18O"
   ELSE
      spelin%spHname = Species(ind)%Hname
      spelin%spID    = Species(ind)%SpecyID
   ENDIF

   spelin%mom     = mass
   spelin%ind     = ind

  !--- Fill levels data ------------------------------------------------
  fichin = TRIM(data_dir)//"Levels/level_"//TRIM(spelin%nam)//".dat"
  spelin%usemin = nu_min
  CALL READ_DATALEVEL(fichin, spelin, nused)

  !--- Fill lines data -------------------------------------------------
  fichin = TRIM(data_dir)//"Lines/line_"//TRIM(spelin%nam)//".dat"
  CALL READ_DATALINE(fichin, spelin)
  spelin%verif = 0

  !--- Memory allocation -----------------------------------------------
  CALL ALLOC_SPECTRA(spelin, spelin%nlv, spelin%ntr)

  abt_in  = 1.0_dp
  IF (ind < nspec) THEN
    DO j = 1, natom-1
      IF (ael(ind,j) /= 0) THEN
        abt_in = MIN(abtot(j), abt_in)
!       PRINT *, ind, j, ael(ind,j), abt_in
      ENDIF
    ENDDO
    spelin%abu = abt_in * densh(0:npo) * 0.001_dp
  ELSE IF (ind == nspec+1) THEN
    abt_in = MIN(abtot(2), abt_in)
    spelin%abu = spec_lin(in_sp(i_co))%abu / r_c13
  ELSE IF (ind == nspec+2) THEN
    abt_in = MIN(abtot(2), abt_in)
    spelin%abu = spec_lin(in_sp(i_co))%abu / r_o18
  ELSE IF (ind == nspec+3) THEN
    abt_in = MIN(abtot(2), abt_in)
    spelin%abu = spec_lin(in_sp(i_co))%abu / (r_c13 * r_o18)
  ENDIF

  CALL INI_SPECTRA(spelin)

END SUBROUTINE NEW_DET_B

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE FDENS(tt, ip, xdens, xtemp)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! Set density and temperature as required by the user

   USE PXDR_FLAGS
   USE PXDR_CONSTANTES
   USE PXDR_CHEM_DATA
   USE PXDR_PROFIL
   USE PXDR_AUXILIAR

   IMPLICIT NONE

   REAL (KIND=dp), INTENT (IN)  :: tt
   INTEGER, INTENT (IN)         :: ip
   REAL (KIND=dp), INTENT (OUT) :: xdens
   REAL (KIND=dp), INTENT (OUT) :: xtemp

   INTEGER                      :: j, ind
   REAL (KIND=dp)               :: rapp, divi
   REAL (KIND=dp)               :: hsurh2
   REAL (KIND=dp)               :: xpres

   ! Interpolation in previous grid
   DO j = 1, npo
      IF (tt < tau_o(j)) THEN
         icd_o = j-1
         EXIT
      ENDIF
      icd_o = npo
   ENDDO

   IF (icd_o < npo) THEN
      raptau = (tt - tau_o(icd_o)) / dtau_o(icd_o+1)
   ELSE
      raptau = 0.0_dp
   ENDIF

   IF (ABS(ifisob) == 1 .OR. ABS(ifisob) == 4) THEN
      ! Interpolation in input file
      DO j = 0, pr_np-1
         IF (tt <= pr_tau(j+1)) THEN
           ind = j
           EXIT
         ENDIF
      ENDDO
      rapp   = (tt - pr_tau(ind)) / (pr_tau(ind+1) - pr_tau(ind))
   ENDIF

   ! Set new temperature
   ! If ifaf = 1, then no thermal balance, we use the initial analytical approximation
   ! See in PROFIL
   SELECT CASE (ifaf)
   CASE (1)
      xtemp = tgaz_o(icd_o) + raptau * (tgaz_o(icd_o+1) - tgaz_o(icd_o))
   CASE DEFAULT
      SELECT CASE (ifisob)
      CASE (0)
         xtemp = tgaz(ip)
      CASE (1)
         IF (ifeqth == 1) THEN
            xtemp = tgaz(ip)
         ELSE
            ! Interpolation in input file
            xtemp = pr_tem(ind) + (pr_tem(ind+1) - pr_tem(ind)) * rapp
         ENDIF
      CASE (2)
         xtemp = tgaz(ip)
      CASE (3)
         IF (ifeqth == 1) THEN
            xtemp = tgaz(ip)
         ELSE
            ! Temperature from Sternberg & Dalgarno, Ap J S, 1995, 99, 565
!           xtemp =  10.0_dp**MAX(3.5d0 - 0.8d0 * tt, 1.3d0)
            ! Temperature profile by JLB (18 II 2011)
            IF (radp /= 0.0_dp) THEN
               xtemp = 20.0_dp + tg_init * EXP(-tt/(radm*1.0e-5_dp)) &
                     + tg_init * SQRT(radp/radm) * EXP(-(taumax-tt)/(radp*1.0e-5_dp))
            ELSE
               xtemp = 20.0_dp + tg_init * EXP(-tt/(radm*1.0e-5_dp))
            ENDIF
         ENDIF
      CASE (4)
         ! Pressure profile
         IF (ifeqth == 1) THEN
            xtemp = tgaz(ip)
         ELSE
            ! Interpolation in input file
            xtemp = pr_tem(ind) + (pr_tem(ind+1) - pr_tem(ind)) * rapp
         ENDIF
      CASE DEFAULT
         PRINT *, "  Wrong value of ifisob:", ifisob
      END SELECT
   END SELECT

   ! Set new density
   SELECT CASE (ifisob)
   CASE (0)
      ! Constant density at prescribed value
!     xdens = densh(ip)
      xdens = nh_init
   CASE (1)
      ! Interpolation in input file
      xdens = pr_den(ind) + (pr_den(ind+1) - pr_den(ind)) * rapp
   CASE (2)
      ! Constant pressure
      hsurh2 = abnua(i_h,ip) / abnua(i_h2,ip)
      divi = (1.0_dp + hsurh2) / (2.0_dp + hsurh2)
      xdens = (presse / xtemp) / (abtot(5) + divi)
   CASE (3)
      ! Constant density
      xdens = densh(ip)
   CASE (4)
      ! Pressure profile
      ! Interpolation in input file
      xpres = pr_pre(ind) + (pr_pre(ind+1) - pr_pre(ind)) * rapp
      hsurh2 = abnua(i_h,ip) / abnua(i_h2,ip)
      divi = (1.0_dp + hsurh2) / (2.0_dp + hsurh2)
      xdens = (xpres / xtemp) / (abtot(5) + divi)
   CASE DEFAULT
      PRINT *, "  Wrong value of ifisob:", ifisob
      STOP
   END SELECT

END SUBROUTINE FDENS

END MODULE PXDR_STR_DATA
