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

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES
  USE PXDR_PROFIL
  USE PXDR_AUXILIAR
  USE PXDR_CHEM_DATA

  REAL (KIND=dp), PUBLIC, DIMENSION (:), ALLOCATABLE    :: I_isot_m        ! Incident isotropic on left side
  REAL (KIND=dp), PUBLIC, DIMENSION (:), ALLOCATABLE    :: I_isot_p        ! Incident isotropic on right side

  PRIVATE

  TYPE SPECPOINT !-----------------------------------------------------------------------!
  ! This type contains the information on the output spectrum on a single point          !
  ! -------------------------------------------------------------------------------------!
     REAL (KIND=dp)             :: wl                  ! wavelength (in angstrom)        !
     REAL (KIND=dp)             :: spec_T              ! wavelength (in angstrom)        !
     REAL (KIND=dp)             :: spec_D              ! wavelength (in angstrom)        !
     REAL (KIND=dp)             :: spec_B              ! wavelength (in angstrom)        !
     TYPE (SPECPOINT),  pointer :: ptr_next => null () ! points to the next point        !
  END TYPE SPECPOINT

  TYPE (SPECPOINT), pointer     :: first_spec          ! pointer to the first point in the output spectrum
  TYPE (SPECPOINT), pointer     :: current_spec        ! pointer to the current point in the output spectrum

  TYPE DATPOINT!-------------------------------------------------------------------------!
  ! This type contains the information required to define a data point                   !
  ! -------------------------------------------------------------------------------------!
     INTEGER                   :: i                   ! index of the dtp on Av grid      !
     TYPE (DATPOINT),  pointer :: ptr_next => null () ! points the dpt immediately below !
  END TYPE DATPOINT

  TYPE SUBBUCKET !-----------------------------------------------------------------------!
  ! This type contains the information required to define a peak                         !
  ! -------------------------------------------------------------------------------------!
     TYPE (DATPOINT),  pointer :: ptr_max  => null () ! pointer to the maximal point     !
     INTEGER                   :: nbpts               ! number of points in the peak     !
     REAL (KIND=dp)            :: level               ! contrib of the peak to total sum !
     REAL (KIND=dp)            :: mean                ! mean value                       !
     REAL (KIND=dp)            :: rms                 ! rms value                        !
     TYPE (SUBBUCKET), pointer :: ptr_next => null () ! points the peak immediately below!
  END TYPE SUBBUCKET

  PUBLIC :: GetIntensities, LDVInt, LDVInt_dust, LDVInt_l, LDVInt_c

CONTAINS

!=========================================================================================
! SUBROUTINE GetIntensities
! Call LDVInt (compute intensities) for all species, all lines and for several angles
!=========================================================================================

SUBROUTINE GetIntensities

   USE PXDR_STR_DATA
   USE PXDR_RF_TOOLS

   IMPLICIT NONE

   REAL (KIND=dp)          :: xmu               ! cos(angle)

   CHARACTER(LEN=lenIDLIN) :: tampon            ! String to characterise the transition
   INTEGER                 :: flag_AllOutput
   INTEGER                 :: i, j, k

   ! ------------------------------------------------
   ! Compute the output spectrum
   ! - only in direction perpendicular to the cloud
   ! - start with the continuum (LDVInt_dust)
   ! - include lines when they are computed (LDVint)
   ! - use chain list to insert lines in the spectrum
   ! ------------------------------------------------
   DO i = 0, nwlg
      IF (i == 0) THEN
         CALL CREATE_SPECPOINT( first_spec )
         current_spec => first_spec
      ELSE
         CALL CREATE_SPECPOINT( current_spec%ptr_next )
         current_spec => current_spec%ptr_next
      ENDIF
      current_spec%wl = rf_wl%Val(i)
      CALL LDVInt_dust (1.0_dp, rf_wl%Val(i), current_spec%spec_D, current_spec%spec_B)
      current_spec%spec_T = current_spec%spec_D + current_spec%spec_B
   ENDDO

   flag_AllOutput = 0
   DO i = 1, nspl                                        ! Loop on all species for which populations are computed
      PRINT *, i," ",TRIM(spec_lin(i)%nam)
      DO j = 1, spec_lin(i)%ntr                          ! Loop on all possible transitions
         IF (spec_lin(i)%iup(j) <= spec_lin(i)%use) THEN ! If upper level of the transition is taken into account
            DO k = 1, nangle
               xmu = cos(AngleInt(k) * xpi / 180.0_dp)
               tampon = ""
               ! Intensity is stored in spec_lin(i)%int(j,k)
               CALL LDVInt(xmu, spec_lin(i), j, tampon, flag_AllOutput, ind_angle=k)
            ENDDO
         ENDIF
      ENDDO
   ENDDO

   ! ------------------------------------------------
   ! Copy the spectrum in the table out_spectrum
   ! - count the number of points
   ! - allocate output table and copy the spectrum
   ! Remove the chain list 
   ! ------------------------------------------------
   IF( ALLOCATED(out_spectrum) ) DEALLOCATE(out_spectrum)
   nwl_spectrum = 1
   current_spec => first_spec
   DO WHILE( associated(current_spec%ptr_next) )
      current_spec => current_spec%ptr_next
      nwl_spectrum = nwl_spectrum + 1
   ENDDO

   ALLOCATE (out_spectrum(nwl_spectrum, 4))
   DO i = 1, nwl_spectrum
      IF (i == 1) THEN
         current_spec => first_spec
      ELSE
         current_spec => current_spec%ptr_next
      ENDIF
      out_spectrum(i, 1) = current_spec%wl
      out_spectrum(i, 2) = current_spec%spec_T
      out_spectrum(i, 3) = current_spec%spec_D
      out_spectrum(i, 4) = current_spec%spec_B
   ENDDO

   CALL DESTROY_SPECPOINT_LIST( first_spec )

   ! ------------------------------------------------
   ! Test - write the spectrum in an ascii file
   ! before including it in the HDF5 standard outputs
   ! ------------------------------------------------
   file_spect = TRIM(out_dir)//TRIM(ADJUSTL(modele))//'.spect'
   OPEN (iwrtmp, file=TRIM(file_spect), status='unknown')
   WRITE (iwrtmp,'(A)') '# This file contains the emerging spectrum'
   WRITE (iwrtmp,'(A)') '# - wavelength    = wavelength (in A)'   
   WRITE (iwrtmp,'(A)') '# - spectrum tot  = total emerging spectrum (in erg cm-2 s-1 A-1 sr-1)'
   WRITE (iwrtmp,'(A)') '# - spectrum dust = pure dust contribution  (in erg cm-2 s-1 A-1 sr-1)'
   WRITE (iwrtmp,'(A)') '# - spectrum bckg = background contribution (in erg cm-2 s-1 A-1 sr-1)'
   WRITE (iwrtmp,'(A)') '#     wavelength      spectrum_tot     spectrum_dust     spectrum_bckg'
   DO i = 1, nwl_spectrum
      WRITE(iwrtmp,'(4(ES16.8E3,2X))') out_spectrum(i, 1), out_spectrum(i, 2), &
                                     & out_spectrum(i, 3), out_spectrum(i, 4)
   ENDDO
   CLOSE(iwrtmp)

   ! Deallocate tables of incident rad field
   DEALLOCATE ( I_isot_m )
   DEALLOCATE ( I_isot_p )

END SUBROUTINE GetIntensities

!=========================================================================================
! SUBROUTINE LDVInt
! Compute line intensities for a given species, transition, and at a given angle
! Store results in spec_lin(i)%int(j,k), spec_lin(i)%dint(j,k), and spec_lin(i)%optdep(j,k)
! Write additional outputs files if needed
!=========================================================================================
SUBROUTINE LDVInt (xmu, spelin, itr, tampon, flag_AllOutput, ind_angle)

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES
  USE PXDR_PROFIL
  USE PXDR_STR_DATA
  USE PXDR_RF_TOOLS ! For npixlam variable

  IMPLICIT NONE

  REAL (KIND=dp),           INTENT (IN)           :: xmu             !  Line of sight cosine
  TYPE(SPECTRA),            INTENT (INOUT)        :: spelin          !  Line data
  INTEGER,                  INTENT (IN)           :: itr             !  Transition index
  CHARACTER (LEN=lenIDLIN), INTENT (IN)           :: tampon          !  Line identity
  INTEGER,                  INTENT (IN)           :: flag_AllOutput  !  Flag
  INTEGER,                  INTENT (IN)           :: ind_angle       !  Index of the angle

  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: wl

  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: dtau_L          ! Integrand of line optical depth
  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: dtau_D          ! Integrand of dust optical depth
  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: tau_L           ! Line optical depth
  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: tau_D           ! Dust optical depth
  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: tau_T           ! Total optical depth (running variable)
  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: tau_nu          ! Total optical depth through cloud
  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: tau_nu_D
  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: tau_nu_L

  REAL (KIND=dp)                                  :: nuij           !  Line frequency (s-1)
  REAL (KIND=dp)                                  :: eij            !  E_ij = (c**2 / 2h nu**3) * D_ij
  REAL (KIND=dp)                                  :: dij            !  D_ij = (h nu / 4 pi) g_i A_ij
  INTEGER                                         :: ju, jl

  INTEGER                                         :: jpm = 100      ! Number of points in line profile
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: spec_BG        ! Background contribution to spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: dspec_D        ! Integrand of dust contribution to spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: dspec_cont     ! Integrand of dust contribution to continuum emission
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:,:)     :: dspec_L        ! Integrand of line contribution to spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:,:)     :: tau_nu_AvD, tau_nu_AvL
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: spec_D         ! Dust contribution to spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: spec_L         ! Line contribution to spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: spec_DT        ! Dust contribution to spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: spec_LT        ! Line contribution to spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: bkgd_contrib   ! background contribution to continuum emission
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: spec_cont      ! Continuum emission on the observer side
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: spec_T         ! Total spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: ibg            ! Cosmic background
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: contrib_line   ! Local (in space) contribution to Line emission
  REAL (KIND=dp)                                  :: emist          ! Total line emissivity (L + D)
  REAL (KIND=dp)                                  :: emisl          ! Total line emissivity (L alone)
  REAL (KIND=dp)                                  :: emisa          ! Total line emissivity (Apparent)
  REAL (KIND=dp)                                  :: emisc          ! Total continumm emission (without gas)
  REAL (KIND=dp)                                  :: absol          ! Total line absorption
  REAL (KIND=dp)                                  :: bkgdc          ! Background integrated contribution to continuum emission

  INTEGER                                         :: i, j, j_wl
  REAL (KIND=dp)                                  :: nu, dnu, ddnu, yy
  REAL (KIND=dp)                                  :: wlth, wlmin, wlmax
  TYPE (SPECPOINT), pointer                       :: save_spec      ! pointer to the next continuum point after the line
  TYPE (SPECPOINT), pointer                       :: tamp_spec      ! dummy pointer to deallocate unnecessary continuum points
  !REAL (KIND=dp)                                 :: fac_exp

  ! Variables for the analysis of local contribution to line emission
  REAL (KIND=dp)                                  :: bucket         ! total contrib to line emission starting with maximums
  REAL (KIND=dp)                                  :: thshd_pk=0.9_dp! threshold value. Only peaks that all together
                                                                    ! contribute to more than this value are analysed
  LOGICAL,          ALLOCATABLE, DIMENSION(:)     :: prevmax        ! used to mask the positions in the cloud
  INTEGER                                         :: nsubbck        ! number of sub-buckets -> number of independent maximum of contrib_line
  INTEGER                                         :: imax           ! position of sub-buckets -> positions of the  maximum of contrib_line
  REAL (KIND=dp)                                  :: dummy          ! dummy variable
  INTEGER,          PARAMETER                     :: corr_idx = 5   ! correlation lgth: 2 pixels distant by more than this value are independent
  LOGICAL                                         :: belong         ! true if the next point can be stored with one of the previous peak detected.
  TYPE (SUBBUCKET), pointer                       :: first_subbck   ! pointer to the first maximum peak
  TYPE (SUBBUCKET), pointer                       :: current_subbck ! pointer to the current maximum peak
  TYPE (DATPOINT),  pointer                       :: current_point  ! pointer to the current point
  REAL (KIND=dp)                                  :: sumval         ! dummy variables to compute and store the sum
  REAL (KIND=dp)                                  :: meanval        ! dummy variables to compute and store the mean
  REAL (KIND=dp)                                  :: rmsval         ! dummy variables to compute and store the rms
  TYPE (SUBBUCKET), pointer                       :: maxctrb_subbck ! pointer to the peak with the max contrib
  TYPE (SUBBUCKET), pointer                       :: curctrb_subbck ! pointer to the current peak with the max contrib
  REAL (KIND=dp)                                  :: lvlmax         ! dummy variables to classify peaks according to their contrib to line intensity
  REAL (KIND=dp)                                  :: lvllim         ! dummy variables to classify peaks according to their contrib to line intensity
  INTEGER                                         :: k

  ! ======================================================================================
  ! INITIALIZATION
  ! ======================================================================================

  ! Set this by hand
  !F_W_LINE_MAP = 1

  ! -------------------------------------------
  ! Recover the incident radiation field
  ! -------------------------------------------
  IF (.NOT. ALLOCATED(I_incr_m)) ALLOCATE (I_incr_m(0:nwlg))
  IF (.NOT. ALLOCATED(I_incr_p)) ALLOCATE (I_incr_p(0:nwlg))
  IF (.NOT. ALLOCATED(wl))       ALLOCATE (wl(0:nwlg))

  ! La lecture du fichier flin n'est pas faite au bon endroit. Puisque LDVInt est appelée
  ! pour chaque transition & espèce, on lit ce fichier bien plus souvent que nécessaire
  IF( (.NOT. ALLOCATED(I_isot_m)).OR.(.NOT. ALLOCATED(I_isot_p)) ) THEN
     ALLOCATE (I_isot_m(0:nwlg))
     ALLOCATE (I_isot_p(0:nwlg))
     fichier = TRIM(out_dir)//TRIM(modele)//'.flin'
     OPEN (60, file=fichier, status="unknown")
     READ (60,*)
     DO j = 0, nwlg
        READ (60, '(1p,9e15.6E3)') wl(j), I_incr_m(j), I_isot_m(j), I_incr_p(j), I_isot_p(j)
     ENDDO
     CLOSE (60)
  ENDIF
  wl = rf_wl%Val

  ! -------------------------------------------
  ! Find index of wavelength in grid
  ! -------------------------------------------
  CALL RF_LOCATE (rf_wl, spelin%lac(itr) * 1.0e8_dp, j_wl)

  ! -------------------------------------------
  ! Compute intermediate quantities
  ! -------------------------------------------
  nuij = clum / spelin%lac(itr)
  dnu = MINVAL(spelin%dnu(itr,:)) / 20.0_dp
  ju = spelin%iup(itr)
  jl = spelin%jlo(itr)
  dij = (xhp * nuij / (4.0_dp * xpi)) * spelin%gst(ju) * spelin%aij(itr)
  eij = spelin%lac(itr)**2 * spelin%aij(itr) * spelin%gst(ju) / (8.0_dp*xpi)

  ALLOCATE (dtau_L(0:npo))
  ALLOCATE (dtau_D(0:npo))
  ALLOCATE (tau_L(0:npo))
  ALLOCATE (tau_D(0:npo))
  ALLOCATE (tau_T(0:npo))
  ALLOCATE (dspec_cont(0:npo))
  ALLOCATE (dspec_D(0:npo))
  ALLOCATE (spec_D(0:npo))
  ALLOCATE (spec_L(0:npo))
  ALLOCATE (contrib_line(0:npo))
  ALLOCATE (prevmax(0:npo))
  IF (.NOT. ALLOCATED(spec_T)) THEN
     ALLOCATE (dspec_L(0:npo,-jpm:jpm))
     ALLOCATE (spec_BG(-jpm:jpm))
     ALLOCATE (spec_T(-jpm:jpm))
     ALLOCATE (spec_LT(-jpm:jpm))
     ALLOCATE (spec_DT(-jpm:jpm))
     ALLOCATE (ibg(-jpm:jpm))
     ALLOCATE (tau_nu_AvD(0:npo,-jpm:jpm))
     ALLOCATE (tau_nu_AvL(0:npo,-jpm:jpm))
     ALLOCATE (tau_nu(-jpm:jpm))
     ALLOCATE (tau_nu_D(-jpm:jpm))
     ALLOCATE (tau_nu_L(-jpm:jpm))
     ALLOCATE (spec_cont(-jpm:jpm))
     ALLOCATE (bkgd_contrib(-jpm:jpm))
  ENDIF
  dtau_L       = 0.0_dp
  dtau_D       = 0.0_dp
  tau_L        = 0.0_dp
  tau_D        = 0.0_dp
  tau_T        = 0.0_dp
  dspec_cont   = 0.0_dp
  dspec_D      = 0.0_dp
  spec_D       = 0.0_dp
  spec_L       = 0.0_dp
  contrib_line = 0.0_dp
  prevmax      = .TRUE.
  dspec_L      = 0.0_dp
  spec_BG      = 0.0_dp
  spec_T       = 0.0_dp
  spec_LT      = 0.0_dp
  spec_DT      = 0.0_dp
  ibg          = 0.0_dp
  tau_nu       = 0.0_dp
  tau_nu_AvD   = 0.0_dp
  tau_nu_AvL   = 0.0_dp
  tau_nu_D     = 0.0_dp
  tau_nu_L     = 0.0_dp
  spec_cont    = 0.0_dp
  bkgd_contrib = 0.0_dp

  IF (ind_angle == 1) THEN
     spelin%optdep(itr,0:npo) = 0.0_dp
     spelin%dint(itr,0:npo)   = 0.0_dp
  ENDIF

  ! ======================================================================================
  ! COMPUTATION OF THE CONTRIBUTIONS TO THE TOTAL INTENSITY AT THE LINE WAVELENGTH RANGE
  ! ======================================================================================
  ! All the subsequent calculations follow Gonzalez Garcia et al., 2008, A&A, 485, 127
  ! *** Note on the complexity of the task and on the limitation of outputs
  ! - contributions are computed at different positions and wavelength (2D problem)
  ! - only the contributions to line emission and integrated line emission are saved in
  !   the output file. Without looking at the spectrum, no information is given on wether
  !   the line is observed in absorption or emission, or on wich of the dust or background
  !   dominate the continuum emission.
  ! - local contributions, i.e. spelin%optdep & spelin%dint are saved only for the direction
  !   perpendicular to the cloud surface
  ! *** Note on the computation of optical depths
  ! - The integration is done from tau = 0 to tau_max, so the integrated quantity is
  !   tau_T(t) - tau_T(s_max), where t is the current position along the ray, and s_max
  !   is the total size of the cloud, measured from intrance at the "back" side (tau_max)
  !   to the front side of the cloud, towards the observer
  ! - Optical depths are only saved for the center of the line which may not coincide with the
  !   maximum of optical depth or/and with the wavelength at which contribution to the line
  !   integrated intensities is the largest.
  ! ======================================================================================

  ! -------------------------------------------
  ! Dust optical depth (independant of profile)
  ! -------------------------------------------
  dtau_D(0:npo) = (du_prop%abso(j_wl) + du_prop%scat(j_wl)) * densh(0:npo)
  dtau_D(0:npo) = dtau_D(0:npo) / xmu
  DO i = 1, npo
     tau_D(i) = tau_D(i-1) + (dtau_D(i) + dtau_D(i-1)) * (d_cm(i) - d_cm(i-1)) * 0.5_dp
  ENDDO

  ! -------------------------------------------
  ! Scan line profile
  ! -------------------------------------------
  DO j = -jpm, jpm
     ddnu = j * dnu
     nu = nuij + ddnu
     yy = ddnu / nuij

     ! ----------------------------------------
     ! Background intensity
     ! - cmb intensity (not true for all lines)
     ! No more used
     ! ----------------------------------------
     !fac_exp = xhp*nu/(xk*tcmb)
     !IF (fac_exp > LOG(HUGE(1.0_dp))*0.9_dp) THEN
     !   ibg(j) = 0.0_dp
     !ELSE
     !   ibg(j) = 2.0_dp * xhp * nu**3 / (clum*clum)
     !   ibg(j) = ibg(j) / (EXP(xhp*nu/(xk*tcmb)) - 1.0_dp)
     !ENDIF
     ! ----------------------------------------
     ! Background intensity
     ! test - 8 VII 2014
     ! - real intensity on the back of the cloud
     ! - simplification: constant background intensity in the line
     ! ----------------------------------------
     ibg(j) = I_isot_p(j_wl) * 1.0e8_dp * clum / nu**2

     ! ----------------------------------------
     ! Line optical depth
     ! - optical depths obtained at line center are
     !   saved in spelin%optdep
     ! - optical depths saved only in the direction
     !   perpendicular to the cloud surface
     ! - negative optical depths are limited to l_hu
     !   to prevent large values of exp(-tau)
     !   This is an arbitrary correction which
     !   should be replaced at some point by a
     !   correct treatment of the maser effect
     !   -> note : masers cannot be treated
     !             in a 1D plan-parallel geom.
     !             By construction, infinite
     !             built up of energy in the
     !             directions // to the plan.
     ! ----------------------------------------
     dtau_L = (clum * eij / (SQRT(xpi) * nuij)) * spelin%abu &
            * (spelin%xre(jl,:) / spelin%gst(jl) - spelin%xre(ju,:) / spelin%gst(ju)) &
            * EXP(-(yy*clum/spelin%vel)**2) / (spelin%vel * xmu)
     DO i = 1, npo
        tau_L(i) = tau_L(i-1) + (dtau_L(i) + dtau_L(i-1)) * (d_cm(i) - d_cm(i-1)) * 0.5_dp
        IF (-tau_L(i) > l_hu) THEN
           tau_L(i) = - l_hu
        ENDIF
     ENDDO
     IF (j == 0) THEN
        IF (ind_angle == 1) THEN
           DO i = 1, npo
              spelin%optdep(itr,i) = tau_L(i)
           ENDDO
        ENDIF
     ENDIF

     ! ----------------------------------------
     ! Total optical depth
     ! ----------------------------------------
     tau_T = tau_L + tau_D
     tau_nu_AvL(:,j) = tau_L(:)
     tau_nu_AvD(:,j) = tau_D(:)
     tau_nu(j) = tau_T(npo)
     tau_nu_D(j) = tau_D(npo)
     tau_nu_L(j) = tau_L(npo)

     ! ----------------------------------------
     ! 1 - Background contribution
     !     to total intensity
     !     to continuum emission only
     ! ----------------------------------------
     spec_BG(j)      = ibg(j) * EXP(-tau_nu(j))
     bkgd_contrib(j) = ibg(j) * EXP(-tau_D(npo))
     spec_cont(j)    = bkgd_contrib(j)

     ! ----------------------------------------
     ! 2 - Dust contribution
     ! ----------------------------------------
     dspec_D     = (1.0e8_dp * spelin%lac(itr)**2 / clum) * du_prop%emis(j_wl,:) * densh(0:npo) * EXP(-tau_T) / xmu
     dspec_cont  = (1.0e8_dp * spelin%lac(itr)**2 / clum) * du_prop%emis(j_wl,:) * densh(0:npo) * EXP(-tau_D) / xmu
     spec_D(npo) = 0.0_dp
     dummy       = 0.0_dp
     DO i = npo-1, 0, -1
        spec_D(i) = spec_D(i+1) + (dspec_D(i) + dspec_D(i+1)) * (d_cm(i+1) - d_cm(i)) * 0.5_dp
        dummy = dummy + (dspec_cont(i) + dspec_cont(i+1)) * (d_cm(i+1) - d_cm(i)) * 0.5_dp
     ENDDO
     spec_cont(j) = spec_cont(j) + dummy

     ! ----------------------------------------
     ! 3 - Line contribution
     !   To check the influence of dust optical depth
     !   use only tau_L in the exponential ....
     ! ----------------------------------------
     dspec_L(0:npo,j) = (clum * dij / (SQRT(xpi) * nuij)) * (spelin%abu * spelin%xre(ju,:) / spelin%gst(ju)) &
             * EXP(-(yy*clum/spelin%vel)**2) * EXP(-tau_T) / (xmu *spelin%vel)
!            * EXP(-(yy*clum/spelin%vel)**2) * EXP(-tau_L) / (xmu *spelin%vel)
     spec_L(npo) = 0.0_dp
     DO i = npo-1, 0, -1
        spec_L(i) = spec_L(i+1) + (dspec_L(i,j) + dspec_L(i+1,j)) * (d_cm(i+1) - d_cm(i)) * 0.5_dp
     ENDDO

     spec_LT(j) = spec_L(0)
     spec_DT(j) = spec_D(0)
     spec_T(j)  = spec_BG(j) + spec_DT(j) + spec_LT(j)
  ENDDO

  ! ======================================================================================
  ! SAVE OR WRITE QUANTITIES FOR DIFFERENT OUTPUT FILES
  ! ======================================================================================

  ! -------------------------------------------
  ! Integration over line profile
  ! -------------------------------------------
  ! 1 - total emission / line emission / emisa (doesn't correspond
  !     to anything meaningful) / continuum emission
  !     total (integrated absorption)
  ! ---
  emist = 0.0_dp
  emisl = 0.0_dp
  emisa = 0.0_dp
  emisc = 0.0_dp
  absol = 0.0_dp
  bkgdc = 0.0_dp
  emist = emist + spec_T (-jpm) / 2.0_dp + spec_T (jpm) / 2.0_dp
  emisl = emisl + spec_LT(-jpm) / 2.0_dp + spec_LT(jpm) / 2.0_dp
  emisa = emisa + (spec_T(-jpm) - spec_DT(jpm)) / 2.0_dp + (spec_T(jpm) - spec_DT(jpm)) / 2.0_dp
  emisc = emisc + spec_cont(-jpm) / 2.0_dp + spec_cont(jpm) / 2.0_dp
  absol = absol + (spec_BG(-jpm) + spec_DT(-jpm) - spec_cont(-jpm)) / 2.0_dp &
                + (spec_BG( jpm) + spec_DT( jpm) - spec_cont( jpm)) / 2.0_dp
  bkgdc = bkgdc + bkgd_contrib(-jpm) / 2.0_dp + bkgd_contrib(jpm) / 2.0_dp
  DO j = -jpm+1, jpm-1
     emist = emist + spec_T(j)
     emisl = emisl + spec_LT(j)
     emisa = emisa + (spec_T(j) - spec_DT(jpm))
     emisc = emisc + spec_cont(j)
     absol = absol + (spec_BG(j) + spec_DT(j) - spec_cont(j))
     bkgdc = bkgdc + bkgd_contrib(j)
  ENDDO
  emist = emist * dnu
  emisl = emisl * dnu
  emisa = emisa * dnu
  emisc = emisc * dnu
  absol = absol * dnu
  bkgdc = bkgdc * dnu
  ! ---
  ! 2 - Local contributions to integrated line emission
  !     normalize contributions to total emission
  ! ---
  contrib_line = 0.0_dp
  DO i = npo-1, 0, -1
     contrib_line(i) = contrib_line(i) + dspec_L(i,-jpm) / 2.0_dp
     contrib_line(i) = contrib_line(i) + dspec_L(i, jpm) / 2.0_dp
  ENDDO
  DO j = -jpm+1, jpm-1
     DO i = npo-1, 0, -1
        contrib_line(i) = contrib_line(i) + dspec_L(i,j)
     ENDDO
  ENDDO
  DO i = npo-1, 0, -1
     contrib_line(i) = contrib_line(i) * dnu
     contrib_line(i) = contrib_line(i) / emisl
  ENDDO
  dummy = 0
  DO i = npo-1, 0, -1
     dummy = dummy + (contrib_line(i) + contrib_line(i+1)) * (d_cm(i+1) - d_cm(i)) * 0.5_dp
  ENDDO
  DO i = npo-1, 0, -1
     contrib_line(i) = contrib_line(i) / dummy
  ENDDO

  ! -------------------------------------------
  ! Integrated line, absorption, and continuum
  ! emission intensities are saved and are
  ! accessible in the HDF5 files
  ! -------------------------------------------
  IF (ind_angle /= 0) THEN
     spelin%int(itr,ind_angle) = emisl
     spelin%abso(itr,ind_angle) = absol
     spelin%cont(itr,ind_angle) = emisc
     spelin%bkgd_ctr_cont(itr,ind_angle) = bkgdc / emisc
     spelin%dust_ctr_cont(itr,ind_angle) = 1.0_dp - bkgdc / emisc
  ENDIF

  ! -------------------------------------------
  ! Local contributions to integrated line emis
  ! saved and accessible in the HDF5 only in
  ! the dir perpendicular to the cloud surface
  ! -------------------------------------------
  IF (ind_angle == 1) THEN
     DO i = npo-1, 0, -1
        spelin%dint(itr,i) = contrib_line(i)
     ENDDO
  ENDIF

  ! -------------------------------------------
  ! Save line profile in the output spectrum
  ! - Only in the dir perp to the cloud surface
  ! - Only for lines above or below the base
  !   line by more than 1%
  ! -------------------------------------------
  IF ( (ind_angle == 1).AND.&
       ( ABS( spec_T(0) - spec_T(jpm) ) / spec_T(jpm) > 1.0e-2_dp ).AND.&
       ( MAXVAL( spelin%xre(ju,:) ) > 1.0e-8_dp ) ) THEN

     wlmin = clum / (nuij + jpm * dnu) * 1e8_dp
     wlmax = clum / (nuij - jpm * dnu) * 1e8_dp
     ! ----------------------------------------
     ! find the continuum point that falls just
     ! before the line profile (< wlmin)
     ! ----------------------------------------
     current_spec => first_spec
     DO WHILE( current_spec%ptr_next%wl < wlmin )
        current_spec => current_spec%ptr_next
     ENDDO
     save_spec => current_spec%ptr_next

     ! ----------------------------------------
     ! scan the profile from wlmin to wlmax
     ! ----------------------------------------
     DO j = jpm, -jpm, -1
        ddnu = j * dnu
        nu = nuij + ddnu
        wlth = clum / nu * 1e8_dp
        ! -------------------------------------
        ! remove all continuum point which
        ! falls within the line profile
        ! -------------------------------------
        IF( wlth > save_spec%wl ) THEN
           tamp_spec => save_spec
           save_spec => save_spec%ptr_next
           DEALLOCATE(tamp_spec)
        ENDIF
        ! -------------------------------------
        ! create a new point in the spectrum
        ! and connect it to the previous point
        ! -------------------------------------
        IF (j == jpm) THEN
           CALL CREATE_SPECPOINT( tamp_spec )
           current_spec%ptr_next => tamp_spec
           current_spec => tamp_spec
        ELSE
           CALL CREATE_SPECPOINT( current_spec%ptr_next )
           current_spec => current_spec%ptr_next
        ENDIF
        ! -------------------------------------
        ! save the intensities of the new point
        ! conversion to erg cm-2 s-1 A-1 sr-1
        ! -------------------------------------
        current_spec%wl     = wlth
        current_spec%spec_T = spec_T(j)  * nu**2.0_dp / clum / 1e8_dp
        current_spec%spec_D = spec_DT(j) * nu**2.0_dp / clum / 1e8_dp
        current_spec%spec_B = spec_BG(j) * nu**2.0_dp / clum / 1e8_dp
     ENDDO
     ! ----------------------------------------
     ! connect the last point of the line
     ! profile to the next continuum point
     ! ----------------------------------------
     current_spec%ptr_next => save_spec
  ENDIF

  ! -------------------------------------------
  ! Build additional outputs if needed
  ! -------------------------------------------
  IF (flag_AllOutput == 1) THEN
     WRITE(*,'(A,3(2x,1p,E13.6),2x,"erg cm-2 s-1 str-1")') &
          TRIM(ADJUSTL(tampon)), emist, emisl, emisa

     ! ----------------------------------------
     ! Write 2D line maps. See for instance
     ! Fig. 2 of Gonzalez Garcia et al. (2008)
     ! ----------------------------------------
     IF (F_W_LINE_MAP == 1) THEN
        OPEN (36,FILE=TRIM(out_dir)//TRIM(tampon),STATUS="unknown")
        DO i = 0, npo
           DO j = -jpm, jpm
              WRITE (36,*) tautav*tau(i), j * dnu / nuij, dspec_L(i,j), tau_nu_AvD(i,j), tau_nu_AvL(i,j)
           ENDDO
           WRITE (36,'(" ")')
        ENDDO
        CLOSE (36)
     ENDIF

     ! ----------------------------------------
     ! Write line profiles integrated over Av
     ! ----------------------------------------
     IF (F_W_LINE_PROF == 1) THEN
        WRITE (35, '(/,"# ",A," nu:",f11.2," GHz, lamda:",f11.4," micron, mu: ",0pf8.4)') &
              TRIM(tampon), 1.0e-9_dp*nuij, 1.0e4_dp*spelin%lac(itr), xmu
        WRITE (35, '("#  I.T:",1pe12.5,", I.L:", e12.5,", I.ap:",e12.5," erg cm-2 s-1 str-1 ")') &
              emist, emisl, emisa
        WRITE (35, '("#  Int. Obs:",1pe12.5," K km s-1 ")') 0.5e-5_dp * emisl * spelin%lac(itr)**3 / xk
        WRITE (35, '("# D.nu/nu   Tau_nu_D   Tau_nu_L  Spec.T    Spec.BG    spec.DT    spec.LT    ibg")')
        DO j = -jpm, jpm
           ddnu = j * dnu
           yy = ddnu / nuij
           WRITE (35, "(1p,20e15.6E3)") yy, tau_nu_D(j), tau_nu_L(j), spec_T(j), spec_BG(j), spec_DT(j), spec_LT(j), ibg(j)
        ENDDO
     ELSE
        WRITE (35, '(A,f11.2,f11.4,1p,2e12.5)') TRIM(tampon), 1.0e-9_dp*nuij, 1.0e4_dp*spelin%lac(itr) &
                                              , emisl, 0.5e-5_dp * emisl * spelin%lac(itr)**3 / xk
     ENDIF
  ENDIF

  ! ======================================================================================
  ! ANALYSIS OF THE LOCAL CONTRIBUTIONS TO THE INTEGRATED LINE INTENSITIES
  ! ======================================================================================

  ! -------------------------------------------
  ! Initialization
  ! -> all the points are considered, no peaks
  ! -------------------------------------------
  prevmax = .TRUE.
  bucket  = 0.0_dp
  nsubbck = 0

  ! -------------------------------------------
  ! Find the number of local maximums in the
  ! table contrib_line(i)
  ! 1 - find the maximum of contrib_line(i)
  !     and mask it for the next iteration
  ! 2 - compare the maximum point to previous
  !     peaks to see if it can be associated to
  !     one of them
  ! 3 - allocate a new peak if necessary
  ! 4 - store the index of the point after the
  !     last point found for the current peak
  ! -------------------------------------------
  DO WHILE ( bucket < thshd_pk )
     ! ----------------------------------------
     ! find the maximum of contrib_line(i)
     ! and mask it for the next iteration
     !
     ! note BG: I don't know why but MAXLOC is
     !          not working properly !?
     ! ----------------------------------------
     !imax   = MAXLOC ( contrib_line(0:npo), 1, prevmax(0:npo) )
     imax = -1
     dummy = 0.0_dp
     DO i = 0, npo-1
        IF ( ( contrib_line(i) > dummy ).AND.( prevmax(i) ) ) THEN
           dummy = contrib_line(i)
           imax = i
        ENDIF
     ENDDO
     bucket = bucket + ( contrib_line(imax) + contrib_line(imax+1) ) &
                     * ( d_cm(imax+1) - d_cm(imax) ) * 0.5_dp
     prevmax(imax) = .FALSE.

     ! ----------------------------------------
     ! Estimate if the maximum belongs to one
     ! of the peaks already found. If it does
     ! - current_subbck -> to the peak
     ! - current_point  -> to the last point
     !                     saved in the peak
     ! ----------------------------------------
     belong = .FALSE.
     DO j = 1, nsubbck
        IF (j == 1) THEN
           current_subbck => first_subbck
        ELSE
           current_subbck => current_subbck%ptr_next
        ENDIF
        DO k = 1, current_subbck%nbpts
           IF (k == 1) THEN
              current_point => current_subbck%ptr_max
           ELSE
              current_point => current_point%ptr_next
           ENDIF
           IF ( ABS(imax - current_point%i) <= corr_idx ) THEN
              belong = .TRUE.
           ENDIF
        ENDDO
        IF ( belong ) EXIT
     ENDDO

     ! ----------------------------------------
     ! If the maximum doesn't belong to
     ! any previous peak, create a new peak
     ! ----------------------------------------
     IF ( .NOT. belong ) THEN
        nsubbck = nsubbck + 1
        IF ( nsubbck == 1 ) THEN
           CALL CREATE_SUBBUCKET( first_subbck )
           current_subbck => first_subbck
        ELSE
           CALL CREATE_SUBBUCKET( current_subbck%ptr_next )
           current_subbck => current_subbck%ptr_next
        ENDIF
     ENDIF

     ! ----------------------------------------
     ! Create a new point to store the index
     ! of the maximum
     ! ----------------------------------------
     current_subbck%nbpts = current_subbck%nbpts + 1
     IF ( .NOT. belong ) THEN
        CALL CREATE_DATPOINT( current_subbck%ptr_max )
        current_point => current_subbck%ptr_max
     ELSE
        CALL CREATE_DATPOINT( current_point%ptr_next )
        current_point => current_point%ptr_next
     ENDIF

     ! ----------------------------------------
     ! store the index of the maximum
     ! ----------------------------------------
     current_point%i = imax
  ENDDO

  ! -------------------------------------------
  ! Compute the properties of the ≠ peaks
  ! - contribution to total sum
  ! - mean and rms values
  ! -------------------------------------------
  current_subbck => first_subbck
  DO WHILE ( associated(current_subbck) )
     ! ---------------------------------------
     ! contribution of current peak to tot sum
     ! ---------------------------------------
     sumval = 0
     current_point => current_subbck%ptr_max
     DO WHILE ( associated(current_point) )
        i = current_point%i
        sumval = sumval + ( contrib_line(i) + contrib_line(i+1) ) &
                        * ( d_cm(i+1) - d_cm(i) ) * 0.5_dp
        current_point => current_point%ptr_next
     ENDDO
     current_subbck%level = sumval
     ! ---------------------------------------
     ! mean value of the current peak
     ! ---------------------------------------
     meanval = 0
     current_subbck%mean = 0
     current_point => current_subbck%ptr_max
     DO WHILE ( associated(current_point) )
        i = current_point%i
        meanval = meanval + ( tautav*tau(i)   * contrib_line(i)     &
                          +   tautav*tau(i+1) * contrib_line(i+1) ) &
                          * ( d_cm(i+1) - d_cm(i) ) * 0.5_dp
        current_point => current_point%ptr_next
     ENDDO
     meanval = meanval / sumval
     current_subbck%mean = meanval
     ! ---------------------------------------
     ! rms value of the current peak
     ! ---------------------------------------
     rmsval = 0
     current_point => current_subbck%ptr_max
     DO WHILE ( associated(current_point) )
        i = current_point%i
        rmsval = rmsval + ( (tautav*tau(i)   - meanval)**2.0_dp * contrib_line(i)     &
                        +   (tautav*tau(i+1) - meanval)**2.0_dp * contrib_line(i+1) ) &
                        * ( d_cm(i+1) - d_cm(i) ) * 0.5_dp
        current_point => current_point%ptr_next
     ENDDO
     rmsval = rmsval / sumval
     rmsval = SQRT(rmsval)
     current_subbck%rms = rmsval
     ! ---------------------------------------
     ! analyse next peak
     ! ---------------------------------------
     current_subbck => current_subbck%ptr_next
  ENDDO

  ! -------------------------------------------
  ! Classify the different peaks in order of
  ! contribution to the total line emission
  ! -------------------------------------------
  i = 1
  lvllim = 1.1_dp
  lvlmax = 0.0_dp
  DO WHILE ( i <= nsubbck )
     current_subbck => first_subbck
     DO WHILE ( associated(current_subbck) )
        IF ( (current_subbck%level > lvlmax).AND.(current_subbck%level < lvllim) ) THEN
           lvlmax = current_subbck%level
        ENDIF
        current_subbck => current_subbck%ptr_next
     ENDDO
     current_subbck => first_subbck
     DO WHILE ( associated(current_subbck) )
        IF (current_subbck%level == lvlmax) THEN
           EXIT
        ENDIF
        current_subbck => current_subbck%ptr_next
     ENDDO
     IF (i == 1) THEN
        CALL CREATE_SUBBUCKET( maxctrb_subbck )
        curctrb_subbck => maxctrb_subbck
     ELSE
        CALL CREATE_SUBBUCKET( curctrb_subbck%ptr_next )
        curctrb_subbck => curctrb_subbck%ptr_next
     ENDIF
     curctrb_subbck%ptr_max => current_subbck%ptr_max
     curctrb_subbck%nbpts = current_subbck%nbpts
     curctrb_subbck%level = current_subbck%level
     curctrb_subbck%mean  = current_subbck%mean
     curctrb_subbck%rms   = current_subbck%rms
     i = i + 1
     lvllim = lvlmax
     lvlmax = 0.0_dp
  ENDDO

  ! -------------------------------------------
  ! Save the properties of the main peak
  ! -------------------------------------------
  ! spelin%lvl_ctr(itr,ind_angle) = first_subbck%level
  ! spelin%pos_ctr(itr,ind_angle) = tautav*tau(first_subbck%ptr_max%i)
  ! spelin%moy_ctr(itr,ind_angle) = first_subbck%mean
  ! spelin%rms_ctr(itr,ind_angle) = first_subbck%rms
  ! -------------------------------------------
  ! Save the properties of the peak which
  ! contributes the most to the line emission
  ! -------------------------------------------
  IF (ind_angle /= 0) THEN
     spelin%lvl_ctr(itr,ind_angle) = maxctrb_subbck%level
     spelin%pos_ctr(itr,ind_angle) = tautav*tau(maxctrb_subbck%ptr_max%i)
     spelin%moy_ctr(itr,ind_angle) = maxctrb_subbck%mean
     spelin%rms_ctr(itr,ind_angle) = maxctrb_subbck%rms
  ENDIF

  ! -------------------------------------------
  ! Reset all the max points of the structures
  ! maxctrb_subbck and following to null.
  ! If not, problem of deallocation in the
  ! DESTROY_SUBBUCKET_LIST. It is not very
  ! elegant but it works - to be improved.
  ! -------------------------------------------
  curctrb_subbck => maxctrb_subbck
  DO WHILE ( associated(curctrb_subbck) )
     curctrb_subbck%ptr_max => null()
     curctrb_subbck => curctrb_subbck%ptr_next
  ENDDO

  ! -------------------------------------------
  ! Deallocate all the peaks and points
  ! -------------------------------------------
  CALL DESTROY_SUBBUCKET_LIST( first_subbck )
  CALL DESTROY_SUBBUCKET_LIST( maxctrb_subbck )

  DEALLOCATE (dtau_L, dtau_D)
  DEALLOCATE (tau_L, tau_D, tau_T)
  DEALLOCATE (tau_nu, tau_nu_D, tau_nu_L, tau_nu_AvD, tau_nu_AvL)
  DEALLOCATE (dspec_D)
  DEALLOCATE (dspec_cont)
  DEALLOCATE (dspec_L)
  DEALLOCATE (spec_BG, spec_D, spec_L)
  DEALLOCATE (spec_DT, spec_LT, spec_T)
  DEALLOCATE (spec_cont, bkgd_contrib)
  DEALLOCATE (ibg)
  DEALLOCATE (contrib_line)
  DEALLOCATE (prevmax)

END SUBROUTINE LDVInt

!=========================================================================================
! SUBROUTINE LDVInt_dust
!            Pure continuum part of the spectrum
!=========================================================================================
SUBROUTINE LDVInt_dust (xmu, wlth, spec_D0, spec_BG)

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES
  USE PXDR_PROFIL
  USE PXDR_STR_DATA
  USE PXDR_RF_TOOLS ! For npixlam variable

  IMPLICIT NONE

  REAL (KIND=dp),           INTENT (IN)           :: xmu             !  Line of sight cosine
  REAL (KIND=dp),           INTENT (IN)           :: wlth            !  Wavelength (A)
  REAL (KIND=dp),           INTENT (OUT)          :: spec_BG         ! Total spectra
  REAL (KIND=dp),           INTENT (OUT)          :: spec_D0         ! Total dust emission

  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: dtau_D          ! Integrand of dust optical depth
  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: tau_D           ! Dust optical depth

  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: dspec_D         ! Integrand of dust contribution to spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: spec_D          ! Dust contribution to spectra
  REAL (KIND=dp)                                  :: ibg             ! Background radiation (constant over line profile)

  INTEGER                                         :: i, j_wl

  ! Find index of wavelength in grid
  CALL RF_LOCATE(rf_wl, wlth, j_wl)

  ! Use same variable as in original LDVInt routine
  ALLOCATE (dtau_D(0:npo))
  ALLOCATE (tau_D(0:npo))
  ALLOCATE (dspec_D(0:npo))
  ALLOCATE (spec_D(0:npo))
  tau_D   = 0.0_dp
  spec_D  = 0.0_dp

  !---  Compute optical depth ------------------------------------------------------------------------------
  ! integration is done from tau = 0 to tau_max, so the integrated quantity is tau_T(t) - tau_T(s_max)
  !     where t is the current position along the ray, and s_max is the total size of the cloud, measured
  !     from intrance at the "back" side (tau_max) to the front side of the cloud, towards the observer

  ! Dust optical depth (independant of profile):
  dtau_D(0:npo) = (du_prop%abso(j_wl) + du_prop%scat(j_wl)) * densh(0:npo)
  dtau_D(0:npo) = dtau_D(0:npo) / xmu
  DO i = 1, npo
     tau_D(i) = tau_D(i-1) + (dtau_D(i) + dtau_D(i-1)) * (d_cm(i) - d_cm(i-1)) * 0.5_dp
  ENDDO

  ! Background Radiation at line center
  ! CMB is automatically included - No need to recompute it here
  ! Only the isotropic part of the incident field is used here
  ! TODO: add the case of background source for mu = 1
  IF (xmu < 1.0_dp) THEN
     ibg = rf_incIp%Val(j_wl)
  ELSE
     ibg = rf_incIp%Val(j_wl)
  ENDIF

  ! Background contribution
  spec_BG = ibg * EXP(-tau_D(npo))

  ! Dust contribution (per Angstrom)
  dspec_D = du_prop%emis(j_wl,:) * densh(0:npo) * EXP(-tau_D) / xmu
  spec_D(npo) = 0.0_dp
  DO i = npo-1, 0, -1
     spec_D(i) = spec_D(i+1) + (dspec_D(i) + dspec_D(i+1)) * (d_cm(i+1) - d_cm(i)) * 0.5_dp
  ENDDO
  ! spec_BG and spec_BG+spec_D0 are written in the output file by the calling routine
  spec_D0 = spec_D(0)

  DEALLOCATE (dtau_D)
  DEALLOCATE (tau_D)
  DEALLOCATE (dspec_D)
  DEALLOCATE (spec_D)

END SUBROUTINE LDVInt_dust

!=========================================================================================
! SUBROUTINE LDVInt_l
!            Convert routine LDVInt to Lambda units
!=========================================================================================
SUBROUTINE LDVInt_l (xmu, spelin, itr, tampon, wl1, wl2)

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES
  USE PXDR_PROFIL
  USE PXDR_STR_DATA
  USE PXDR_RF_TOOLS ! For npixlam variable

  IMPLICIT NONE

  REAL (KIND=dp),           INTENT (IN)           :: xmu             !  Line of sight cosine
  TYPE(SPECTRA),            INTENT (INOUT)        :: spelin          !  Line data
  INTEGER,                  INTENT (IN)           :: itr             !  Transition index
  CHARACTER (LEN=lenIDLIN), INTENT (INOUT)        :: tampon          !  Line identity
  REAL (KIND=dp)          , INTENT (OUT)          :: wl1, wl2

  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: dtau_L          ! Integrand of line optical depth
  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: dtau_D          ! Integrand of dust optical depth
  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: tau_L           ! Line optical depth
  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: tau_D           ! Dust optical depth
  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: tau_T           ! Total optical depth (running variable)
  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: tau_nu          ! Total optical depth through cloud
  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: tau_nu_D
  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: tau_nu_L

  REAL (KIND=dp)                                  :: nuij           !  Line frequency (s-1)
  REAL (KIND=dp)                                  :: eij            !  E_ij = (c**2 / 2h nu**3) * D_ij
  REAL (KIND=dp)                                  :: dij            !  D_ij = (h nu / 4 pi) g_i A_ij
  INTEGER                                         :: ju, jl

  INTEGER                                         :: jpm = 75       !  Number of points in line profile
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: spec_BG        ! Background contribution to spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: dspec_D        ! Integrand of dust contribution to spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:,:)     :: dspec_L        ! Integrand of line contribution to spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: spec_D         ! Dust contribution to spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: spec_L         ! Line contribution to spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: spec_DT        ! Dust contribution to spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: spec_LT        ! Line contribution to spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: spec_T         ! Total spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: ibg            ! Background radiation (constant over line profile)
  REAL (KIND=dp)                                  :: emist          !  Total line emissivity (L + D)
  REAL (KIND=dp)                                  :: emisl          !  Total line emissivity (L alone)
  REAL (KIND=dp)                                  :: emisl_Tv       !  Total line emissivity (L alone) in K km s-1

  INTEGER                                         :: i, j, j_wl, j_1, j_2
  REAL (KIND=dp)                                  :: dnu, yy
  REAL (KIND=dp)                                  :: wlth
  REAL (KIND=dp)                                  :: wl, dwl, ddwl

  ! 22 I 2011 - JLB
  ! Find index of wavelength in grid
  wlth = spelin%lac(itr) * 1.0e8_dp
  CALL RF_LOCATE(rf_wl, wlth, j_wl)
  ! Values on each side of line center are used for interpolation of the background radiation
  j_1 = j_wl - 1
  j_2 = j_wl + 1
  wl1 = rf_wl%Val(j_1)
  wl2 = rf_wl%Val(j_2)

  ! Frequencies used as in LDVInt
  nuij = clum / spelin%lac(itr)
  dnu  = MINVAL(spelin%dnu(itr,:)) / 10.0_dp
  dwl  = 1.0e8_dp * dnu * clum / nuij**2
  ju   = spelin%iup(itr)
  jl   = spelin%jlo(itr)
  dij  = (xhp * nuij / (4.0_dp * xpi)) * spelin%gst(ju) * spelin%aij(itr)
  eij  = spelin%lac(itr)**2 * spelin%aij(itr) * spelin%gst(ju) / (8.0_dp*xpi)

  ALLOCATE (dtau_L(0:npo))
  ALLOCATE (dtau_D(0:npo))
  ALLOCATE (tau_L(0:npo))
  ALLOCATE (tau_D(0:npo))
  ALLOCATE (tau_T(0:npo))
  ALLOCATE (dspec_D(0:npo))
  ALLOCATE (spec_D(0:npo))
  ALLOCATE (spec_L(0:npo))
  IF (.NOT. ALLOCATED(spec_T)) THEN
     ALLOCATE (dspec_L(0:npo,-jpm:jpm))
     ALLOCATE (spec_BG(-jpm:jpm))
     ALLOCATE (spec_T(-jpm:jpm))
     ALLOCATE (spec_LT(-jpm:jpm))
     ALLOCATE (spec_DT(-jpm:jpm))
     ALLOCATE (tau_nu(-jpm:jpm))
     ALLOCATE (tau_nu_D(-jpm:jpm))
     ALLOCATE (tau_nu_L(-jpm:jpm))
     ALLOCATE (ibg(-jpm:jpm))
  ENDIF
  tau_D   = 0.0_dp
  tau_L   = 0.0_dp
  spec_BG = 0.0_dp
  spec_D  = 0.0_dp
  spec_L  = 0.0_dp
  spec_T  = 0.0_dp

  !---  Compute optical depth ------------------------------------------------------------------------------
  ! integration is done from tau = 0 to tau_max, so the integrated quantity is tau_T(t) - tau_T(s_max)
  !     where t is the current position along the ray, and s_max is the total size of the cloud, measured
  !     from intrance at the "back" side (tau_max) to the front side of the cloud, towards the observer

  ! Dust optical depth (independant of profile):
  dtau_D(0:npo) = (du_prop%abso(j_wl) + du_prop%scat(j_wl)) * densh(0:npo)
  dtau_D(0:npo) = dtau_D(0:npo) / xmu
  DO i = 1, npo
     tau_D(i) = tau_D(i-1) + (dtau_D(i) + dtau_D(i-1)) * (d_cm(i) - d_cm(i-1)) * 0.5_dp
  ENDDO

  ! Background Radiation at line center
  ! CMB is automatically included - No need to recompute it here
  ! Only the isotropic part of the incident field is used here
  ! TODO: add the case of background source for mu = 1 (here, the same code is duplicated)
  IF (xmu < 1.0_dp) THEN
     DO j = -jpm, -1
        wl = wlth + j * dwl
        ibg(j) = I_isot_p(j_1) + (I_isot_p(j_wl) - I_isot_p(j_1)) &
               * (wl1 - wl) / (wl1 - wlth)
     ENDDO
     ibg(0) = I_isot_p(j_wl)
     DO j = 1, jpm
        wl = wlth + j * dwl
        ibg(j) = I_isot_p(j_wl) + (I_isot_p(j_2) - I_isot_p(j_wl)) &
               * (wlth - wl) / (wlth - wl2)
     ENDDO
  ELSE
     ! Add here perpendicular source
     DO j = -jpm, -1
        wl = wlth + j * dwl
        ibg(j) = I_isot_p(j_1) + (I_isot_p(j_wl) - I_isot_p(j_1)) &
               * (wl1 - wl) / (wl1 - wlth)
     ENDDO
     ibg(0) = I_isot_p(j_wl)
     DO j = 1, jpm
        wl = wlth + j * dwl
        ibg(j) = I_isot_p(j_wl) + (I_isot_p(j_2) - I_isot_p(j_wl)) &
               * (wlth - wl) / (wlth - wl2)
     ENDDO
  ENDIF

  !--- Scan line profile -----------------------------------------------------------------------------------
  DO j = -jpm, jpm
     ddwl = j * dwl
     wl   = wlth + ddwl
     yy = ddwl / wlth

     ! Line optical depth
     dtau_L = (clum * eij / (SQRT(xpi) * nuij)) * spelin%abu &
            * (spelin%xre(jl,:) / spelin%gst(jl) - spelin%xre(ju,:) / spelin%gst(ju)) &
            * EXP(-(yy*clum/spelin%vel)**2) / (spelin%vel * xmu)
     DO i = 1, npo
        tau_L(i) = tau_L(i-1) + (dtau_L(i) + dtau_L(i-1)) * (d_cm(i) - d_cm(i-1)) * 0.5_dp
     ENDDO

     ! Total optical depth
     tau_T       = tau_L + tau_D
     tau_nu(j)   = tau_T(npo)
     tau_nu_D(j) = tau_D(npo)
     tau_nu_L(j) = tau_L(npo)

     ! Background contribution
     spec_BG(j) = ibg(j) * EXP(-tau_nu(j))

     ! Dust contribution (per Angstrom)
     dspec_D = du_prop%emis(j_wl,:) * densh(0:npo) * EXP(-tau_T) / xmu
     spec_D(npo) = 0.0_dp
     DO i = npo-1, 0, -1
        spec_D(i) = spec_D(i+1) + (dspec_D(i) + dspec_D(i+1)) * (d_cm(i+1) - d_cm(i)) * 0.5_dp
     ENDDO

     ! Line contribution (per Angstrom)
     ! One can check the influence of dust oppacity by using only tau_L in the exponential
     dspec_L(0:npo,j) = (spelin%abu * spelin%xre(ju,:) / spelin%gst(ju)) &
             * (1.0e-8_dp * nuij * dij / SQRT(xpi)) &
             * EXP(-(yy*clum/spelin%vel)**2) * EXP(-tau_T) / (xmu * spelin%vel)
!            * EXP(-(yy*clum/spelin%vel)**2) * EXP(-tau_L) / (xmu * spelin%vel)
     spec_L(npo) = 0.0_dp
     DO i = npo-1, 0, -1
        spec_L(i) = spec_L(i+1) + (dspec_L(i,j) + dspec_L(i+1,j)) * (d_cm(i+1) - d_cm(i)) * 0.5_dp
     ENDDO

     spec_DT(j) = spec_D(0)
     spec_LT(j) = spec_L(0)
     spec_T(j)  = spec_BG(j) + spec_DT(j) + spec_LT(j)
  ENDDO

  ! Output
  emist = 0.0_dp
  emisl = 0.0_dp
  DO j = -jpm, jpm
     emist = emist + spec_T(j)
     emisl = emisl + spec_LT(j)
  ENDDO
  emist = emist * dwl
  emisl = emisl * dwl
  ! Convert to K km s-1
  emisl_Tv = emisl * 0.5e-5_dp * spelin%lac(itr)**3 / xk

  tampon = TRIM(ADJUSTL(tampon))
  WRITE(*,'(A,3(2x,1p,E13.6),2x,"erg cm-2 s-1 str-1")') tampon, emist, emisl

  ! The line profile is added to the full spectrum only if
  ! it is above or below the base line by more than 1%
  IF (ABS((spec_T(0) - spec_T(jpm)) / spec_T(jpm)) > 1.0e-2_dp &
      .AND. MAXVAL(spelin%xre(ju,:)) > 1.0e-8_dp) THEN
     DO j = -jpm, jpm
        ddwl = j * dwl
        WRITE (35, "(1p,4e16.8E3,a2)") wlth+ddwl, spec_T(j), spec_DT(j), spec_BG(j), " 1"
     ENDDO
     j = LEN_TRIM(tampon)
     WRITE (36, '(A,A,1p,4e18.10)') tampon(1:j), tampon(j+1:50), 1.0e-9_dp*nuij &
                                  , 1.0e4_dp*spelin%lac(itr), emisl, emisl_Tv
  ELSE
     ! Else call the continuum routine. Note that spec_T(0) is slightly different
     ! from the one calculated above (with line contribution to the optical depth and emissivity
     CALL LDVInt_c (xmu, wlth, spec_D(0), spec_BG(0))
     WRITE (35, "(1p,4e16.8E3,a2)") wlth, spec_D(0)+spec_BG(0), spec_D(0), spec_BG(0), " 0"
  ENDIF

  DEALLOCATE (dtau_L, dtau_D)
  DEALLOCATE (tau_L, tau_D, tau_T)
  DEALLOCATE (tau_nu, tau_nu_D, tau_nu_L)
  DEALLOCATE (dspec_D)
  DEALLOCATE (dspec_L)
  DEALLOCATE (spec_BG, spec_D, spec_L)
  DEALLOCATE (spec_DT, spec_LT, spec_T)
  DEALLOCATE (ibg)

END SUBROUTINE LDVInt_l

!=========================================================================================
! SUBROUTINE LDVInt_c
!            Pure continuum part of the spectrum
!=========================================================================================
SUBROUTINE LDVInt_c (xmu, wlth, spec_D0, spec_BG)

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES
  USE PXDR_PROFIL
  USE PXDR_STR_DATA
  USE PXDR_RF_TOOLS ! For npixlam variable

  IMPLICIT NONE

  REAL (KIND=dp),           INTENT (IN)           :: xmu             !  Line of sight cosine
  REAL (KIND=dp),           INTENT (IN)           :: wlth            !  Wavelength (A)
  REAL (KIND=dp),           INTENT (OUT)          :: spec_BG         ! Total spectra
  REAL (KIND=dp),           INTENT (OUT)          :: spec_D0         ! Total dust emission

  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: dtau_D          ! Integrand of dust optical depth
  REAL (KIND=dp), DIMENSION (:), ALLOCATABLE      :: tau_D           ! Dust optical depth

  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: dspec_D         ! Integrand of dust contribution to spectra
  REAL (KIND=dp), ALLOCATABLE, DIMENSION(:)       :: spec_D          ! Dust contribution to spectra
  REAL (KIND=dp)                                  :: ibg             ! Background radiation (constant over line profile)

  INTEGER                                         :: i, j_wl

  ! Find index of wavelength in grid
  CALL RF_LOCATE(rf_wl, wlth, j_wl)

  ! Use same variable as in original LDVInt routine
  ALLOCATE (dtau_D(0:npo))
  ALLOCATE (tau_D(0:npo))
  ALLOCATE (dspec_D(0:npo))
  ALLOCATE (spec_D(0:npo))
  tau_D   = 0.0_dp
  spec_D  = 0.0_dp

  !---  Compute optical depth ------------------------------------------------------------------------------
  ! integration is done from tau = 0 to tau_max, so the integrated quantity is tau_T(t) - tau_T(s_max)
  !     where t is the current position along the ray, and s_max is the total size of the cloud, measured
  !     from intrance at the "back" side (tau_max) to the front side of the cloud, towards the observer

  ! Dust optical depth (independant of profile):
  dtau_D(0:npo) = (du_prop%abso(j_wl) + du_prop%scat(j_wl)) * densh(0:npo)
  dtau_D(0:npo) = dtau_D(0:npo) / xmu
  DO i = 1, npo
     tau_D(i) = tau_D(i-1) + (dtau_D(i) + dtau_D(i-1)) * (d_cm(i) - d_cm(i-1)) * 0.5_dp
  ENDDO

  ! Background Radiation at line center
  ! CMB is automatically included - No need to recompute it here
  ! Only the isotropic part of the incident field is used here
  ! TODO: add the case of background source for mu = 1
  IF (xmu < 1.0_dp) THEN
     ibg = I_isot_p(j_wl)
  ELSE
     ibg = I_isot_p(j_wl)           ! Add here perpendicular source
  ENDIF

  ! Background contribution
  spec_BG = ibg * EXP(-tau_D(npo))

  ! Dust contribution (per Angstrom)
  dspec_D = du_prop%emis(j_wl,:) * densh(0:npo) * EXP(-tau_D) / xmu
  spec_D(npo) = 0.0_dp
  DO i = npo-1, 0, -1
     spec_D(i) = spec_D(i+1) + (dspec_D(i) + dspec_D(i+1)) * (d_cm(i+1) - d_cm(i)) * 0.5_dp
  ENDDO
  ! spec_BG and spec_BG+spec_D0 are written in the output file by the calling routine
  spec_D0 = spec_D(0)

  DEALLOCATE (dtau_D)
  DEALLOCATE (tau_D)
  DEALLOCATE (dspec_D)
  DEALLOCATE (spec_D)

END SUBROUTINE LDVInt_c

!=========================================================================================
! SUBROUTINE CREATE_SPECPOINT
! Creates and initializes a structure of type SPECPOINT
!=========================================================================================
SUBROUTINE CREATE_SPECPOINT( point )
    TYPE(SPECPOINT), pointer  :: point

    ALLOCATE( point )
    point%wl     = 0.0_dp
    point%spec_T = 0.0_dp
    point%spec_D = 0.0_dp
    point%spec_B = 0.0_dp
    point%ptr_next => null()
END SUBROUTINE CREATE_SPECPOINT

!=========================================================================================
! SUBROUTINE DESTROY_SPECPOINT_LIST
! Deallocate the memory associated to an entire serie of SPECPOINTS
! The serie is defined by the address of the first point "point"
!=========================================================================================
SUBROUTINE DESTROY_SPECPOINT_LIST( point )
    TYPE(SPECPOINT), pointer  :: point
    TYPE(SPECPOINT), pointer  :: current
    TYPE(SPECPOINT), pointer  :: elem

    elem => point
    DO WHILE ( associated(elem) )
       current => elem
       elem => current%ptr_next
       DEALLOCATE( current )
    ENDDO
END SUBROUTINE DESTROY_SPECPOINT_LIST

!=========================================================================================
! SUBROUTINE CREATE_DATPOINT
! Creates and initializes a structure of type DATPOINT
!=========================================================================================
SUBROUTINE CREATE_DATPOINT( point )
    TYPE(DATPOINT), pointer  :: point

    ALLOCATE( point )
    point%i = -1000
    point%ptr_next => null()
END SUBROUTINE CREATE_DATPOINT

!=========================================================================================
! SUBROUTINE CREATE_SUBBUCKET
! Creates and initializes a structure of type SUBBUCKET
!=========================================================================================
SUBROUTINE CREATE_SUBBUCKET( subbck )
    TYPE(SUBBUCKET), pointer  :: subbck

    ALLOCATE( subbck )
    subbck%ptr_max => null()
    subbck%nbpts =  0
    subbck%level =  0.0_dp
    subbck%mean  =  0.0_dp
    subbck%rms   =  0.0_dp
    subbck%ptr_next => null()
END SUBROUTINE CREATE_SUBBUCKET

!=========================================================================================
! SUBROUTINE DESTROY_DATPOINT_LIST
! Deallocate the memory associated to an entire serie of DATPOINTS
! The serie is defined by the address of the first point "point"
!=========================================================================================
SUBROUTINE DESTROY_DATPOINT_LIST( point )
    TYPE(DATPOINT), pointer  :: point
    TYPE(DATPOINT), pointer  :: current
    TYPE(DATPOINT), pointer  :: elem

    elem => point
    DO WHILE ( associated(elem) )
       current => elem
       elem => current%ptr_next
       DEALLOCATE( current )
    ENDDO
END SUBROUTINE DESTROY_DATPOINT_LIST

!=========================================================================================
! SUBROUTINE DESTROY_SUBBUCKET_LIST
! Deallocate the memory associated to an entire serie of SUBBUCKET
! The serie is defined by the address of the first subbucket "subbck"
!=========================================================================================
SUBROUTINE DESTROY_SUBBUCKET_LIST( subbck )
    TYPE(SUBBUCKET), pointer  :: subbck
    TYPE(SUBBUCKET), pointer  :: current
    TYPE(SUBBUCKET), pointer  :: elem

    elem => subbck
    DO WHILE ( associated(elem) )
       current => elem
       elem => current%ptr_next
       IF ( associated(current%ptr_max) ) THEN
          CALL DESTROY_DATPOINT_LIST ( current%ptr_max )
          current%ptr_max => null()
       ENDIF
       DEALLOCATE( current )
    ENDDO
END SUBROUTINE DESTROY_SUBBUCKET_LIST

END MODULE PXDR_INTENSITIES
