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

  ! Cloud profile related data
  USE PXDR_CONSTANTES

  ! Variables used in numerical algorithms (sort of...)
  INTEGER, PUBLIC                                          :: isoneside         ! 1 if one side, 0 if two sides
  INTEGER, PUBLIC                                          :: is_imp = 0        ! 1: we are currently computing a mandatory point
  INTEGER, PUBLIC                                          :: next_imp = 1      ! next mandatory point

  ! Model defining variables
  CHARACTER (LEN=35), PUBLIC                               :: version_code      ! Name of the version of the code
  CHARACTER (LEN=35), PUBLIC                               :: version_output    ! Version of the .bin
  CHARACTER (LEN=41), PUBLIC                               :: los_ext           ! Line of sight extinction curve
  REAL (KIND=dp), PUBLIC                                   :: d_sour            ! Distance of radiation source (0.0 -> infinity)
  REAL (KIND=dp), PUBLIC                                   :: rstar             ! Radius of emitting source
                                                                                !   (READ in rsun, converted to cm)
  REAL (KIND=dp), PUBLIC                                   :: teff              ! Effective temperature (K)
  REAL (KIND=dp), PUBLIC                                   :: geom              ! Geometric dilution
  REAL (KIND=dp), PUBLIC                                   :: taumax            ! Maximal optical depth  at V
  REAL (KIND=dp), PUBLIC                                   :: taulm=0.0_dp      ! Maximal optical depth in any line
  REAL (KIND=dp), PUBLIC                                   :: Avmax             ! Maximal AV computed (taumax * 2.5 LOG10(e))
  REAL (KIND=dp), PUBLIC                                   :: nh_init           ! Initial density
  REAL (KIND=dp), PUBLIC                                   :: tg_init           ! Initial temperature
  REAL (KIND=dp), PUBLIC                                   :: presse            ! External pressure (if ifisob = 2)
  REAL (KIND=dp), PUBLIC                                   :: fmrc              ! Cosmic rays inisation scaling
  REAL (KIND=dp), PUBLIC                                   :: zeta              ! Cosmic rays ionisatin rate (zeta = 1.0e-17 * fmrc)
  REAL (KIND=dp), PUBLIC                                   :: fphsec            ! Secondary photons flux
  REAL (KIND=dp), PUBLIC                                   :: vturb             ! Turbulent velocity (Doppler broadening only)
  REAL (KIND=dp), PUBLIC                                   :: radm              ! Radiation field intensity on left side
  REAL (KIND=dp), PUBLIC                                   :: radp              ! Radiation field intensity on right side
  REAL (KIND=dp), PUBLIC                                   :: radm_ini          ! Radiation field on left side
  REAL (KIND=dp), PUBLIC                                   :: radp_ini          ! Radiation field on right side
                                                                                !  (both from the initial parameter file)
  REAL (KIND=dp), PUBLIC                                   :: z_dist = 0.0_dp   ! Cosmological distance of the source (as a redshift z)
  REAL (KIND=dp), PUBLIC                                   :: metal             ! metallicity (automatically scales cdunit,
                                                                                !   gratio, & elemental abundances)
  REAL (KIND=dp), PUBLIC                                   :: cdunit_0          ! Av to gaz column density conversion factor for Z = 1
  REAL (KIND=dp), PUBLIC                                   :: cdunit            ! Av to gaz column density conversion factor at metallicity Z
  REAL (KIND=dp), PUBLIC                                   :: rrv               ! Ratio Av / E(B-V)
  REAL (KIND=dp), PUBLIC                                   :: coef2             ! cdunit * tautav / rrv
  REAL (KIND=dp), PUBLIC                                   :: g_ratio_0         ! Grain/gaz mass ratio for Z = 1
  REAL (KIND=dp), PUBLIC                                   :: g_ratio           ! Grain/gaz mass ratio at metallicity Z
  REAL (KIND=dp), PUBLIC                                   :: q_pah             ! PAH mass fraction (q_PAH = M_PAH/(M_PAH+M_BG))
  REAL (KIND=dp), PUBLIC                                   :: rhogr             ! Grain density for the "big grain" component
                                                                                ! (g cm-3)
  REAL (KIND=dp), PUBLIC                                   :: rhoamc = 1.81_dp  ! Amorphous carbon (g cm-3)
  REAL (KIND=dp), PUBLIC                                   :: rhogra = 2.24_dp  ! Graphite (g cm-3) (also used for PAHs)
  REAL (KIND=dp), PUBLIC                                   :: rhosil = 3.50_dp  ! Astrophysical silicates (g cm-3)
  REAL (KIND=dp), PUBLIC                                   :: amix = 0.3_dp     ! Mixture of Draine's grain components
  REAL (KIND=dp), PUBLIC                                   :: alpgr             ! Grain size distribution index
  REAL (KIND=dp), PUBLIC                                   :: rgrmin            ! Minimum grain size
  REAL (KIND=dp), PUBLIC                                   :: rgrmax            ! Maximum grain size
  REAL (KIND=dp), PUBLIC                                   :: sigma_pah         ! sigma for lognormal PAH component
  REAL (KIND=dp), PUBLIC                                   :: a0_pah            ! central size for the lognormal PAH component
  REAL (KIND=dp), PUBLIC                                   :: dthres = 1.0e-8_dp ! Typical width of an activation barrier
  REAL (KIND=dp), PUBLIC                                   :: dwell  = 1.0e-8_dp ! Typical width of a potential well on a grain
  REAL (KIND=dp), PUBLIC                                   :: dsite  = 2.6e-8_dp ! Mean distance between sites on grains
! REAL (KIND=dp), PUBLIC                                   :: dsite  = 8.0e-8_dp ! Mean distance between sites on grains (Offer)
! REAL (KIND=dp), PUBLIC                                   :: dsite  = 14.14e-8_dp ! Mean distance between sites on grains (Offer)
                                                                                   ! dwell is used when only one site is concerned (e.g. evaporation)
                                                                                   ! dsite is used when two sites interat (e.g. tunneling)

  REAL (KIND=dp), PUBLIC                                   :: cc1, cc2, cc3     !  Fitzpatrick fit parameters
  REAL (KIND=dp), PUBLIC                                   :: cc4, xgam, y0     !  Fitzpatrick fit parameters
  REAL (KIND=dp), PUBLIC                                   :: tcmb              ! Effective CMB temperature
                                                                                ! (usually tcmb0)
                                                                                ! (except in extragalactic applications)
  INTEGER, PUBLIC                                          :: ifeqth            ! 1 : Temperature from thermal balance
  INTEGER, PUBLIC                                          :: ifisob            ! Equation of state
  INTEGER, PUBLIC                                          :: ifisob_r          ! Value read from input
  INTEGER, PUBLIC                                          :: l0h2 = 0          ! Highest H2 level included
  INTEGER, PUBLIC                                          :: ichh2             ! H + H2 collisions
  INTEGER, PUBLIC                                          :: l0hd = 0          ! Highest HD level included
  INTEGER, PUBLIC                                          :: iforh2            ! H2 formation mechanism
  INTEGER, PUBLIC                                          :: istic             ! H Sticking coefficient
  REAL (KIND=dp), PUBLIC, DIMENSION(:), ALLOCATABLE        :: tfrac             ! Tau grid for fractal model
  REAL (KIND=dp), PUBLIC, DIMENSION(:), ALLOCATABLE        :: nfrac             ! nH grid for fractal model
  INTEGER, PUBLIC                                          :: pr_np             ! Number of points in interpolation grid
  REAL (KIND=dp), PUBLIC, DIMENSION(:), ALLOCATABLE        :: pr_tau            ! Tau grid for interpolation
  REAL (KIND=dp), PUBLIC, DIMENSION(:), ALLOCATABLE        :: pr_tem            ! Temperature grid for interpolation
  REAL (KIND=dp), PUBLIC, DIMENSION(:), ALLOCATABLE        :: pr_den            ! Density grid for interpolation
  REAL (KIND=dp), PUBLIC, DIMENSION(:), ALLOCATABLE        :: pr_pre            ! Pressure grid for interpolation
  ! ---
  REAL (KIND=dp), PUBLIC                                   :: mean_rad1         ! Intensity in the UV (Lyman -> Habing) left  side
  REAL (KIND=dp), PUBLIC                                   :: mean_rad2         ! Intensity in the UV (Lyman -> Habing) right side
                                                                                ! (in erg cm-2 s-1 sr-1)

  ! Variables used for current iteration
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: tau               ! Optical depth profile
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: dtau              ! Optical depth profile increment
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: densh             ! Density profile
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: tgaz              ! Temperature profile
  REAL (KIND=dp), PUBLIC, DIMENSION(0:nes,0:noptm)         :: abnua             ! species abundances
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE      :: codesp            ! species column densities
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE      :: totcoldens        ! total column densities
                                                                                !       (column densities at last point, npo)
  REAL (KIND=dp), PUBLIC, DIMENSION(0:nvbc,0:njbc,0:noptm) :: h2bnua            ! H2 populations (B level)
  REAL (KIND=dp), PUBLIC, DIMENSION(0:nvbc,0:njbc,0:noptm) :: h2cnua            ! H2 populations (C level)
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: timh21            ! Formation and destruction of H2
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: timh22            ! Formation and destruction of H2
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: timh23            ! Formation and destruction of H2
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: timh24            ! Formation and destruction of H2
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: timh25            ! Formation and destruction of H2
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: timhd1            ! Formation and destruction of HD
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: timhd2            ! Formation and destruction of HD
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: timhd3            ! Formation and destruction of HD
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: timhd4            ! Formation and destruction of HD
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: x_lay             ! Number of ice layers on grains

  REAL (KIND=dp), PUBLIC, DIMENSION(0:nes+npart)           :: ab                ! abundances at current point (temporary variable)
  REAL (KIND=dp), PUBLIC, DIMENSION(0:nes+npart)           :: ab_o              ! abundances at current point (temporary variable)
  REAL (KIND=dp), PUBLIC, DIMENSION(0:miter)               :: tb                ! temperature iteration at point iopt
  INTEGER, PUBLIC                                          :: ifafm =  20       ! Number of global iteration on whole structure
  INTEGER, PUBLIC                                          :: ifaf              ! current iteration number

  ! Variables saved from previous iteration
  INTEGER, PUBLIC                                          :: npo               ! Number of points in previous grid
  REAL (KIND=dp), PUBLIC, DIMENSION(:), ALLOCATABLE        :: tau_o             ! previous optical depth profile
                                                                                ! (dust at V) (- => +)
  REAL (KIND=dp), PUBLIC, DIMENSION(:), ALLOCATABLE        :: dtau_o            ! previous optical depth increment
  INTEGER, PUBLIC                                          :: iopt_o            ! current point i previous grid
  INTEGER, PUBLIC                                          :: icd_o             ! current point i previous grid (for interpolation)
  REAL (KIND=dp)                                           :: raptau            ! Interpolation fractional step
  REAL (KIND=dp)                                           :: abhm
  REAL (KIND=dp)                                           :: abhp
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE      :: abh_o             ! previous atomic hydrogen profile
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE      :: abh2_o            ! previous molecular hydrogen profile
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE      :: tgaz_o            ! previous temperature profile
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE      :: tgaz_oo           ! prev. temp. profile interpolated on new grid
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE      :: tdust_o           ! previous temperature profile
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE      :: dens_o            ! previous density profile
  REAL (KIND=dp), PUBLIC, DIMENSION(:),   ALLOCATABLE      :: pres_o            ! previous pressure profile
  REAL (KIND=dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE      :: abnua_o           ! previous abundances

  ! Convergence variables
  REAL (KIND=dp), PUBLIC                                   :: varmax            ! convergence tolerance, target
  REAL (KIND=dp), PUBLIC                                   :: thevar            ! convergence tolerance, done
  REAL (KIND=dp), PUBLIC                                   :: dtaumin           ! min relative variation of tau
  REAL (KIND=dp), PUBLIC                                   :: errx              ! relative error on abundances
  REAL (KIND=dp), PUBLIC                                   :: errc              ! relative error on formation / destruction
  INTEGER                                                  :: mauvai            ! identity of worse species
  REAL (KIND=dp), PUBLIC                                   :: bthrel            ! relative error on thermal balance
  ! Save convergence test in output file
  INTEGER,        PUBLIC, DIMENSION(0:noptm)               :: iter_nb           ! number of iterations
  INTEGER,        PUBLIC, DIMENSION(0:noptm)               :: fail_bt           ! number of failed convergences - case BT
  INTEGER,        PUBLIC, DIMENSION(0:noptm)               :: fail_bthr         ! number of failed convergences - case bthrel
  INTEGER,        PUBLIC, DIMENSION(0:noptm)               :: fail_chem         ! number of failed convergences - case chemistry
  INTEGER,        PUBLIC, DIMENSION(0:noptm)               :: fail_h            ! number of failed convergences - case H
  INTEGER,        PUBLIC, DIMENSION(0:noptm)               :: fail_h2           ! number of failed convergences - case H2
  INTEGER,        PUBLIC, DIMENSION(0:noptm)               :: fail_hd           ! number of failed convergences - case HD
  INTEGER,        PUBLIC, DIMENSION(0:noptm)               :: fail_co           ! number of failed convergences - case CO
  INTEGER,        PUBLIC, DIMENSION(0:noptm)               :: fail_c            ! number of failed convergences - case C
  INTEGER,        PUBLIC, DIMENSION(0:noptm)               :: fail_grco         ! number of failed convergences - case CO:
  INTEGER,        PUBLIC, DIMENSION(0:noptm)               :: fail_grh2o        ! number of failed convergences - case H2O:
  INTEGER,        PUBLIC, DIMENSION(0:noptm)               :: fail_electr       ! number of failed convergences - case electrons
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: var_bt            ! Mean variation of temperature
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: var_bthr          ! Mean departure from thermal balance
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: var_chem          ! Mean error on chemistry solver
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: var_h             ! Mean variation of H density
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: var_h2            ! Mean variation of H2 density
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: var_hd            ! Mean variation of HD density
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: var_co            ! Mean variation of CO density
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: var_c             ! Mean variation of C density
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: var_grco          ! Mean variation of CO: density
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: var_grh2o         ! Mean variation of H2O: density
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: var_electr        ! Mean variation of electr density

  ! Local variables (used for current iteration)
  REAL (KIND=dp), PUBLIC                                   :: temp              ! Temperature
  REAL (KIND=dp), PUBLIC                                   :: av                ! Av
  REAL (KIND=dp), PUBLIC, DIMENSION(0:noptm)               :: grcharge          ! Grain charge abundance

  ! Backup variables (for relative variations)
  REAL (KIND=dp), PUBLIC                                   :: oldhat            ! H
  REAL (KIND=dp), PUBLIC                                   :: oldhmo            ! H2
  REAL (KIND=dp), PUBLIC                                   :: oldhd             ! HD
  REAL (KIND=dp), PUBLIC                                   :: oldco             ! CO
  REAL (KIND=dp), PUBLIC                                   :: oldc              ! C
  REAL (KIND=dp), PUBLIC                                   :: oldcoD            ! CO:
  REAL (KIND=dp), PUBLIC                                   :: oldh2oD           ! H2O:
  REAL (KIND=dp), PUBLIC                                   :: oldelectr         ! e-

  ! Computed in GRPARAM
  ! "big grain" component
  REAL (KIND=dp), PUBLIC                                   :: xngr              ! dust gas number ratio
  REAL (KIND=dp), PUBLIC                                   :: rgazgr            ! dust gas volume ratio
  REAL (KIND=dp), PUBLIC                                   :: agrnrm            ! normalisation factor
  REAL (KIND=dp), PUBLIC                                   :: signgr
  REAL (KIND=dp), PUBLIC                                   :: f3
  ! PAH component
  REAL (KIND=dp), PUBLIC                                   :: xngrpah           ! dust gas number ratio
  REAL (KIND=dp), PUBLIC                                   :: rgazgrpah         ! dust gas volume ratio
  REAL (KIND=dp), PUBLIC                                   :: agrnrmpah         ! normalisation factor
  REAL (KIND=dp), PUBLIC                                   :: signgrpah
  REAL (KIND=dp), PUBLIC                                   :: f3pah
  REAL (KIND=dp), PUBLIC                                   :: rdeso
  REAL (KIND=dp), PUBLIC                                   :: sngclb
  REAL (KIND=dp), PUBLIC                                   :: vmaxw
  REAL (KIND=dp), PUBLIC                                   :: fgrneu = 0.0_dp   ! Fraction of neutral grains
  REAL (KIND=dp), PUBLIC                                   :: fgrmoi = 1.0_dp   ! Fraction of neg charged grains
  REAL (KIND=dp), PUBLIC                                   :: fgrplu = 0.0_dp   ! Fraction of pos charged grains

  ! Integration on grain size distribution is done by Gaussian integration.
  !    absissa and weight of the orthogonal polynomials associated to
  !    the weight FUNCTION x**(-alp) are computed in SUBROUTINE MY_GAUSS
  !    The number of points npbgr depends on r_min and r_max
  !    The abscissa and weight associated with le lognormal distribution
  !    for PAHs are computed in SUBROUTINE MY_GAUSSHERMITE
  !    Both families are then concatenated.
  !    Sizes are stored in inverse order (from the largest to the smallest).
  ! All physical quantities F depending on grain size are computed at the
  !    points adust (Fi) and weighted so that Sum Fi = Integral F dng
  INTEGER, PUBLIC                                          :: npg               ! Total number of grains sizes
  INTEGER, PUBLIC                                          :: nppah             ! Number of sizes for the PAH component
  INTEGER, PUBLIC                                          :: npbgr             ! Number of sizes for the "big grains" component

  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: adust             ! Absissa of gaussian integration
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: wwmg              ! Weight of gaussian integration
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: surfgr            ! Surface of grains of size i
  REAL (KIND=dp), PUBLIC                                   :: s_gr_t            ! Total surface of grains per H
  REAL (KIND=dp), PUBLIC                                   :: s_gr_t_bgr        ! Total surface of "big grains" per H
  REAL (KIND=dp), PUBLIC                                   :: s_gr_t_pah        ! Total surface of PAHs per H
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: x_nc              ! Number of C atom in grains of size i
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: bt_fy             ! Ionisation enhancement factor (Bakes & Tielens)
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)      :: tdust             ! Dust temperature
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)      :: zmoy              ! Mean charge of grain
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)      :: xji               ! individual ions accretion rate
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)      :: frac              ! Charge distribution
  INTEGER,        PUBLIC, ALLOCATABLE, DIMENSION(:)        :: jzmin, jzmax
  INTEGER, PUBLIC, PARAMETER                               :: izm0 = 1000       ! Maximum negative charge
  INTEGER, PUBLIC, PARAMETER                               :: izp0 = 10000      ! Maximum positive charge

  ! Table of possible dust temperatures for the computation of dust emissivities
  INTEGER,        PUBLIC, PARAMETER                        :: nTd   = 1000      ! Number of possible dust temperature
  REAL (KIND=dp), PUBLIC, PARAMETER                        :: aTd   = 1.2_dp    ! index of dust temperature grid
  REAL (KIND=dp), PUBLIC, PARAMETER                        :: Tdmin = 0.100e+0_dp ! Minimum dust temperature
  REAL (KIND=dp), PUBLIC, PARAMETER                        :: Tdmax = 3.925e+3_dp ! Maximum dust temperature
                                                                                  ! = sublimation temperature of Graphite
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: Tdposs            ! Logarithmic grid of possible dust temperature
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)      :: Edposs            ! Corresp. grid in energy for each size of grain
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)      :: D_Edposs          ! Delta of grid
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)      :: ldposs            ! Corresp. grid in wavelength for each size of grain
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)      :: Peposs            ! Emitted power of photons with E < Edposs
                                                                                ! (divided by pi*a^2)
  INTEGER,        PUBLIC                                   :: nraff = 32        ! number of log refinement for computation
                                                                                ! of cold dust emissivity. If = 8
                                                                                ! => 1% error on the conserv. of radiative energy
  TYPE(RF_TYPE),  PUBLIC, DIMENSION(nTd), SAVE             :: rf_Plint          ! Specific intensities of Planck functions at Tdposs
  TYPE(RF_TYPE),  PUBLIC, ALLOCATABLE, DIMENSION(:,:)      :: eff_phel          ! Fraction of the radiative energy absorbed by dust
                                                                                ! that goes in the photoelectrons
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)    :: eff_cte           ! Constante for the computation of eff_phel
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)      :: J_du_pro          ! intJmp interpolated on the current tau grid for
                                                                                ! computation of dust properties

  ! Parameters related to radiation field with early use
  TYPE (RF_TYPE), PUBLIC, SAVE                             :: rf_wl             !  declared in MODULE PXDR_PROFIL to be available

  ! New variables for dust properties. Should supersede obsolete variables
  TYPE (DU_DIST), PUBLIC                                   :: du_prop           !  Dust Properties in whole cloud
  TYPE (DU_DIST), PUBLIC                                   :: dustem_in         !  Dust Properties read from DUSTEM
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)    :: dustem_Qabs       !  Size-dependent absorption coeff. from dustem
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)    :: dustem_Qsca       !  Size-dependent scattering coeff. from dustem

  ! Quantities calculated at the end of the code to prepare caracterisation
  REAL (Kind=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: protoncd          ! Proton column density
  REAL (Kind=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: molfrac_ab        ! H2 molecular frac computed from abundances
  REAL (Kind=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: molfrac_cd        ! H2 molecular frac computed from col. densities
  REAL (Kind=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: T01_ab            ! H2 T01 excitation temperature from abundances
  REAL (Kind=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: T01_cd            ! H2 T01 excitation temperature from col. densities
  REAL (Kind=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: h2opr_ab          ! H2 OPR (ortho-para ratio) computed with abundances
  REAL (Kind=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: h2opr_cd_tot      ! H2 OPR (ortho-para ratio) computed with column densities, all levels
  REAL (Kind=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: h2opr_cd_emi      ! H2 OPR (ortho-para ratio) computed with column densities but only J>1
  REAL (Kind=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: h2opr_cd_vib      ! H2 OPR (ortho-para ratio) computed with column densities but v>1
  REAL (Kind=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: ionidegree        ! Ionization degree
  REAL (Kind=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: gaspressure       ! Gas pressure
  REAL (Kind=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: totdensity        ! Total density
  REAL (Kind=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: d_cm              ! Distance in cm (Computed from "-" to "+")
  REAL (Kind=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: dd_cm             ! Distance increment in cm
  REAL (Kind=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: visualext         ! Visual extinction Av

  ! Quantities required for the post-treatment chemistry analysis
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)      :: all_rate_chem     ! contains all reactions rates for all position in Av times abundances
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:)        :: rate_chem         ! contains all reactions rates

  ! Variables to compute the entire output spectrum
  INTEGER,        PUBLIC                                   :: nwl_spectrum      ! number of lambda points in the output spectrum
  REAL (KIND=dp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)      :: out_spectrum      ! Entire output spectrum perpendicular to the cloud (wl, tot, Dust, bckg)

  ! Array to store CPU time of each iteration
  REAL (KIND=dp), PUBLIC, DIMENSION(:), ALLOCATABLE        :: runtime           ! CPU time for each iteration
!------------------------------------------------------------------------

CONTAINS

  ! Case ifisob /= 1 or 4 (i.e. no external file)
  !%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE INIT_PROFIL_0
  !%%%%%%%%%%%%%%%%%%%%%%%

    USE PXDR_FLAGS
    USE PXDR_CONSTANTES
    USE PXDR_CHEM_DATA

    IMPLICIT NONE

    REAL (KIND=dp)                   :: t
    REAL (KIND=dp)                   :: tauc, td, toto
    REAL (KIND=dp)                   :: rap_0, rap_n
    INTEGER                          :: i, j, k, it
    REAL (KIND=dp)                   :: sig = 3.8_dp ! Dust attenuation in the UV
    REAL (KIND=dp)                   :: t1, t2

    ! First value in Av grid is 10**-ism - Change accordingly
    INTEGER, PARAMETER               :: ism = 6
    REAL (KIND=dp), PARAMETER        :: s2 = SQRT(2.0_dp)
    REAL (KIND=dp), PARAMETER        :: s3 = 3.0_dp * SQRT(5.0_dp/3.0_dp)
    REAL (KIND=dp), DIMENSION(0:7)   :: pt_obl
    DATA pt_obl / 1.0_dp, s2, 2.0_dp, 3.0_dp, s3, 5.0_dp, 7.0_dp, 10.0_dp /

    ! Control of variable step size (in tau)
    varmax = 0.5_dp
    dtaumin = 1.0e-2_dp

    pt_obl = pt_obl / tautav

    taumax = Avmax / tautav
    taulm = taumax

    ! Center of cloud
    tauc = 0.5_dp * taumax

    ! 10 VI 2011 - Seek a simpler way
    it = FLOOR(LOG10(tauc))
    td = tauc / 10.0_dp**it
    IF (td >= 10.0_dp / tautav) THEN
       td = td / 10.0_dp
       it = it + 1
    ENDIF

    IF (it < -ism) THEN
       PRINT *, "  Modelling a slab smaller than Av =", 10.0_dp**(-ism),  " is not currently possible"
       PRINT *, "  Either increase the slab size or modify the code in routine INIT_PROFILE_0"
       STOP
    ENDIF
    i  = ism + 1
    k = 0
    outer1: DO
       i = i - 1
       DO j = 0, 6
          td = pt_obl(j) * 10.0_dp**(-i)
          IF (ABS(td - tauc)/tauc < 1.0e-3_dp .OR. td >= tauc) EXIT outer1
          k = k + 1
       ENDDO
    ENDDO outer1
    npo = 2 * (k + 1)
    ALLOCATE (tau_o(0:npo))
    ALLOCATE (dtau_o(0:npo))
    tau_o(0) = 0.0_dp
    dtau_o(0) = 0.0_dp
    i  = ism + 1
    k = 0
    outer2: DO
       i = i - 1
       DO j = 0, 6
          td = pt_obl(j) * 10.0_dp**(-i)
          IF (ABS(td - tauc)/tauc < 1.0e-3_dp .OR. td >= tauc) EXIT outer2
          k = k + 1
          tau_o(k) = td
          dtau_o(k) = td - tau_o(k-1)
       ENDDO
    ENDDO outer2
    tau_o(npo/2) = tauc
    dtau_o(npo/2) = tauc - tau_o(k)
    DO i = 1, k
       j = npo/2 + i
       tau_o(j) = tau_o(j-1) + dtau_o(npo/2-i+1)
       dtau_o(j) = dtau_o(npo/2-i+1)
    ENDDO
    tau_o(npo) = taumax
    dtau_o(npo) = dtau_o(1)
    ! End

    DO i = 0, npo
       IF (i > 0 .AND. dtau_o(i) == 0.0_dp) THEN
          PRINT *, " Please change slightly Avmax!"
          STOP
       ENDIF
    ENDDO
    dtau(0:npo) = dtau_o(0:npo)

    ! Initial integrated weighted molecular profiles and optical depth
    ALLOCATE (abh_o(0:npo))
    ALLOCATE (abh2_o(0:npo))
    ALLOCATE (tgaz_o(0:npo+1))
    ALLOCATE (tdust_o(npg,0:npo))
    ALLOCATE (dens_o(0:npo))

    ! Initial temperature
    IF (ifeqth == 0 .AND. ifisob /= 4) THEN
       tgaz_o(0:npo+1) = tg_init
    ELSE
       t1 = tg_init
       t2 = tg_init
       DO i = 0, npo
          ! JLB - 7 III 2016 - Compute approximate equilibrium temperature
          CALL T_INIT0(t1, nh_init, radm*EXP(-sig*tau_o(i)))
          CALL T_INIT0(t2, nh_init, radp*EXP(-sig*(taumax-tau_o(i))))
          tgaz_o(i) = t1 + t2
          ! JLB - 3 III 2016 - Supress asymetry wrt illuminated edge
          !tgaz_o(i) = tg_init * EXP(-tau_o(i)/(radm*1.0e-5_dp)) &
          !          + tg_init * EXP(-(taumax-tau_o(i))/(radp*1.0e-5_dp)) &
          !          + 20.0_dp
       ENDDO
       tgaz_o(npo+1) = tgaz_o(npo)
    ENDIF

    DO i = 1, npo-1
       IF (tau_o(i) == 0.0_dp) THEN
          abhm = 1.0_dp
       ELSE
          abhm = 0.5_dp - ATAN(10.0_dp * LOG10(1.0e4_dp*tau_o(i)/radm)) / xpi
       ENDIF
       IF (isoneside == 1) THEN
          t = tau_o(i)
          abhp = 0.0_dp
       ELSE
          t = MIN(tau_o(i),taumax-tau_o(i))
          IF (t == 0.0_dp) THEN
             abhp = 1.0_dp
          ELSE
             abhp = 0.5_dp - ATAN(10.0_dp &
                  * LOG10(1.0e4_dp*(taumax-tau_o(i))/radp)) / xpi
          ENDIF
       ENDIF
       abh_o(i) = nh_init * MAX(abhm, abhp)
       abh2_o(i) = (nh_init - abh_o(i)) * 0.5_dp + 1.0_dp
       toto = nh_init / (abh_o(i) + 2.0_dp * abh2_o(i))
       abh_o(i) = abh_o(i) * toto
       abh2_o(i) = (nh_init - abh_o(i)) * 0.5_dp
    ENDDO
    tdust_o = 15.0_dp

    ! Extrapolate to edges
    rap_0 = tau_o(1) / dtau_o(1)
    rap_n = (dtau_o(npo) + dtau_o(npo-1)) / dtau_o(npo-1)

    abh_o(0) = abh_o(1) + (abh_o(2) - abh_o(1)) * rap_0
    abh2_o(0) = abh2_o(1) + (abh2_o(2) - abh2_o(1)) * rap_0
    abh_o(npo) = abh_o(npo-2) + (abh_o(npo-1) - abh_o(npo-2)) * rap_n
    abh2_o(npo) = abh2_o(npo-2) + (abh2_o(npo-1) - abh2_o(npo-2)) * rap_n

    ! Initialisation of various other profiles
    ! TODO : QU'EST CE QUE CETTE INITIALISATION VIENT FAIRE ICI ????
    zeta = 1.0e-17_dp * fmrc

    IF (ifisob /= 2) THEN
       densh(0:npo) = nh_init
    ELSE
       densh(0:npo) = presse / (tgaz_o(0:npo) * 1.1_dp)
    ENDIF
    tgaz(0:npo) = tgaz_o(0:npo)
    dens_o(0:npo) = densh(0:npo)

    ! Secondary photons flux due to cosmic rays
    ! 1E3 cm-2 s-1 (Roberge, in Dalgarno's book)
    fphsec = 1.0e3_dp * fmrc

    ! conversion of turbulent velocity from km s-1 to cm s-1
    vturb = vturb * 1.0e5_dp

    ! Extinction curve
    CALL FM_PAR

  END SUBROUTINE INIT_PROFIL_0

  ! Case ifisob == 1 (i.e. profile read from external file)
  !   or ifisob == 4
  !%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE INIT_PROFIL_1
  !%%%%%%%%%%%%%%%%%%%%%%%

    USE PXDR_FLAGS
    USE PXDR_CONSTANTES
    USE PXDR_AUXILIAR
    USE PXDR_CHEM_DATA

    IMPLICIT NONE

    REAL (KIND=dp)                   :: t
    REAL (KIND=dp)                   :: tauc, td, toto
    REAL (KIND=dp)                   :: rap_0, rap_n
    REAL (KIND=dp)                   :: av_read, rapp
    REAL (KIND=dp)                   :: t_read, n_read, p_read
    INTEGER                          :: i, j, k, it
    INTEGER                          :: ind

    ! First value in Av grid is 10**-ism - Change accordingly
    INTEGER, PARAMETER               :: ism = 6
    REAL (KIND=dp), PARAMETER        :: s2 = SQRT(2.0_dp)
    REAL (KIND=dp), PARAMETER        :: s3 = 3.0_dp * SQRT(5.0_dp/3.0_dp)
    REAL (KIND=dp), DIMENSION(0:7)   :: pt_obl = (/ &
                1.0_dp, s2, 2.0_dp, 3.0_dp, s3, 5.0_dp, 7.0_dp, 10.0_dp /)

    INTEGER                          :: nnpt, nnpt2
    REAL (KIND=dp), DIMENSION (:), ALLOCATABLE :: prov_tau
    REAL (KIND=dp), DIMENSION (:), ALLOCATABLE :: prov_tau2
    CHARACTER (LEN=80)               :: ligne
    INTEGER                          :: prof = 0

    ! Control of variable step size (in tau)
    varmax = 0.5_dp
    dtaumin = 1.0e-2_dp

    pt_obl = pt_obl / tautav

    taumax = Avmax / tautav
    taulm = taumax

    ! 30 V 2002, linear interpolation in temperature and density grid
    !---------------------------------------------------------------------
    ! Read the temperature / density profile of the cloud from a .pfl file
    !
    ! This can be used to controle the temperature / densite profile of the cloud
    ! - First line should provide the number of points defining the profile
    ! - Next lines : Av[mag]  temperature[K]  proton_density[cm-3]
    !---------------------------------------------------------------------
    fichier=TRIM(data_dir)//"Astrodata/"//fprofil
    PRINT *," "
    PRINT *,"Reading temperature - density profile file :", TRIM(fichier)
    OPEN (iwrtmp, file=fichier, status="old")
    READ (iwrtmp,'(a60)') ligne
    ! number of points in the profile file and wether this is a variable pressure profile or not
    ligne = TRIM(ADJUSTL(ligne))
    print *, ligne, INDEX(TRIM(ADJUSTL(ligne))," ")
    IF (INDEX(TRIM(ADJUSTL(ligne))," ") > 0) THEN
       READ (ligne,*) pr_np, prof
       print *, pr_np, prof
    ELSE
       READ (ligne,*) pr_np
       print *, pr_np
    ENDIF
    pr_np = pr_np - 1     ! arrays begin at 0
    IF (ifisob < 0) THEN
       ALLOCATE (pr_tau(0:2*pr_np))
       ALLOCATE (pr_tem(0:2*pr_np))
       ALLOCATE (pr_den(0:2*pr_np))
       IF (prof == 1) THEN
          ALLOCATE (pr_pre(0:2*pr_np))
       ENDIF
    ELSE
       ALLOCATE (pr_tau(0:pr_np))
       ALLOCATE (pr_tem(0:pr_np))
       ALLOCATE (pr_den(0:pr_np))
       IF (prof == 1) THEN
          ALLOCATE (pr_pre(0:pr_np))
       ENDIF
    ENDIF
    DO i = 0, pr_np
!      READ (iwrtmp,*) av_read, pr_tem(i), pr_den(i)
       IF (prof == 1) THEN
          READ (iwrtmp,*) av_read, t_read, n_read, p_read
       ELSE
          READ (iwrtmp,*) av_read, t_read, n_read
       ENDIF
       IF (d_sour <= 0.0_dp) THEN
          pr_tau(i) = av_read / tautav
          pr_tem(i) = t_read
          pr_den(i) = n_read
          IF (prof == 1) THEN
             pr_pre(i) = p_read
          ENDIF
       ELSE
          pr_tau(pr_np-i) = (Avmax - av_read) / tautav
          pr_tem(pr_np-i) = t_read
          pr_den(pr_np-i) = n_read
          IF (prof == 1) THEN
             pr_pre(i) = p_read
          ENDIF
       ENDIF
    ENDDO

    !--- Check for consistency ----------------------------------
    IF (av_read < Avmax) THEN
       WRITE (iwrit2,'(" Cloud size is larger than maximum value in ",a20)') fprofil
       WRITE (iwrit2,'(10x,f10.5," > ",f10.5)') Avmax, av_read
       WRITE (iwrit2,'(" Please provide enough data for interpolation")')
       WRITE (*,'(" Cloud size is larger than maximum value in ",a20)') fprofil
       WRITE (*,'(10x,f10.5," > ",f10.5)') Avmax, av_read
       WRITE (*,'(" Please provide enough data for interpolation")')
       STOP
    ENDIF
    ! JLB 21 III 2014 - Keep value read in input file
!   nh_init = pr_den(0)
    tg_init = pr_tem(0)
    CLOSE (iwrtmp)
    IF (ifisob < 0) THEN
       DO i = 0, pr_np-1
          pr_tau(2*pr_np-i) = 2.0_dp * pr_tau(pr_np) - pr_tau(i)
          pr_tem(2*pr_np-i) = pr_tem(i)
          pr_den(2*pr_np-i) = pr_den(i)
          IF (prof == 1) THEN
             pr_pre(2*pr_np-i) = pr_pre(i)
          ENDIF
       ENDDO
       ifisob = -ifisob
       pr_np = pr_np * 2
    ENDIF

    !--- BUILD THE TAU GRID -------------------------------------
    ! Center of cloud
    tauc = 0.5_dp * taumax

    ! 10 VI 2011 - Seek a simpler way
    it = FLOOR(LOG10(tauc))
    td = tauc / 10.0_dp**it
    IF (td >= 10.0_dp / tautav) THEN
       td = td / 10.0_dp
       it = it + 1
    ENDIF
    IF (it < -ism) THEN
       PRINT *, "  Modelling a slab smaller than Av =", 10.0_dp**(-ism),  " is not currently possible"
       PRINT *, "  Either increase the slab size or modify the code in routine INIT_PROFILE_1"
       STOP
    ENDIF
    i  = ism + 1
    k = 0
    outer1: DO
       i = i - 1
       DO j = 0, 6
          td = pt_obl(j) * 10.0_dp**(-i)
          IF (ABS(td - tauc)/tauc < 1.0e-3_dp .OR. td >= tauc) EXIT outer1
          k = k + 1
       ENDDO
    ENDDO outer1
    npo = 2 * (k + 1)
    ALLOCATE (tau_o(0:npo))
    ALLOCATE (dtau_o(0:npo))
    tau_o(0) = 0.0_dp
    dtau_o(0) = 0.0_dp
    i  = ism + 1
    k = 0
    outer2: DO
       i = i - 1
       DO j = 0, 6
          td = pt_obl(j) * 10.0_dp**(-i)
          IF (ABS(td - tauc)/tauc < 1.0e-3_dp .OR. td >= tauc) EXIT outer2
          k = k + 1
          tau_o(k) = td
          dtau_o(k) = td - tau_o(k-1)
       ENDDO
    ENDDO outer2
    tau_o(npo/2) = tauc
    dtau_o(npo/2) = tauc - tau_o(k)
    DO i = 1, k
       j = npo/2 + i
       tau_o(j) = tau_o(j-1) + dtau_o(npo/2-i+1)
       dtau_o(j) = dtau_o(npo/2-i+1)
    ENDDO
    tau_o(npo) = taumax
    dtau_o(npo) = dtau_o(1)
    ! End

    DO i = 0, npo
       IF (i > 0 .AND. dtau_o(i) == 0.0_dp) THEN
          PRINT *, " Please change slightly Avmax!"
          STOP
       ENDIF
    ENDDO

    ! Get union of two grids
    nnpt = npo + pr_np + 2
    ALLOCATE (prov_tau(nnpt))
    ALLOCATE (prov_tau2(nnpt))
    prov_tau(1:npo+1) = tau_o(0:npo)
    prov_tau(npo+2:nnpt) = pr_tau(0:pr_np)

    ! Sort tau in the 2 grids
    CALL SORT (prov_tau)

    !- Correction of the tau grid
    !- Remove tau values that may be present twice
    !- Remove tau values above taumax
    nnpt2 = 0
    DO i = 1, nnpt-1
       IF ( (prov_tau(i) .NE. prov_tau(i+1))  &
            .AND. (prov_tau(i) <= taumax)   &
          ) THEN
          nnpt2 = nnpt2 + 1
          prov_tau2(nnpt2) = prov_tau(i)
       ENDIF
    ENDDO
    IF (prov_tau(nnpt) <= taumax) THEN
       nnpt2 = nnpt2 + 1
       prov_tau2(nnpt2) = prov_tau(nnpt)
    ENDIF

    !--- Fill the tau grid
    DEALLOCATE (tau_o, dtau_o)
    npo = nnpt2 - 1
    ALLOCATE (tau_o(0:npo))
    ALLOCATE (dtau_o(0:npo))
    tau_o(0:npo) = prov_tau2(1:nnpt2)
    dtau_o(0) = 0.0_dp
    DO i = 1, npo
       dtau_o(i) = tau_o(i) - tau_o(i-1)
    ENDDO

    DEALLOCATE (prov_tau)
    DEALLOCATE (prov_tau2)

    dtau(0:npo) = dtau_o(0:npo)
    ! Initial integrated weighted molecular profiles and optical depth
    ALLOCATE (abh_o(0:npo))
    ALLOCATE (abh2_o(0:npo))
    ALLOCATE (tgaz_o(0:npo+1))
    ALLOCATE (tdust_o(npg,0:npo))
    ALLOCATE (dens_o(0:npo+1))
    IF (prof == 1) THEN
       ALLOCATE (pres_o(0:npo+1))
    ENDIF

    ! Initial temperature and density
    ! Interpolation in input file
    DO i = 0, npo
       DO j = 0, pr_np-1
          IF (tau_o(i) <= pr_tau(j+1)) THEN
            ind = j
            EXIT
          ENDIF
       ENDDO
       rapp   = (tau_o(i) - pr_tau(ind)) / (pr_tau(ind+1) - pr_tau(ind))
       tgaz_o(i)= pr_tem(ind) + (pr_tem(ind+1) - pr_tem(ind)) * rapp
       dens_o(i)= pr_den(ind) + (pr_den(ind+1) - pr_den(ind)) * rapp
       IF (prof == 1) THEN
          pres_o(i) = pr_pre(ind) + (pr_pre(ind+1) - pr_pre(ind)) * rapp
       ENDIF
    ENDDO
    tgaz_o(npo+1) = tgaz_o(npo)
    dens_o(npo+1) = dens_o(npo)
    IF (prof == 1) THEN
       pres_o(npo+1) = pres_o(npo)
    ENDIF

    DO i = 1, npo-1
       IF (tau_o(i) == 0.0_dp) THEN
          abhm = 1.0_dp
       ELSE
          abhm = 0.5_dp - ATAN(10.0_dp * LOG10(1.0e4_dp*tau_o(i)/radm)) / xpi
       ENDIF
       IF (isoneside == 1) THEN
          t = tau_o(i)
          abhp = 0.0_dp
       ELSE
          t = MIN(tau_o(i),taumax-tau_o(i))
          IF (t == 0.0_dp) THEN
             abhp = 1.0_dp
          ELSE
             abhp = 0.5_dp - ATAN(10.0_dp &
                  * LOG10(1.0e4_dp*(taumax-tau_o(i))/radp)) / xpi
          ENDIF
       ENDIF
       abh_o(i) = pr_den(0) * MAX(abhm, abhp)
       abh2_o(i) = (pr_den(0) - abh_o(i)) * 0.5_dp + 1.0_dp
       toto = pr_den(0) / (abh_o(i) + 2.0_dp * abh2_o(i))
       abh_o(i) = abh_o(i) * toto
       abh2_o(i) = (pr_den(0) - abh_o(i)) * 0.5_dp
    ENDDO
    tdust_o = 15.0_dp

    ! Extrapolate to edges
    rap_0 = tau_o(1) / dtau_o(1)
    rap_n = (dtau_o(npo) + dtau_o(npo-1)) / dtau_o(npo-1)

    abh_o(0) = abh_o(1) + (abh_o(2) - abh_o(1)) * rap_0
    abh2_o(0) = abh2_o(1) + (abh2_o(2) - abh2_o(1)) * rap_0
    abh_o(npo) = abh_o(npo-2) + (abh_o(npo-1) - abh_o(npo-2)) * rap_n
    abh2_o(npo) = abh2_o(npo-2) + (abh2_o(npo-1) - abh2_o(npo-2)) * rap_n

    ! Initialisation of various other profiles
    zeta = 1.0e-17_dp * fmrc

    densh(0:npo) = dens_o(0:npo)
    tgaz(0:npo) = tgaz_o(0:npo)
    dens_o(0:npo) = densh(0:npo)

    ! Secondary photons flux due to cosmic rays
    ! 1E3 cm-2 s-1 (Roberge, in Dalgarno's book)
    fphsec = 1.0e3_dp * fmrc

    ! conversion of turbulent velocity from km s-1 to cm s-1
    vturb = vturb * 1.0e5_dp

    ! Extinction curve
    CALL FM_PAR

  END SUBROUTINE INIT_PROFIL_1

!   %%%%%%%%%%%%%%%%%
    SUBROUTINE FM_PAR
!   %%%%%%%%%%%%%%%%%

    ! Fitzpatrick and Massa data base of extinction curves
    USE PXDR_FLAGS
    USE PXDR_CONSTANTES

    IMPLICIT NONE

    INTEGER           :: i
    INTEGER           :: los_found ! flag=1 if line of sight found in data
    CHARACTER(LEN=15) :: los       ! name of the line of sight
    REAL(KIND=dp)     :: rrv_true  ! Rv found in litterature for this l.o.s.

       WRITE (iscrn,*) "    * Read dust extinction properties (Fitzpatrick and Massa)"
       WRITE (iscrn,*) "    * POURQUOI APPELLE-T-ON CELA DANS LA ROUTINE SUR nh / Temperature ????"

       fichier = TRIM(ADJUSTL(data_dir))//"Astrodata/line_of_sight.dat"
       PRINT *, " Open line of sight file:", TRIM(fichier)
       OPEN(iwrtmp,file=fichier,status="old",action="READ")
       READ(iwrtmp,*) ! commentaire
       READ(iwrtmp,*) ! commentaire
       los_found = 0
       DO i = 1, 10000
          READ(iwrtmp,*,END=110) los, rrv_true, y0, xgam, cc1, cc2, cc3, cc4
          los = TRIM(ADJUSTL(los))
          IF (los == "End_of_file") EXIT
          IF (los == TRIM(ADJUSTL(los_ext))) THEN
             los_found = 1
             IF (rrv /= rrv_true) THEN
                WRITE(iscrn,*)"**** WARNING ****"
                WRITE(iscrn,*)"Line of sight : ",TRIM(ADJUSTL(los_ext))
                WRITE(iscrn,*)"Entered value for Rv is :    ", rrv
                WRITE(iscrn,*)"Proper  value seems to be :  ", rrv_true
                WRITE(iscrn,*)"Program continues with Rv =  ", rrv
             ENDIF
             EXIT
          ENDIF
      ENDDO
110   CONTINUE
      CLOSE(iwrtmp)

      IF (los_found == 0) THEN
         WRITE(iscrn,*)
         WRITE(iscrn,*) "***************** WARNING ***********************"
         WRITE(iscrn,*) "Line of sight not found in 'line_of_sight.dat': "
         WRITE(iscrn,*) "Line of sight searched : ", los_ext
         WRITE(iscrn,*) "Automatic switch to 'GALAXY' extinction curve"
         WRITE(iscrn,*) "Automatic switch to Rv = 3.1"
         WRITE(iscrn,*) "*************************************************"
         WRITE(iwrit2,*)
         WRITE(iwrit2,*) "***************** WARNING ***********************"
         WRITE(iwrit2,*) "Line of sight not found in 'line_of_sight.dat': "
         WRITE(iwrit2,*) "Line of sight searched : ", los_ext
         WRITE(iwrit2,*) "Automatic switch to 'GALAXY' extinction curve"
         WRITE(iwrit2,*) "Automatic switch to Rv = 3.1"
         WRITE(iwrit2,*) "*************************************************"
         y0   =  4.59_dp
         xgam =  1.05_dp
         cc1  = -0.38_dp
         cc2  =  0.74_dp
         cc3  =  3.96_dp
         cc4  =  0.26_dp
         rrv  =  3.1_dp
      ENDIF

    END SUBROUTINE FM_PAR

!=======================================================================
!== SUBROUTINE GRPARAM
!
!== Requires : rgrmin, rgrmax, alpgr, rhogr
!=======================================================================
SUBROUTINE GRPARAM

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES
  USE PXDR_CHEM_DATA

  IMPLICIT NONE

  REAL (KIND=dp)                            :: f1, f2, f4, f5
  REAL (KIND=dp)                            :: f1sf4, f3sf4, f2sf3, f15s34
  REAL (KIND=dp)                            :: rapgr, fcolgg
  REAL (KIND=dp), PARAMETER                 :: x_la = 1.0e-6_dp      ! Photon attenuation length (Bakes & Tielens)
  REAL (KIND=dp), PARAMETER                 :: x_le = 1.0e-7_dp      ! Photon attenuation length (Bakes & Tielens)
  REAL (KIND=dp)                            :: aalp, fy, zetph, toto
  REAL (KIND=dp)                            :: dTd
  INTEGER                                   :: mm, i

  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:) :: abgr   ! Absissa of gaussian integration of the "big grain" component
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:) :: wbgr   ! Weight of gaussian integration of the "big grain" component
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:) :: apah   ! Absissa of gaussian integration of the PAH component
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:) :: wpah   ! Weight of gaussian integration of the PAH component

  ! Should this really be in this routine ?
  ! vmaxw : numerical constant in mean velocity computation
  ! vbar = vmaxw * SQRT(temp/m)
  vmaxw = SQRT(8.0_dp * xk / (xmh *xpi))

  !! 11/2013 EB : Add the PAH component

  !! I - Big grain component

  rapgr = rgrmax / rgrmin
  IF (rgrmax == rgrmin) THEN
     alpgr = 0.0_dp
  ENDIF

  ! Compute weight and absissas for Gaussian integration
  ! over size distribution
  IF (rapgr > 1.0_dp) THEN
     ! Determine the number of integration points needed
     toto = (rgrmax / rgrmin) - 1.0_dp
     npbgr = 1 + FLOOR(npmg * ((1.0_dp + toto) / (4.0_dp + toto)))
     npbgr = MIN(npbgr,npmg)
     ! allocate the abscissa and weights array
     ALLOCATE (abgr(npbgr), wbgr(npbgr))
     ! Compute abscissas and weights for Gauss integration
     CALL MY_GAUSS(abgr,wbgr)
  ELSE
     npbgr = 1
     ALLOCATE (abgr(npbgr), wbgr(npbgr))
     abgr(1) = rgrmin
     wbgr(1) = 1.0_dp
  ENDIF
  WRITE(iscrn,*) "    * Number of sizes in the big grain distribution : ", npbgr
  DO mm = 1, npbgr
!    PRINT *, mm, wbgr(mm), abgr(mm)
     PRINT *, mm, abgr(mm), wbgr(mm)
  ENDDO

  ! Auxiliary quantities. We use an expansion for R-1 < 0.1
  ! fi = Integral from Rmin to Rmax of (x**(i-1) x**(-alpgr) dx)
  IF (rapgr > 1.1_dp) THEN
     f1 = (rgrmax**(1.0_dp-alpgr) - rgrmin**(1.0_dp-alpgr)) / (1.0_dp-alpgr)
     f2 = (rgrmax**(2.0_dp-alpgr) - rgrmin**(2.0_dp-alpgr)) / (2.0_dp-alpgr)
     f3 = (rgrmax**(3.0_dp-alpgr) - rgrmin**(3.0_dp-alpgr)) / (3.0_dp-alpgr)
     f4 = (rgrmax**(4.0_dp-alpgr) - rgrmin**(4.0_dp-alpgr)) / (4.0_dp-alpgr)
     f5 = (rgrmax**(5.0_dp-alpgr) - rgrmin**(5.0_dp-alpgr)) / (5.0_dp-alpgr)
     f1sf4  = f1 / f4
     f3sf4  = f3 / f4
     f2sf3  = f2 / f3
     f15s34 = (f1 * f5) / (f3 * f4)
  ELSE
     f1 = 1.0_dp
     f3sf4 = (3.0_dp - rapgr) / (2.0_dp * rgrmin)
     f1sf4 = (5.0_dp - 3.0_dp * rapgr) / (2.0_dp * rgrmin**3)
     f2sf3 = f3sf4
     f15s34 = f3sf4
  ENDIF

  ! Those quantities are for the "big grain" component only

  ! rgazgr : Volume of grain per nucleon (cm3) for big grains
  rgazgr = 1.4_dp * xmh * (1.0_dp - q_pah) * g_ratio / rhogr

  ! xngr : Numerical relative density of grains for big grains
  xngr = 3.0_dp * rgazgr * f1sf4 / (4.0_dp * xpi)

  ! agrnrm : Normalisation factor for big grains
  agrnrm = xngr / f1

  ! PRINT *, " <4 pi a**2> =", 4.0_dp * xpi * f3sf4 / f1sf4

  ! signgr : mean of ngr * sigma over nH (cm2)
  signgr = 3.0_dp * rgazgr * f3sf4 / 4.0_dp

  ! fcolgr : Geometrical factor used for grain-grain collisions (cm-1)
  fcolgg = f3sf4 + 2.0_dp * f2sf3 + f15s34

  ! rdeso : desorption velocity per grain-grain collision
  rdeso = 1.5_dp * (vturb / 10.0_dp) * rgazgr * fcolgg

  ! sngclb : Coulomb interaction caracteristic constant (unused)
  sngclb = 2.0_dp * xqe2 * f2sf3 / (3.0_dp * xk)

  ! s_gr_t_bgr : total "big grains" surface
  ! s_gr_t_bgr must still be multiplied by n_H to get the total surface per cm-3
  s_gr_t_bgr = 3.0_dp * rgazgr * f3sf4

  !! II - PAH component

  a0_pah = 6.4E-8_dp ! central size for the PAH distribution
  sigma_pah = 0.1_dp ! sigma for the PAH distribution

  ! Compute weights and absissas for Gaussian integration
  ! over size distribution
  IF (q_pah > 0.0_dp) THEN
     nppah = 5
     ALLOCATE (apah(nppah), wpah(nppah))
     CALL MY_GAUSSHERMITE(apah,wpah)
  ELSE
     nppah = 0
     ALLOCATE (apah(nppah), wpah(nppah))
     apah = 0.0_dp
     wpah = 0.0_dp
  ENDIF
  WRITE(iscrn,*) "    * Number of sizes in the PAH distribution : ", nppah
  DO mm = 1, nppah
     PRINT *, mm, apah(mm), wpah(mm)
  ENDDO

  ! rgazgrpah : Volume of grain per nucleon (cm3) for PAH
  rgazgrpah = 1.4_dp * xmh * q_pah * g_ratio / rhogra

  ! agrnrmpah : Normalisation factor for PAHs
  agrnrmpah = q_pah * g_ratio * exp(-(9.0_dp/2.0_dp)*sigma_pah*sigma_pah) &
               * 1.4 * xmh / &
               ( (4.0_dp/3.0_dp) * xpi * a0_pah * a0_pah * a0_pah * rhogra)

  ! xngr : Numerical relative density of grains for PAH
  xngrpah = agrnrmpah

  ! signgr : mean of ngr * sigma over nH (cm2) (currently unused) for PAHs
  signgrpah = agrnrmpah * xpi * a0_pah * a0_pah * EXP(2 * sigma_pah * sigma_pah)

  ! s_gr_t_pah : total PAH surface
  ! s_gr_t_pah must still be multiplied by n_H to get the total surface per cm-3
  s_gr_t_pah = agrnrmpah * 4.0_dp * xpi * a0_pah * a0_pah * EXP(2 * sigma_pah * sigma_pah)

  !! III - Concatenation

  npg = nppah + npbgr

  ALLOCATE ( adust(npg), wwmg(npg) )
  ALLOCATE ( x_nc(npg) )

  DO mm = 1, npbgr
    adust(mm) = abgr(mm)
    wwmg(mm) = wbgr(mm) * agrnrm
    x_nc(mm) = 4.0_dp * xpi * adust(mm)**3 * rhogr &
              / (3.0_dp * xmh * 12.0_dp)
  ENDDO
  IF ( nppah /=0 ) THEN
    DO mm = npbgr+1, npbgr+nppah
      adust(mm) = apah(mm-npbgr)
      wwmg(mm) = wpah(mm-npbgr) * agrnrmpah / SQRT(xpi)
      x_nc(mm) = 4.0_dp * xpi * adust(mm)**3 * rhogra &
              / (3.0_dp * xmh * 12.0_dp)
    ENDDO
  ENDIF
  WRITE(iscrn,*) "    * Number of sizes in the dust distribution : ", npg
  !! Debug
  print *, " A_gr PAH: ", agrnrmpah, "agrnrm: ", agrnrm
  DO mm = 1, npg
     print *, mm, adust(mm), wwmg(mm)
  ENDDO
  !STOP

  !! IV - Initialization of grain variables

  ALLOCATE (surfgr(npg), tdust(npg,0:noptm))
  ALLOCATE (zmoy(npg,0:noptm))

  ALLOCATE (bt_fy(npg))

  ! Initial grain charge is set to 0
  WRITE(iscrn,*) "    * Initialize grains charges and temperatures"
  zmoy = 0.0_dp
  grcharge = 0.0_dp
  ! grains initial temperature (for first iteration only)
  tdust(:,:) = MAX(15.0_dp, 15.0_dp * (1.0_dp + 0.3_dp*LOG10(radm)))

  ! Eq (16) of Bakes & Tielens
  DO mm = 1, npg
     aalp = adust(mm) / x_la + adust(mm) / x_le
     zetph = adust(mm) / x_la
     fy = aalp*aalp - 2.0_dp * aalp + 2.0_dp - 2.0_dp * EXP(-aalp)
     fy = fy / (zetph*zetph - 2.0_dp * zetph + 2.0_dp - 2.0_dp * EXP(-zetph))
     bt_fy(mm) = fy * (zetph / aalp)**2
  ENDDO

  surfgr = 4.0_dp * xpi * wwmg(1:npg) * adust(1:npg)*adust(1:npg)

  ! total dust surface
  ! s_gr_t must still be multiplied by n_H to get the total surface per cm-3
  s_gr_t = s_gr_t_bgr + s_gr_t_pah

  ! --------------------------------------------------------------------------------------
  ! Allocate & initialize tables of possible dust temperatures, energies, & emitted power
  ! --------------------------------------------------------------------------------------
  ALLOCATE(Tdposs(nTd))
  ALLOCATE(Edposs(npg,nTd))
  ALLOCATE(D_Edposs(nTd,npg))
  ALLOCATE(ldposs(npg,nTd))
  ALLOCATE(Peposs(npg,nTd))
  ALLOCATE(eff_phel(npg,0:noptm))
  ALLOCATE(eff_cte(npg,0:noptm,3))
  ! --------------------------------------------------------------------------------------
  ! Dust temperature grid. Needs to be sufficiently and smartly sampled
  !    - the first attempt is an exponential function of the index
  !    - the second one is a more complicated function to better sample large temperatures
  !    - we should maybe use a tanh function of the index for the steps ???
  ! --------------------------------------------------------------------------------------
  Tdposs(:) = 0.0_dp
  !dtd = 1.0e+1_dp**(LOG10(Tdmax/Tdmin)/DBLE(nTd))
  dtd = 1.0e+1_dp**( ( LOG10(Tdmax/Tdmin) - aTd*LOG10(DBLE(nTd)) ) / DBLE(nTd) )
  DO i = 1, nTd
     !Tdposs(i) = Tdmin*dtd**(DBLE(i))
     Tdposs(i) = Tdmin*dtd**(DBLE(i)) * DBLE(i)**(aTd)
  ENDDO
  Edposs(:,:)   = 0.0_dp
  D_Edposs(:,:) = 0.0_dp
  ldposs(:,:)   = 0.0_dp
  Peposs(:,:)   = 1.0_dp
  ! --------------------------------------------------------------------------------------
  ! Number of refinement points for the computation of dust emissivity.
  ! --------------------------------------------------------------------------------------
  nraff = NINT(LOG(DBLE(nraff) * 250.0_dp/DBLE(nTd)) / LOG(2.0_dp))

END SUBROUTINE GRPARAM

!================================================================
! SUBROUTINE : STICKING
!================================================================
SUBROUTINE STICKING(iopt, ir, ir1, stickH)

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES
  USE PXDR_CHEM_DATA

  IMPLICIT NONE

  INTEGER,        INTENT (IN)                :: iopt      ! Position in cloud
  INTEGER,        INTENT (IN)                :: ir        ! Reaction number
  INTEGER,        INTENT (IN)                :: ir1       ! Reactant number
  REAL (KIND=dp), INTENT (OUT), DIMENSION(:) :: stickH    ! Sticking coefficient

  REAL (KIND=dp) :: t2

!----------------------------------------------------------------
! Computes sticking coefficients from different prescriptions
! 1- istic = 1 : Sticking coeff is equals to gamma of the
!                adsorption reaction read in the chemistry file
! 2- istic = 2 : Trick from Sternberg & Dalgarno, 1995, ApJS, 99, 565
!                to get nearly 1.0 at low temperature
! 3- istic = 3 : Expression from Andersson & Wannier
!                ApJ, 402, 585, 1993
! 4- istic = 4 : Our expression from Pineau des Forets and Flower
!                MNRAS
! 5- istic = 5 : Other possibility from Jacques Le Bourlot
!
! 6- istic = 6 : Same sticking as for chemisorbed H
!----------------------------------------------------------------
! - 1 I 2015 - JLB
!   Sticking coefficients are constants for all sizes of big grains
!   s = 0 on PAH for all species except H and D
!----------------------------------------------------------------

  IF (istic == 1) THEN
     stickH = gamm(ir)

  ELSE IF (istic == 2) THEN
     t2 = temp / 100.0_dp
     stickH = 2.5_dp / (1.0_dp + 0.4_dp * SQRT(tdust(1,iopt) + t2) + 0.2_dp * t2)

  ELSE IF (istic == 3) THEN
     stickH = 1.0_dp / (temp/102.0_dp + 1.0_dp)**2

  ELSE IF (istic == 4) THEN
     IF (temp > 10.0_dp) THEN
        stickH = 1.0_dp * SQRT(10.0_dp) / SQRT(temp)
     ELSE
        stickH = 1.0_dp
     ENDIF

  ELSE IF (istic == 5) THEN
     stickH = 1.0_dp / (temp * temp * 1.0e-4_dp + 1.0_dp)

  ELSE IF (istic == 6) THEN
     stickH = 1.0_dp / (1.0_dp + (temp/T2_stick_ER)**ex_stick_ER)

  ENDIF

  ! No sticking on PAH except for H and D
  IF (ir1 /= i_h .AND. ir1 /= i_d) THEN
     stickH(npbgr+1:npg) = 0.0_dp
  ENDIF

END SUBROUTINE STICKING

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE MY_GAUSS(abgr,wbgr)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

   USE PXDR_FLAGS
   USE PXDR_CONSTANTES
   USE PXDR_AUXILIAR

   IMPLICIT NONE

   REAL (KIND=dp), DIMENSION (npbgr), INTENT (INOUT) :: abgr
   REAL (KIND=dp), DIMENSION (npbgr), INTENT (INOUT) :: wbgr

   INTEGER, PARAMETER                            :: normax=npmg*2

   REAL (KIND=dp), DIMENSION (normax+1,0:normax) :: xnu
   REAL (KIND=dp), DIMENSION (normax)            :: alp, btta, anu
   REAL (KIND=dp), DIMENSION (1:normax+1)        :: ff
   REAL (KIND=dp), DIMENSION (normax/2)          :: a = 0.0_dp, b = 0.0_dp

   REAL (KIND=dp)                                :: xplu, xmoi, amu0
   INTEGER                                       :: nnint, nmod
   REAL (KIND=dp)                                :: p, q, r
   INTEGER                                       :: j, k

   xplu = 0.5_dp * (rgrmin + rgrmax)
   xmoi = 0.5_dp * (rgrmax - rgrmin)

   alp(1) = xplu
   btta(1) = 0.0_dp

   nnint = npbgr

   nmod = 2 * nnint

   DO j = 2, nmod-1
      alp(j) = xplu
      btta(j) = xmoi * xmoi / (4.0_dp - 1.0_dp / ((j-1)*(j-1)))
   ENDDO

   DO k = 0, nmod
      ff(k+1) = (rgrmax**(k+1-alpgr) - rgrmin**(k+1-alpgr)) / (k+1-alpgr)
      xnu(1,k) = ff(k+1)
   ENDDO

   DO k = 0, nmod-1
      p = xnu(1,k+1)
      q = alp(1) * xnu(1,k)
      xnu(2,k) = p - q
      DO j = 3, k+2
         p = xnu(j-1,k-j+3)
         q = alp(j-1) * xnu(j-1,k-j+2)
         r = btta(j-1) * xnu(j-2,k-j+2)
         xnu(j,k-j+2) = p - q - r
      ENDDO
   ENDDO

   DO j = 1, nmod
      anu(j) = xnu(j,0)
   ENDDO

   CALL ORTHOG(nnint,anu,alp,btta,a,b)

   amu0 = ff(1)

   CALL GAUCOF(nnint,a,b,amu0,abgr,wbgr)

END SUBROUTINE MY_GAUSS

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE MY_GAUSSHERMITE(apah,wpah)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! EB 11/2013 :
! Computes abscissas and weights for a 5 points Gauss-Hermite integration.
! Converts into grain sizes for the integration over a lognormal PAH size
! distribution.

   USE PXDR_FLAGS
   USE PXDR_CONSTANTES
   USE PXDR_AUXILIAR

   IMPLICIT NONE

   REAL (KIND=dp), DIMENSION (nppah), INTENT (INOUT) :: apah
   REAL (KIND=dp), DIMENSION (nppah), INTENT (INOUT) :: wpah

   REAL (KIND=dp), DIMENSION (nppah)                 :: xghpah
   INTEGER                                           :: mm


   IF (nppah/=5) THEN
      PRINT *, "ERROR : Number of PAH sizes should be 5 in routine MY_GAUSSHERMITE !"
      STOP
   ENDIF

   !! from largest to smallest
   xghpah = (/ 2.02018287046_dp, 0.958572464614_dp, 0._dp &
            , -0.958572464614_dp, -2.02018287046_dp  /)

   wpah = (/ 0.019953242059_dp, 0.393619323152_dp, 0.945308720483_dp &
          ,  0.393619323152_dp, 0.019953242059_dp /)

   DO mm = 1, nppah    !! Conversion into sizes
      apah(mm) = a0_pah * EXP( SQRT(2.0_dp) * sigma_pah * xghpah(mm) )
   ENDDO

END SUBROUTINE MY_GAUSSHERMITE

! Use low pass Filter on results of chemistr and thermal balance
! to remove spurious oscillations if convergence is bad.
!%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE LOWPASS (np)
!%%%%%%%%%%%%%%%%%%%%%%

   USE PXDR_CONSTANTES
   USE PXDR_CHEM_DATA

   IMPLICIT NONE

   INTEGER, INTENT (IN)                       :: np
   INTEGER                                    :: i, j, n
   INTEGER                                    :: ns
   REAL (KIND=dp), DIMENSION (:), ALLOCATABLE :: ff
   REAL (KIND=dp), DIMENSION (:), ALLOCATABLE :: gg
   REAL (KIND=dp)                             :: alpa = 0.1_dp  ! This value is derived from ampirical tests
   REAL (KIND=dp)                             :: norm, auxi

   n = np + 1
   ALLOCATE (ff(-n:2*n))
   ALLOCATE (gg(-n:n))

   ! Build the filter. this is a sinc function
   gg (0) = alpa
   DO i = 1, n
      gg(i) = SIN(alpa*DBLE(i)) / DBLE(i)
      gg(-i) = gg(i)
   ENDDO

   DO ns = 1, nspec
      DO i = 1, n
         ff(i) = abnua(ns,i-1)
      ENDDO
      ! Pad the function to a constant outside the range (0,npo)
      ff(-n:0) = ff(1)
      ff(n+1:2*n) = ff(n)
      ! The filter is applied to a "order of one" transform of the function
      norm = SUM(ff) / DBLE(3*n+1)
      ff = LOG(ff/norm)

      ! Convolution
      DO i = 1, n
         auxi = 0.0_dp
         DO j = i-n, i+n
            auxi = auxi + ff(j) * gg(i-j)
         ENDDO
         ! Back to original function
         abnua(ns,i-1) = norm*EXP(auxi/xpi)
      ENDDO
   ENDDO

   ! Same with temperature
   DO i = 1, n
      ff(i) = tgaz(i-1)
   ENDDO
   ff(-n:0) = ff(1)
   ff(n+1:2*n) = ff(n)
   norm = SUM(ff) / DBLE(3*n+1)
   ff = LOG(ff/norm)

   DO i = 1, n
      auxi = 0.0_dp
      DO j = i-n, i+n
         auxi = auxi + ff(j) * gg(i-j)
      ENDDO
      tgaz(i-1) = norm*EXP(auxi/xpi)
   ENDDO

   ! Same with Density
   DO i = 1, n
      ff(i) = densh(i-1)
   ENDDO
   ff(-n:0) = ff(1)
   ff(n+1:2*n) = ff(n)
   norm = SUM(ff) / DBLE(3*n+1)
   ff = LOG(ff/norm)

   DO i = 1, n
      auxi = 0.0_dp
      DO j = i-n, i+n
         auxi = auxi + ff(j) * gg(i-j)
      ENDDO
      densh(i-1) = norm*EXP(auxi/xpi)
   ENDDO

   ! Same with grain charge
   DO ns = 1, npg
      DO i = 1, n
         ff(i) = zmoy(ns,i-1)
      ENDDO
      ff(-n:0) = ff(1)
      ff(n+1:2*n) = ff(n)

      ! Convolution
      DO i = 1, n
         auxi = 0.0_dp
         DO j = i-n, i+n
            auxi = auxi + ff(j) * gg(i-j)
         ENDDO
         ! Back to original function
         zmoy(ns,i-1) = auxi / xpi
      ENDDO
   ENDDO
   DO i = 0, npo
      grcharge(i) = 0.0_dp
      DO j = 1, npg
         grcharge(i) = grcharge(i) + zmoy(j,i) * wwmg(j)
      ENDDO
      grcharge(i) = grcharge(i) * densh(i)
   ENDDO

   DEALLOCATE (ff)
   DEALLOCATE (gg)

END SUBROUTINE LOWPASS

! Idem on a single vector
!%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE LOWPASS1 (np, xx)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%

   USE PXDR_CONSTANTES
   USE PXDR_CHEM_DATA

   IMPLICIT NONE

   INTEGER, INTENT (IN)                            :: np
   REAL (KIND=dp), DIMENSION(0:np), INTENT (INOUT) :: xx
   INTEGER                                         :: i, j, n
   REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: ff
   REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: gg
   REAL (KIND=dp)                                  :: alpa = 0.1_dp  ! This value is derived from ampirical tests
   REAL (KIND=dp)                                  :: norm, auxi

   n = np + 1
   ALLOCATE (ff(-n:2*n))
   ALLOCATE (gg(-n:n))

   ! Build the filter. this is a sinc function
   gg (0) = alpa
   DO i = 1, n
      gg(i) = SIN(alpa*DBLE(i)) / DBLE(i)
      gg(-i) = gg(i)
   ENDDO

   DO i = 1, n
      ff(i) = xx(i-1)
   ENDDO
   ff(-n:0) = ff(1)
   ff(n+1:2*n) = ff(n)
   norm = SUM(ff) / DBLE(3*n+1)
   ff = LOG(ff/norm)

   DO i = 1, n
      auxi = 0.0_dp
      DO j = i-n, i+n
         auxi = auxi + ff(j) * gg(i-j)
      ENDDO
      xx(i-1) = norm*EXP(auxi/xpi)
   ENDDO

   DEALLOCATE (ff)
   DEALLOCATE (gg)

END SUBROUTINE LOWPASS1

! Compute a first approximation of the gas temperature from an analytical approximation
! Uses cooling by OI and CII from Wolfire et al. (2003)
! And photoelectric heating by Rollig et al. (2006)
! With cuts off inside the cloud
SUBROUTINE T_INIT0(tt, nH, I0)

   USE PXDR_CONSTANTES
   USE PXDR_CHEM_DATA

   IMPLICIT NONE

   REAL (KIND=dp), INTENT (INOUT) :: tt           ! Temperature
   REAL (KIND=dp), INTENT (IN)    :: nH           ! Density
   REAL (KIND=dp), INTENT (IN)    :: I0           ! Radiation field

   REAL (KIND=dp)                 :: t1, t2
   REAL (KIND=dp)                 :: f1, f2, ff

   t1 = 10.0_dp
   t2 = 1.0e4_dp
   f1 = f_cool(t1,nH,I0)
   f2 = f_cool(t2,nH,I0)

   IF (f1 > 0.0_dp) THEN
      tt = t1
      RETURN
   ELSE IF (f2 < 0.0_dp) THEN
      tt = t2
      RETURN
   ELSE
      DO
         tt = SQRT(t1*t2)
         ff = f_cool(tt,nH,I0)
         IF ((t2/t1 - 1.0_dp) < 1.0e-3_dp) THEN
            RETURN
         ELSE IF (ff*f1 > 0.0_dp) THEN
            t1 = tt
            f1 = ff
         ELSE
            t2 = tt
            f2 = ff
         ENDIF
      ENDDO
   ENDIF

END SUBROUTINE T_INIT0

REAL (KIND=dp) FUNCTION f_cool(tt, nH, I0)

   USE PXDR_CONSTANTES
   USE PXDR_CHEM_DATA

   IMPLICIT NONE

   REAL (KIND=dp), INTENT (IN) :: tt           ! Temperature
   REAL (KIND=dp), INTENT (IN) :: nH           ! Density
   REAL (KIND=dp), INTENT (IN) :: I0           ! Radiation field

   REAL (KIND=dp)              :: yy, zz

   yy = tt**0.2_dp * EXP(-150.0_dp / tt)
   zz = 1.0_dp + SQRT(1.0_dp + 14.4_dp * tt**0.75_dp / nH)

   f_cool = yy - 7.62_dp * zz * (I0/nH) / (0.42_dp * zz + SQRT(tt) * (I0/nH))

END FUNCTION f_cool

END MODULE PXDR_PROFIL

