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

!%%%%%%%%%%%
PROGRAM PXDR
!%%%%%%%%%%%

  USE PXDR_FLAGS
  USE PXDR_CONSTANTES
  USE PXDR_CHEM_DATA
  USE PXDR_PROFIL
  USE PXDR_AUXILIAR
  USE PXDR_STR_DATA
  USE PXDR_RF_TOOLS
  USE PXDR_RF_INIT
  USE PXDR_TRANSFER
  USE PXDR_INITIAL
  USE PXDR_OUTPUT
  USE PXDR_OUTPUT_ASCII
  USE PXDR_FGK_TR
  USE PXDR_CHEMISTRY
  USE PXDR_BILTHERM
  USE PXDR_DUSTEM
  USE PXDR_INTENSITIES

  IMPLICIT NONE

  INTEGER                                :: iargc, iopt, itenua, nuse
  INTEGER                                :: i, ii, j, lev, mm, nsplit
  INTEGER                                :: summary_conv(1:11)
  REAL (KIND=dp)                         :: vartg, testv
  REAL (KIND=dp)                         :: xdens = 0.0_dp
  REAL (KIND=dp)                         :: xtemp = 0.0_dp
  REAL (KIND=dp)                         :: vart, varn, varh
  REAL (KIND=dp)                         :: varhd, varh2, varco, varc, varh2ogr, varcogr
  REAL (KIND=dp)                         :: convli_o
  REAL (KIND=dp)                         :: xlam0
  REAL (KIND=dp)                         :: aux_grch = 0.0_dp
  REAL (KIND=dp)                         :: aux_abel = 0.0_dp
  REAL (KIND=dp)                         :: aux_coef = 2.0_dp
  REAL (KIND=dp)                         :: chg_p, chg_m, chg_cons
  REAL (KIND=dp)                         :: var_ab

  INTEGER                                :: ndeb
  ! Detect bad convergence and apply a low pass filter to results
  INTEGER                                :: F_BADCONV = 0

  REAL (KIND=dp)                         :: runtime_start

  !--- Variables used in the Thermal Balance Debug mode
  LOGICAL                                :: done_check_thbal = .false.
  REAL (KIND=dp), DIMENSION(14)          :: av_check_thbal
  DATA av_check_thbal / 1.0e-6_dp, 3.0e-6_dp, 1.0e-5_dp, 3.0e-5_dp &
                      , 1.0e-4_dp, 3.0e-4_dp, 1.0e-3_dp, 3.0e-3_dp &
                      , 1.0e-2_dp, 3.0e-2_dp, 1.0e-1_dp, 3.0e-1_dp &
                      , 1.0e-0_dp, 3.0e-0_dp /
  INTEGER,        PARAMETER              :: ifaf_check_thbal  = 10

  !=======================================================================================
  ! WARNING : the line below is used by python script as key='value'. Consequently, this
  !           will be the version's name on the ISM plateform website attached to all the
  !           models we run and distribute to the community. Needs to be updated regularly
  !=======================================================================================
  version_code='PDRLight_rev_1827'

  CALL CPU_TIME(runtime_start)

  PRINT *,'********************************************************'
  PRINT *,'*                                                      *'
  PRINT *,'*                *****    ****     *****               *'
  PRINT *,'*                *   *    *   *    *   *               *'
  PRINT *,'*                *****    *   *    *****               *'
  PRINT *,'*                *        *   *    * *                 *'
  PRINT *,'*                *        ***      *  *                *'
  PRINT *,'*                                                      *'
  PRINT *,'*          Version : ',TRIM(version_code),'            *'
  PRINT *,'********************************************************'

  !=======================================================================================
  !== PART 1 : INITIALISATION
  !=======================================================================================

  WRITE(iscrn,*)
  WRITE(iscrn,*) "========================================================"
  WRITE(iscrn,*) "                   INITIALISATION                       "
  WRITE(iscrn,*) "========================================================"
  WRITE(iscrn,*)

  ! -------------------------------------------
  ! Choose the input file
  ! -------------------------------------------
  IF (iargc() .ne. 1) THEN
     inpfile="../data/pdr.in"
  ELSE
     CALL getarg(1,inpfile)
  ENDIF

  ! -------------------------------------------
  ! Test if the correct version of python exist
  ! -------------------------------------------
  IF (F_W_HDF5_STD == 1) THEN
  sh_cmd = "which "//TRIM(python_version)
  CALL SYSTEM (TRIM(ADJUSTL(sh_cmd)), python_exists)
  IF (python_exists /= 0) THEN
     WRITE(*,*) '*** Error: python2.7 is not installed on the computer'
     WRITE(*,*) '           -> "which python2.7" /=0'
     WRITE(*,*) '           -> PDR code stops'
     STOP
  ENDIF

  ! -------------------------------------------
  ! Read the metadata of all output quantities
  ! 1 - read number of lines in metadata files
  ! 2 - allocate the metadata tables
  ! 3 - read the metadata files and store info
  ! -------------------------------------------
  fichier = TRIM(data_dir)//TRIM(metdat_dir)//TRIM(metstd_fil)
  CALL READ_METADATA_NBL(fichier, nhdf5_std)
  ALLOCATE( metatab_std(nhdf5_std) )
  CALL READ_METADATA_DAT(fichier, metatab_std, nhdf5_std)

  fichier = TRIM(data_dir)//TRIM(metdat_dir)//TRIM(metche_fil)
  CALL READ_METADATA_NBL(fichier, nhdf5_che)
  ALLOCATE( metatab_che(nhdf5_che) )
  CALL READ_METADATA_DAT(fichier, metatab_che, nhdf5_che)

  fichier = TRIM(data_dir)//TRIM(metdat_dir)//TRIM(metana_fil)
  CALL READ_METADATA_NBL(fichier, nhdf5_ana)
  ALLOCATE( metatab_ana(nhdf5_ana) )
  CALL READ_METADATA_DAT(fichier, metatab_ana, nhdf5_ana)
  ENDIF

  ! -------------------------------------------
  ! Read the input files (parameters, chemisty,
  ! ...) and initialise all related quantites
  ! -------------------------------------------
  CALL INIT1
  aux_grch = 0.0_dp
  ALLOCATE(runtime(0:ifafm+1))
  runtime(0) = runtime_start

  i = SIZE(tau_o)
  IF (ALLOCATED(tmptau)) DEALLOCATE(tmptau)
  ALLOCATE(tmptau(0:i-1))
  tmptau = tau_o

  ! -------------------------------------------
  ! Promoted from INIT1: Initialise radiation
  ! field and related quantities
  ! -------------------------------------------
  PRINT *,"--- Initialization of radiation field ---"
  CALL RF_INIT
  IF (ALLOCATED(tmp_wl)) DEALLOCATE(tmp_wl)
  ALLOCATE(tmp_wl(0:nwlg))
  tmp_wl(0:nwlg) = rf_wl%Val(0:nwlg)

  ! JLB - 6 X 2014
  ! Find position of H2 lines in WL grid
   DO i = 1, nrh2bt
      xlam0 = prah2b(i,2)
      CALL RF_LOCATE(rf_wl, xlam0, j)
      irah2b(i,8) = j
   ENDDO
   DO i = 1, nrh2ct
      xlam0 = prah2c(i,2)
      CALL RF_LOCATE(rf_wl, xlam0, j)
      irah2c(i,8) = j
   ENDDO

  CALL COMP_DIST

  ! -------------------------------------------
  ! Initialise a few extra quantities
  ! (d_cm requires a radiation field)
  ! -------------------------------------------
  CALL CALC_EXTRA

  WRITE(iscrn,*)
  WRITE(iscrn,*) "========================================================"
  WRITE(iscrn,*) "                END OF INITIALISATION                   "
  WRITE(iscrn,*) "========================================================"
  WRITE(iscrn,*)

  !=======================================================================================
  !== PART 2 : ITERATIONS
  !=======================================================================================
  !== 1 - GLOBAL LOOP on the whole cloud (ifaf)
  !== 2 - LOOPS on each positions (iopt)
  !== 3 - LOCAL LOOPS for convergervence of physical processes (miter)
  !=======================================================================================

  WRITE (iscrn,*) " ================================================ "
  WRITE (iscrn,*) "           Solve Radiative Transfer               "
  WRITE (iscrn,*) " ================================================ "

  ! -------------------------------------------
  ! Set dust properties (absorption, scattering
  ! emission, anisotropy) and compute the dust
  ! temperature distributions and emissivities
  ! -------------------------------------------
  PRINT *, " Enter DUST_PROPERTIES - initial"
  CALL DUST_PROPERTIES

  ! -------------------------------------------
  ! Solve the radiative transfer with the dust
  ! properties set above
  ! -------------------------------------------
     CALL ETIN90 (nwlg)

  ! -------------------------------------------
  ! FEED_LINES moved after grain initialisation
  ! is complete
  ! -------------------------------------------
  DO i = 1, nspl
     CALL FEED_LINES(spec_lin(i))
  ENDDO
  CALL CDT_WRAP

  PRINT *, "Global iterations"
  PRINT *, "   Final   : ", ifafm
  !---------------------------------------------------------------------------------------
  !-- GLOBAL LOOP
  !---------------------------------------------------------------------------------------
  convli_o = convli
  DO ifaf = 1, ifafm

     CALL CPU_TIME(runtime(ifaf))

     ! -------------------------------------------
     ! Log file: indicate next ifaf iteration
     ! -------------------------------------------
     WRITE (iwrit2,*)
     WRITE (iwrit2,'("====================================================")')
     WRITE (iwrit2,'("Global iteration (ifaf) = ",I3,"/",I3)') ifaf, ifafm
     WRITE (iwrit2,'("====================================================")')

     ! Reset flag to 0 for new iteration
     F_BADCONV = 0
     IF (ifaf < 6) THEN
        convli = 10.0_dp * convli_o
     ELSE
        convli = convli_o
     ENDIF

     ! -------------------------------------------
     ! The following file are used for debug only
     ! -------------------------------------------
     ! fichier = TRIM(ADJUSTL(modele))//"_eq_"//TRIM(ADJUSTL(ii2c(ifaf)))//".dat"
     ! OPEN (56, file=fichier, status="unknown")
     ! fichier = TRIM(ADJUSTL(modele))//"_dc_"//TRIM(ADJUSTL(ii2c(ifaf)))//".dat"
     ! OPEN (57, file=fichier, status="unknown")
     ! WRITE(57,'(A)',ADVANCE='no') '#      AV       xjpe       xjit       xjet'
     ! ndeb = nh2for + ncrion + npsion + nasrad + nrest + nh2endo + nphot_f &
     !      + nphot_i + n3body + ncpart + ngsurf + ngphot + ngads + 1
     ! DO i = ndeb, ndeb + ngneut - 1
     !    IF ( (react(i,1) > nsp_ne) .AND. (react(i,1) <= nsp_ne+nsp_ip+nsp_im) ) THEN
     !       WRITE(57,'(2(3X,A8))',ADVANCE='no') speci(react(i,1)),speci(react(i,1))
     !    ENDIF
     ! ENDDO
     ! WRITE(57,*)

     iopt_o = 0
     tau(0) = 0.0_dp
     dtau(0) = 0.0_dp

     ! -------------------------------------------
     ! Initialize the convergence test variables
     ! -------------------------------------------
     iter_nb       = 0
     fail_bt       = 0
     fail_bthr     = 0
     fail_chem     = 0
     fail_h        = 0
     fail_h2       = 0
     fail_hd       = 0
     fail_co       = 0
     fail_c        = 0
     fail_grco     = 0
     fail_grh2o    = 0
     fail_electr   = 0
     var_bt        = 0.0_dp
     var_bthr      = 0.0_dp
     var_chem      = 0.0_dp
     var_h         = 0.0_dp
     var_h2        = 0.0_dp
     var_hd        = 0.0_dp
     var_co        = 0.0_dp
     var_c         = 0.0_dp
     var_grco      = 0.0_dp
     var_grh2o     = 0.0_dp
     var_electr    = 0.0_dp

     !------------------------------------------------------------------------------------
     !-- LOOP ON POSITION IN THE CLOUD (iopt)
     !------------------------------------------------------------------------------------
     DO iopt = 0, noptm
402     CONTINUE

        WRITE(iscrn,*)
        WRITE(iscrn,*) '*********************************************'
        WRITE(iscrn,'(5x,"Two sides iteration number",i2," of",i4)') ifaf, ifafm
        WRITE(iscrn,'(15x,"Slab number: ",i4)') iopt
        WRITE(iscrn,*) '*********************************************'

        temp = tgaz(iopt)
        av   = tau(iopt) * tautav

        ! -------------------------------------------
        ! Re-initialization of abundances
        ! note that cosmic rays, photons and so have
        ! an abundance of 1 (numerical trick)
        ! -------------------------------------------
        ab = 1.0_dp
        ab(1:n_var) = abnua(1:n_var,iopt)

        !---------------------------------------------------------------------------------
        !-- LOCAL LOOP FOR CONVERGENCE OF PHYSICAL PROCESSES (index : itenua)
        !-- Compute iteratively all physical quantities at a given point
        !-- 1 - Radiative transfer
        !-- 2 - Chemistry
        !-- 3 - Thermal balance
        !-- 4 - Various tests
        !---------------------------------------------------------------------------------
        summary_conv(:) = 0
        DO itenua = 1, miter
           ab_o(1:n_var) = ab(1:n_var)

           WRITE(iscrn,*)
           WRITE(iscrn,*)'-------------------------------------------------'
           WRITE(iscrn,1030) ifaf,iopt, itenua, av, densh(iopt), temp

           ! Previous values are saved to tests
           IF (i_h     /= 0) oldhat    = ab(i_h)
           IF (i_h2    /= 0) oldhmo    = ab(i_h2)
           IF (i_hd    /= 0) oldhd     = ab(i_hd)
           IF (i_co    /= 0) oldco     = ab(i_co)
           IF (i_c     /= 0) oldc      = ab(i_c)
           IF (i_cogr  /= 0) oldcoD    = ab(i_cogr)
           IF (i_h2ogr /= 0) oldh2oD   = ab(i_h2ogr)
           IF (nspec   /= 0) oldelectr = ab(nspec)

           !------------------------------------------------------------------------------
           !-- 1 - RADIATIVE TRANSFER (FGK approximation above jfgk for H2)
           !------------------------------------------------------------------------------
           CALL FGKTR2 (iopt)

           ! -------------------------------------------
           ! Absorption and dissociation of H2, CO, and
           ! their isotopes.
           ! Ionisation of C, S,... by integration of
           ! cross sections over the radiation field int
           ! -------------------------------------------
           CALL FGKDAT (iopt)

           ! -------------------------------------------
           ! Compute CO pumping excitation
           ! -------------------------------------------
           IF (i_co /=0 .AND. F_CO_UV_pum == 1) THEN
              CALL CO_UV_EXC (iopt)
           ENDIF

           ! -------------------------------------------
           ! Write some photodissociation probabilities
           ! on the screen during execution
           ! TODO : avoir quelque chose de plus pratique
           !        pour les indices de pdiesp
           !        actuellement, on suppose un ordre
           !        particulier des especes, ce qui n'est
           !        pas pratique
           ! -------------------------------------------
           WRITE(iscrn,*) 'Photodissociation probabilities [s-1] :'
           IF (i_hd /= 0) THEN
              IF (i_h2 /= 0) WRITE(iscrn,"(' P(H2): ',1p,e10.3)",ADVANCE="NO") pdiesp(kdeph0,iopt)
              IF (i_hd /= 0) WRITE(iscrn,"(' P(HD): ',1p,e10.3)",ADVANCE="NO") pdiesp(kdeph0+1,iopt)
              IF (i_co /= 0) WRITE(iscrn,"(' P(CO): ',1p,e10.3)",ADVANCE="NO") pdiesp(kdeph0+2,iopt)
           ELSE
              IF (i_h2 /= 0) WRITE(iscrn,"(' P(H2): ',1p,e10.3)",ADVANCE="NO") pdiesp(kdeph0,iopt)
              IF (i_co /= 0) WRITE(iscrn,"(' P(CO): ',1p,e10.3)",ADVANCE="NO") pdiesp(kdeph0+1,iopt)
           ENDIF
           WRITE(iscrn,*)

           !------------------------------------------------------------------------------
           !-- 2 - CHEMISTRY
           !------------------------------------------------------------------------------

           ! Development versions have more choiceis here => align column numbers for diff

              ! -------------------------------------------
              ! Build the set of chemical equations
              ! -------------------------------------------
              aux_abel = ab(nspec)
              CALL CHIMIJ (temp, iopt, itenua)
              grcharge(iopt) = (aux_coef * aux_grch + grcharge(iopt)) / (1.0_dp + aux_coef)
              aux_abel = ab(nspec)
              chg_p = 0.0_dp
              chg_m = 0.0_dp
              IF (grcharge(iopt) >= 0.0_dp) THEN
                 chg_p = grcharge(iopt)
              ELSE
                 chg_m = grcharge(iopt)
              ENDIF

              ! -------------------------------------------
              ! Solve the set of chemical equations (Newton
              ! -raphson scheme). Inspired from (with home
              ! made tuning) numerical recipes, WH Press,BP
              ! Flannery,SA Teukolsky and WT Vetterling,
              ! Cambridge University Press, 1986.
              ! -------------------------------------------
              CALL MNEWT (temp, iopt, itenua)
              aux_grch = grcharge(iopt)
              ab(nspec) = (aux_coef * aux_abel + ab(nspec)) / (1.0_dp + aux_coef)
              IF (F_STABLE >= 1 .AND. itenua > 5 .AND. MOD(itenua,3) == 0) THEN
                 ab(1:n_var) = sqrt(ab(1:n_var) * ab_o(1:n_var))
              ENDIF
              DO ii = nsp_ne+1, nspec
                 IF (ab(ii) * ael(ii,natom) >= 0.0_dp) THEN
                    chg_p = chg_p + ab(ii) * ael(ii,natom)
                 ELSE
                    chg_m = chg_m + ab(ii) * ael(ii,natom)
                 ENDIF
              ENDDO
              chg_cons = 50.0_dp * (chg_p + chg_m) / (chg_p - chg_m)
              PRINT *, " Charge conservation:", chg_p, chg_m, grcharge(iopt), chg_p + chg_m, chg_cons, " %"

           ! -----------------------------------------------------------------------------
           ! In some cases, the fact that the dust charges and the ions and the electrons
           ! abundances are computed separately induces numerical instabilities. The code
           ! alternatively converges towards 2 solutions for specific Av ranges (see doc.
           ! bug_report_dust_charge.pdf).
           ! To solve this problem, the abundances of the ions and electrons involved in
           ! all the recombination reactions on grain surfaces are averaged with those
           ! computed at the previous subiteration (itenua). This is done for itenua > 4,
           ! an arbitrary choice. A better treatment would be to simultaneously compute
           ! the chemistry and the dust charges with a global Newton Raphson algorithm.
           ! -----------------------------------------------------------------------------
           !ndeb = nh2for + ncrion + npsion + nasrad + nrest + nh2endo + nphot_f &
           !     + nphot_i + n3body + ncpart + ngsurf + ngphot + ngads + 1
           !j = 0
           !IF (itenua <= 4) THEN
           !   DO i = ndeb, ndeb + ngneut - 1
           !      j = j + 1
           !      IF ( react(i,4) == nspec ) CYCLE
           !      abions(j) = ab(react(i,1))
           !      IF ( (ab(react(i,1)) > 0.0_dp) .AND. (abions(j) > 0.0_dp) ) THEN
           !         ab(react(i,1)) = ( LOG(abions(j)) + LOG(ab(react(i,1))) ) / 2.0_dp
           !         ab(react(i,1)) = EXP(ab(react(i,1)))
           !      ELSE
           !         ab(react(i,1)) = ( abions(j) + ab(react(i,1)) ) / 2.0_dp
           !      ENDIF
           !   ENDDO
           !ELSE
           !   DO i = ndeb, ndeb + ngneut - 1
           !      j = j + 1
           !      IF ( react(i,4) == nspec ) CYCLE
           !      IF ( (ab(react(i,1)) > 0.0_dp) .AND. (abions(j) > 0.0_dp) ) THEN
           !         ab(react(i,1)) = ( LOG(abions(j)) + LOG(ab(react(i,1))) ) / 2.0_dp
           !         ab(react(i,1)) = EXP(ab(react(i,1)))
           !      ELSE
           !         ab(react(i,1)) = ( abions(j) + ab(react(i,1)) ) / 2.0_dp
           !      ENDIF
           !      abions(j) = ab(react(i,1))
           !   ENDDO
           !ENDIF

           ! -------------------------------------------
           ! write some abundances on the screen during execution
           ! -------------------------------------------
           WRITE (iscrn,'("Abundances [cm-3] :")')
           DO i = 1, natom-1
              IF (icx(i,1) /= 0) THEN
                 WRITE (iscrn,"(2x,a8,':',1pe12.4,2x,a8,':',e12.4)") &
                        speci(icx(i,1)), ab(icx(i,1)), speci(icx(i,2)), ab(icx(i,2))
              ENDIF
           ENDDO

           IF (i_h    /= 0) WRITE(iscrn,'(" H   : ",1p,e12.3," cm-3")') ab(i_h)
           IF (i_hgrc /= 0) WRITE(iscrn,'(" H:: : ",1p,e12.3," cm-3")') ab(i_hgrc)
           IF (i_h2   /= 0) WRITE(iscrn,'(" H2  : ",1p,e12.3," cm-3")') ab(i_h2)
           IF (i_hd   /= 0) WRITE(iscrn,'(" HD  : ",1p,e12.3," cm-3")') ab(i_hd)
           IF (i_co   /= 0) WRITE(iscrn,'(" CO  : ",1p,e12.3," cm-3")') ab(i_co)
           IF (i_h2o  /= 0) WRITE(iscrn,'(" H2O : ",1p,e12.3," cm-3")') ab(i_h2o)

           WRITE (iscrn,'(" errx    : ", 1p,e12.2," errc : ",e12.2)') errx, errc
           WRITE (iscrn,'(" mauvais : ", a8)') speci(mauvai)
           WRITE (iscrn,*) speci(nspec+1), ab(nspec+1) , speci(nspec+2), ab(nspec+2)
           WRITE (iscrn,*) ifaf, iopt, itenua, " Grain charge:", grcharge(iopt), &
                           ", n(e-):", ab(nspec)

           ! Save abundances for next iteration
           abnua(0,iopt) = 1.0_dp
           abnua(1:n_var,iopt) = ab(1:n_var)

           ! Update abundances in line specific variable at first iteration
           IF (ifaf == 1) THEN
              DO i = 1, nspl
                 spec_lin(i)%abu = ab(spec_lin(i)%ind)
              ENDDO
              IF (i_c13o == 0 .AND. j_c13o /= 0 .AND. i_co /= 0) THEN
                 spec_lin(in_sp(j_c13o))%abu = ab(i_co) / r_c13
              ENDIF
              IF (i_co18 == 0 .AND. j_co18 /= 0 .AND. i_co /= 0) THEN
                 spec_lin(in_sp(j_co18))%abu = ab(i_co) / r_o18
              ENDIF
              IF (i_c13o18 == 0 .AND. j_c13o18 /= 0 .AND. i_co /= 0) THEN
                 spec_lin(in_sp(j_c13o18))%abu = ab(i_co) / (r_c13 * r_o18)
              ENDIF
           ENDIF

           !------------------------------------------------------------------------------
           !--  3 - THERMAL BALANCE
           !--
           !--  Compute excitation of H2, CO, CS, C, C+, O, HCO+ and others...
           !--  Then heating and cooling rates.
           !--  Thermal balance only if asked for (FROID and CHAUD are used in BILTHM)
           !------------------------------------------------------------------------------

           bthrel = 0.0_dp
           IF (ifeqth == 1 .AND. ifaf >= 2) THEN
              CALL BILTHM (iopt, itenua)
           ELSE
              CALL FROID (temp, iopt)
              CALL CHAUD (temp, iopt, itenua)
           ENDIF

           WRITE(iscrn,*) ' '
           WRITE(iscrn,'(" T_dust:",20f7.2)') (tdust(mm,iopt), mm = 1, npg)
           WRITE(iscrn,"('Cooling and Heating rates:  ',1p,E13.6,3x, 1p,E13.6, &
                      &' [erg cm-3 s-1]')") reftot(iopt), chotot(iopt)
           WRITE(iscrn,"('Cooling (-) or Heating (+) H2:  ',3x, 1p,E13.6, &
                      & ' Pure Col: ', E13.6,' [erg cm-3 s-1]')") -rfjh2t(iopt), -rfjh2c(iopt)
           WRITE(iscrn,*)

           !------------------------------------------------------------------------------
           !--  4 - TESTS
           !--    - Chemical solution accuracy
           !--    - relative abundance of H, H2, C, CO (and maybe some other)
           !--    - H2 population conservation
           !--      ===> Leave loop on itenua if ALL conditions are met
           !--    A Warning on screen gives the reason why another iteration is done
           !------------------------------------------------------------------------------
!          IF (itenua < 5) CYCLE   ! At least 5 iterations !
           IF (itenua < 3) CYCLE   ! Test: At least 3 iterations !

           WRITE(iscrn,*)
           WRITE(iscrn,*) '------------------------------------'
           WRITE(iscrn,*) '        convergence tests           '

           ! JLB 19 IV 2010 - try more severe conditions for thermal balance
           IF (ifeqth == 1) THEN
              vartg = ABS(tb(itenua) - tb(itenua-1))
              var_bt(iopt) = vartg
              IF (      (ABS(bthrel) > (1.0_dp * convli)) &
                  .AND. (vartg > 0.02d0)                  &
                  .AND. (temp > 4.0_dp)) THEN
                 PRINT *, "   CASE 1: BT", bthrel, vartg
                 summary_conv(1) = summary_conv(1) + 1
                 CYCLE
              ENDIF
           ENDIF

           var_bthr(iopt) = ABS(bthrel)
           IF ( (ifeqth == 1) .AND. (ABS(bthrel) > 1.0e-3_dp) .AND. (temp > 4.0_dp)) THEN
              PRINT *, "   CASE 2: bthrel", bthrel
              summary_conv(2) = summary_conv(2) + 1
              CYCLE
           ENDIF

           var_chem(iopt) = errx
           IF (errx > 1.0e-2_dp) THEN
!          IF (errx > 1.0e-2_dp .OR. errc > 1.0e-1_dp) THEN
              PRINT *, "   CASE 3: chemistry", errx, errc
              summary_conv(3) = summary_conv(3) + 1
              CYCLE
           ENDIF

           testv = ABS(oldhat - abnua(i_h,iopt)) / abnua(i_h,iopt)
           !  JLB 29 IV 2008 : * 0.2
           !  JLB  4 IX 2008 : * 0.1
           var_h(iopt) = testv
           testv = testv * 0.1_dp
           IF (testv > convli) THEN
              PRINT *, "   CASE 4: H", testv
              summary_conv(4) = summary_conv(4) + 1
              CYCLE
           ENDIF

           testv = ABS(oldhmo - abnua(i_h2,iopt)) / abnua(i_h2,iopt)
           var_h2(iopt) = testv
           IF (testv > convli) THEN
              PRINT *, "   CASE 5: H2", testv
              summary_conv(5) = summary_conv(5) + 1
              CYCLE
           ENDIF

           IF (i_hd /= 0) THEN
              testv = ABS(oldhd - abnua(i_hd,iopt)) / abnua(i_hd,iopt)
              var_hd(iopt) = testv
              IF (testv > convli) THEN
                 PRINT *, "   CASE 6: HD", testv
                 summary_conv(6) = summary_conv(6) + 1
                 CYCLE
              ENDIF
           ENDIF

           IF (i_co /= 0) THEN
              testv = ABS(oldco - abnua(i_co,iopt)) / abnua(i_co,iopt)
              var_co(iopt) = testv
              IF (testv > convli) THEN
                 PRINT *, "   CASE 7: CO", testv
                 summary_conv(7) = summary_conv(7) + 1
                 CYCLE
              ENDIF
           ENDIF

           IF (i_c /= 0) THEN
              testv = ABS(oldc - abnua(i_c,iopt)) / abnua(i_c,iopt)
              var_c(iopt) = testv
              IF (testv > convli) THEN
                 PRINT *, "   CASE 8: C", testv
                 summary_conv(8) = summary_conv(8) + 1
                 CYCLE
              ENDIF
           ENDIF

           IF (i_cogr /= 0) THEN
              testv = ABS(oldcoD - abnua(i_cogr,iopt)) / abnua(i_cogr,iopt)
              var_grco(iopt) = testv
              IF (testv > convli) THEN
                 PRINT *, "   CASE 9: CO:", testv
                 summary_conv(9) = summary_conv(9) + 1
                 CYCLE
              ENDIF
           ENDIF

           IF (i_h2ogr /= 0) THEN
              testv = ABS(oldh2oD - abnua(i_h2ogr,iopt)) / abnua(i_h2ogr,iopt)
              var_grh2o(iopt) = testv
              IF (testv > convli) THEN
                 PRINT *, "   CASE 10: H2O:", testv
                 summary_conv(10) = summary_conv(10) + 1
                 CYCLE
              ENDIF
           ENDIF

           testv = ABS((chg_p + chg_m) / (chg_p - chg_m))
           testv = ABS(oldelectr - abnua(nspec,iopt)) / abnua(nspec,iopt)
           var_electr(iopt) = testv
           IF (testv > convli) THEN
              PRINT *, "   CASE 11: e-", testv
              summary_conv(11) = summary_conv(11) + 1
              CYCLE
           ENDIF

           EXIT

              !--------------------------------------------------------------------
        ENDDO !-- END OF LOOP ON LOCAL CONVERGENCE OF PHYSICAL PROCESSES
              !--------------------------------------------------------------------

        ! -------------------------------------------
        ! compute convergence test variables
        ! -------------------------------------------
        iter_nb(iopt)     = MIN(itenua,50)
        fail_bt(iopt)     = summary_conv( 1)
        fail_bthr(iopt)   = summary_conv( 2)
        fail_chem(iopt)   = summary_conv( 3)
        fail_h(iopt)      = summary_conv( 4)
        fail_h2(iopt)     = summary_conv( 5)
        fail_hd(iopt)     = summary_conv( 6)
        fail_co(iopt)     = summary_conv( 7)
        fail_c(iopt)      = summary_conv( 8)
        fail_grco(iopt)   = summary_conv( 9)
        fail_grh2o(iopt)  = summary_conv(10)
        fail_electr(iopt) = summary_conv(11)

        PRINT *, "  O/P:", h2para, h2orth, h2orth/h2para
        WRITE (iwrit2,1010) &
              iopt, tau(iopt), av, densh(iopt), temp, itenua, summary_conv(:)

        IF (  (F_CHECK_THBAL /= 0) .AND. (ifaf == 20) &
        .AND. (tau(iopt)*tautav >= 5.0e-1_dp) &
        .AND. (tau(iopt)*tautav <= 7.0e-1_dp) ) THEN
           CALL CHECK_THBAL(done_check_thbal, iopt, itenua, temp)
        ENDIF

1010 FORMAT(i4, " tau= ",1pe17.10," AV= ",1pe17.10," nH= ",e13.6,6x, " Tgas = ",0pf13.6 &
           ," itenua= ",i3,"     --- BT= ",I2," bthrel= ",I2," Chem= ",I2        &
           ," H= ",I2, " H2= ",I2, " HD= ",I2, " CO= ",I2, " C= ",I2, " CO:= ",I2      &
           ," H2O: = ",I2," e- = ",I2)

        !-- Save new temperature ---------------------------------------
        tgaz(iopt) = temp

        ! oct and dec 91: variable step size
        ! Dec 2006 : change slightly algo to get a smoother grid.

        IF (iopt == 0) THEN
           ! No comparison possible.
           ! If max iteration reached, redo the first point
           ! Else, go to next point.
           ! IF (itenua >= miter) THEN
           !    GOTO 402
           ! ENDIF

           ! FDENS CONTAINS various state laws and prescriptions
           ! controled by "ifisob" and "ifeqth"

           tau(1) = tau_o(1)
           dtau(1) = dtau_o(1)
           iopt_o = 1
           CALL FDENS(tau(1), iopt, xdens, xtemp)
           tgaz(1) = xtemp
           densh(1) = xdens

        ELSE
           ! Compute relative variation between two points (thevar)
           vart = ABS((tgaz(iopt) - tgaz(iopt-1)) / tgaz(iopt))
           varn = ABS((densh(iopt) - densh(iopt-1)) / densh(iopt))
           varh = ABS(abnua(i_h,iopt-1) - abnua(i_h,iopt)) / abnua(i_h,iopt)
           ! 29 IV 2008 - just for a test
           varh = 0.2_dp * varh
           varh2 = ABS(abnua(i_h2,iopt-1) - abnua(i_h2,iopt)) / abnua(i_h2,iopt)
           IF (i_hd /= 0) THEN
              varhd = ABS(abnua(i_hd,iopt-1) - abnua(i_hd,iopt)) / abnua(i_hd,iopt)
           ELSE
              varhd = 0.0_dp
           ENDIF
           IF (i_co /= 0) THEN
              varco = ABS(abnua(i_co,iopt-1) - abnua(i_co,iopt)) / abnua(i_co,iopt)
           ELSE
              varco = 0.0_dp
           ENDIF
           IF (i_cogr /= 0) THEN
              varcogr = ABS(abnua(i_cogr,iopt-1) - abnua(i_cogr,iopt)) / abnua(i_cogr,iopt)
           ELSE
              varcogr = 0.0_dp
           ENDIF
           IF (i_h2ogr /= 0) THEN
              varh2ogr = ABS(abnua(i_h2ogr,iopt-1) - abnua(i_h2ogr,iopt)) / abnua(i_h2ogr,iopt)
           ELSE
              varh2ogr = 0.0_dp
           ENDIF
           IF (i_c /= 0) THEN
              varc = ABS(abnua(i_c,iopt-1) - abnua(i_c,iopt)) / abnua(i_c,iopt)
           ELSE
              varc = 0.0_dp
           ENDIF
!          thevar = vart + varn + varh + varhd + varh2 + varco + varc + varh2ogr + varcogr
           thevar = vart + varn + varh + varhd + varh2 + varco + varc
           ! 6 II 2007
           IF (i_h2o /= 0 .AND. ALLOCATED(xreh2o)) THEN
              IF (ab(i_h2o) > densh(iopt) * 1.0e-20_dp) THEN
                 thevar = thevar + ABS(xreh2o(3,iopt-1) - xreh2o(3,iopt)) / xreh2o(3,iopt)
              ENDIF
           ENDIF

           testv = dtau(iopt) / MIN(tau(iopt),MAX(tau(1),taumax-tau(iopt)))

           !--------------------------------------------------------------------
           ! Grid refinement
           !--------------------------------------------------------------------
           !IF ( (thevar >= varmax .OR. itenua >= miter).AND.&
           IF ( (thevar >= varmax)      .AND. &
                (testv >= dtaumin)      .AND. &
                (ifaf /= 1)             .AND. &
                (tau(iopt) >= 1.0e-8_dp).AND. &
                (tau(iopt) <= (taumax-1.0e-8_dp)) ) THEN
!          .AND. (ifisob /=2 .OR. ifaf /= 1 .OR. itenua > 2)) THEN
              ! If "thevar" is too large, or max number of iterations has been reached,
              ! the point is discarded. We need a new point, closer to the previous one.
              dtau(iopt) = dtau(iopt) * 0.5_dp
              tau(iopt) = tau(iopt-1) + dtau(iopt)
              CALL FDENS(tau(iopt), iopt, xdens, xtemp)
              tgaz(iopt) = xtemp
              densh(iopt) = xdens

              ! Reset abundances (use IF/THEN/ELSE to enforce HIP or LIP solutions (if they exist...)
              ! Rescaling only for full species. not for grain surface variables

              DO ii = 1, nspec
!                IF (tau(iopt) > 1.0e-1_dp) THEN
!                   abnua(ii,iopt) = abin(ii) * densh(iopt)
!                ELSE
                    abnua(ii,iopt) = abnua(ii,iopt-1) * densh(iopt) / densh(iopt-1)
!                ENDIF
              ENDDO
              grcharge(iopt) = grcharge(iopt) * densh(iopt) / densh(iopt-1)
              GOTO 402
           ELSE
              ! If end of cloud, ...finished!
              IF (tau(iopt) >= taumax) GOTO 403

              ! Else, we accept the point and step to a further one.
              IF (tau_o(iopt_o) <= tau(iopt)) THEN
                 iopt_o = iopt_o + 1
              ENDIF
!             nsplit = floor((tau_o(iopt_o) - tau(iopt))*300.0_dp/taumax) ! Initial
!             nsplit = floor((tau_o(iopt_o) - tau(iopt))*200.0_dp/taumax) ! OK
              nsplit = floor((tau_o(iopt_o) - tau(iopt))*100.0_dp/taumax) ! Test
              IF (nsplit < 2) THEN
                 dtau(iopt+1) = tau_o(iopt_o) - tau(iopt)
                 IF (dtau(iopt+1) /= dtau_o(iopt_o)) THEN
                    PRINT *, iopt, dtau(iopt+1), dtau_o(iopt_o)
                 ENDIF
                 tau(iopt+1) = tau_o(iopt_o)
              ELSE
!                dtau(iopt+1) = MIN((tau_o(iopt_o) - tau(iopt)) / nsplit, 0.2_dp*taulm/taumax) ! Initial
!                dtau(iopt+1) = MIN((tau_o(iopt_o) - tau(iopt)) / nsplit, 0.5_dp*taulm/taumax) ! OK
                 dtau(iopt+1) = MIN((tau_o(iopt_o) - tau(iopt)) / nsplit, 0.8_dp*taulm/taumax) ! Test
                 tau(iopt+1) = tau(iopt) + dtau(iopt+1)
              ENDIF
              CALL FDENS(tau(iopt+1), iopt, xdens, xtemp)
              ! Try to force a low temperature solution
              tgaz(iopt+1) = xtemp
              !tgaz(iopt+1) = MIN(200.0_dp, xtemp)
              densh(iopt+1) = xdens
           ENDIF

        ENDIF ! END OF IF (iopt == 0)

        !----------------------------------------------------------------------------------
        ! For debug purpose only
        ! IF (MOD(iopt,10) == 0) THEN
        ! IF (iopt == 274 .OR. iopt == 275) THEN
        !    WRITE (56,'("#",i5,1p,5e18.8)') iopt, tau(iopt)*tautav, ab(i_h2) &
        !                                  , SUM(eq_spe%des*eq_spe%pop), SUM(eq_spe%cre) &
        !                                  , SUM(eq_spe%ref)*ab(i_h2)
        !    DO ii = 1, nld
        !       WRITE (56,'(1p,3(300e16.7E3," "),6(e16.7," "))') (eq_spe%qua(ii,j), j=1,nld) &
        !                , (eq_spe%col(ii,j), j=1,nld), (eq_spe%cas(ii,j), j=1,nld) &
        !                , eq_spe%des(ii), eq_spe%cre(ii), eq_spe%pop(ii), eq_spe%ref(ii) &
        !                , eq_spe%pir(ii), eq_spe%puv(ii)
        !    ENDDO
        !    WRITE (56,'(" ")')
        ! ENDIF
        !----------------------------------------------------------------------------------

        !-----------------------------------------------------------------
        !-- Initial conditions at next point
        !-- - Radiation field
        !-- - Chemical abundances
        !-- - Excited levels
        !-----------------------------------------------------------------

        PRINT *,"Preparation of quantities for next point"
        !-- Grains temperature -------------------------------------------
        tdust(:,iopt+1) = tdust(:,iopt)

        !-- Abundances ---------------------------------------------------
        DO j = 1, nspec
           abnua(j,iopt+1) = abnua(j,iopt) * densh(iopt+1) / densh(iopt)
        ENDDO
        DO j = nspec+1, n_var
           abnua(j,iopt+1) = abnua(j,iopt)
        ENDDO

        !-- H2 levels ----------------------------------------------------
        DO lev = 1, l0h2
           xreh2(lev,iopt+1) = xreh2(lev,iopt)
        ENDDO

        !-- HD levels ----------------------------------------------------
        IF (i_hd /= 0) THEN
           DO lev = 1, l0hd
              xrehd(lev,iopt+1) = xrehd(lev,iopt)
           ENDDO
        ENDIF

        !-- CO (and isotopes) levels -------------------------------------
        IF (i_co /= 0) THEN
           DO j = 1, spec_lin(in_sp(i_co))%nlv
              xreco(j,iopt+1) = xreco(j,iopt)
           ENDDO
        ENDIF
        IF (i_c13o /= 0) THEN
           DO j = 1, spec_lin(in_sp(j_c13o))%nlv
              xrec13o(j,iopt+1) = xrec13o(j,iopt)
           ENDDO
        ENDIF
        IF (i_co18 /= 0) THEN
           DO j = 1, spec_lin(in_sp(j_co18))%nlv
              xreco18(j,iopt+1) = xreco18(j,iopt)
           ENDDO
        ENDIF
        IF (i_c13o18 /= 0) THEN
           DO j = 1, spec_lin(in_sp(j_c13o18))%nlv
              xrec13o18(j,iopt+1) = xrec13o18(j,iopt)
           ENDDO
        ENDIF

        ! Use number of iteration as an indication of bad convergence
        ! A more sophisticated diagnostic may be set up here
        IF (itenua >= miter-1) THEN
           F_BADCONV = 1
        ENDIF

           !--------------------------------------------------------------------------------
     ENDDO !-- END OF LOOP ON CLOUD POSITION
           !--------------------------------------------------------------------------------
403  CONTINUE

     ! CLOSE (56)
     ! CLOSE (57)

     !---------------------------------------
     ! Now prepare quantities on the new grid
     !---------------------------------------

     ! If converge was bad, then use a low pass filter on temperature and abundances
     !IF (ifaf == 3 .OR. F_BADCONV == 1) THEN
     !IF (ifaf == 1) THEN
     !   CALL LOWPASS (iopt)
     !ENDIF

     ! Switch back to initial settings in case of controled T and nH profile
     IF (ifeqth == -1 .AND. ifaf == 6) THEN
        ifeqth = - ifeqth
        ifisob = ifisob_r
        PRINT *, "  Back to initial settings"
        PRINT *, "       ifeqth =", ifeqth
        PRINT *, "       ifisob =", ifisob
     ENDIF

     ! -----------------------------------------------------------------------------------
     ! Prepare radiation field for dust properties at next iteration
     ! -----------------------------------------------------------------------------------
     IF (ALLOCATED(J_du_pro)) DEALLOCATE(J_du_pro)
     ALLOCATE (J_du_pro(0:iopt,0:nwlg))
     DO i = 0, iopt
        DO j = 0, npo
           IF (tau_o(j) > tau(i)) EXIT
        ENDDO
        IF (j == npo+1) j = npo
        J_du_pro(i,:) = intJmp(j-1,:) + (intJmp(j,:) - intJmp(j-1,:)) &
                      * (tau(i) - tau_o(j-1)) / dtau_o(j)
     ENDDO

     ! Set here the new size of computed quantities
     npo = MIN(noptm, iopt)

     PRINT *, " Enter DUST_PROPERTIES - running"
     CALL DUST_PROPERTIES

     ! Reallocate size dependant quantities - Part 1: Profil
     CALL REALL1

     CALL COMP_DIST

     ! Reallocate size dependant quantities - Part 2: Lines
     CALL REALL

     ! Modify populations and temperature to avoid oscillations.
     IF (ifaf > 5 .AND. MOD(ifaf,3) == 0) THEN
        DO ii = 1, nspl
           nuse = spec_lin(ii)%use
           DO j = 1, nuse
              spec_lin(ii)%xre(j,:) = SQRT(spec_lin(ii)%xre(j,:)*spec_lin(ii)%xre_o(j,:))
           ENDDO
           ! Renormalize populations
           DO j = 0, npo
              spec_lin(ii)%xre(1:nuse,j) = spec_lin(ii)%xre(1:nuse,j) / SUM(spec_lin(ii)%xre(1:nuse,j))
           ENDDO
        ENDDO
        tgaz_o(:) = SQRT(tgaz_o(:) * tgaz_oo(:))
     ENDIF

     !-- UV RADIATIVE TRANSFER -----------------------------------------
     WRITE (iscrn,*) " ================================================ "
     WRITE (iscrn,*) "           Solve Radiative Transfer               "
     WRITE (iscrn,*) " ================================================ "

     CALL CALC_EXTRA

     CALL ETIN90 (nwlg)

     ! Call back DUST_PROPERTIES for the first iteration to
     ! smooth the photo electron production and heating rates
     ! -> important since thermal balance starts at ifaf=2
     IF (ifaf == 1) THEN
        DO j = 0, npo
           J_du_pro(j,:) = intJmp(j,:)
        ENDDO
        CALL DUST_PROPERTIES
     ENDIF

     ! FEED_LINES moved after grain initialisation is complete
     DO i = 1, nspl
        CALL FEED_LINES(spec_lin(i))
     ENDDO

     !------------------------------------------------------------------------------------
     ! Compute extra quantities not used in the code but usefull in outputs
     !------------------------------------------------------------------------------------
     CALL CALC_EXTRA

     !------------------------------------------------------------------------------------
     ! Compute the line intensities for the last two iterations only
     !------------------------------------------------------------------------------------
     IF ( (F_W_ALL_IFAF == 1 .OR. ifaf >= ifafm-1) .AND. (F_W_HDF5_STD == 1) ) THEN
        WRITE (*,*)
        WRITE (*,*) "Compute all line intensities"
        CALL GetIntensities ! In file PXDR_INTENSITIES.f90
     ENDIF

     PRINT *, "                                                 "
     PRINT *, " -------------- WRITE RESULTS ------------------ "
     IF (F_W_ALL_IFAF == 1 .OR. ifaf >= ifafm-1) THEN
        ! --------------------------------------------------------------------------------
        ! Write binary output file
        ! --------------------------------------------------------------------------------
        IF (F_W_BINARY == 1) THEN
           CALL SORTIE1
        ENDIF
        ! --------------------------------------------------------------------------------
        ! Write standard hdf5 output files
        ! --------------------------------------------------------------------------------
        IF (F_W_HDF5_STD == 1) THEN
           ! -------------------------------------------------------
           ! Write standard ascii files in a temporary directory
           ! -------------------------------------------------------
           ascii_dir_std = TRIM(out_dir)//TRIM(ascii_std)
           CALL WRITE_ASCII(ascii_dir_std, metatab_std, nhdf5_std)
           ! -------------------------------------------------------
           ! Call python script that builds HDF5 from ascii files
           ! -------------------------------------------------------
           sh_cmd = TRIM(python_version)//" "//&
                    TRIM(write_hdf5_file)//" "//&
                    TRIM(ascii_dir_std)//" "//&
                    TRIM(out_dir)//" "//&
                    TRIM(ADJUSTL(modele))//"_s"//" "//&
                    TRIM(ADJUSTL(ii2c(ifaf)))//" "//&
                    TRIM(version_code)//" "//&
                    "1"
           PRINT *,"Launch command : "
           PRINT *, TRIM(sh_cmd)
           CALL SYSTEM(sh_cmd)
           ! -------------------------------------------------------
           ! Remove both the ascii files and the directory
           ! -------------------------------------------------------
           sh_cmd = "rm -r "//TRIM(ascii_dir_std)
           CALL SYSTEM(sh_cmd)
        ENDIF
        ! --------------------------------------------------------------------------------
        ! Write the chemical hdf5 output files
        ! --------------------------------------------------------------------------------
        IF (F_W_HDF5_CHE == 1) THEN
           ! -------------------------------------------------------
           ! Write chemical ascii files in a temporary directory
           ! -------------------------------------------------------
           ascii_dir_che = TRIM(out_dir)//TRIM(ascii_che)
           CALL WRITE_ASCII(ascii_dir_che, metatab_che, nhdf5_che)
           ! -------------------------------------------------------
           ! Call python script that builds HDF5 from ascii files
           ! -------------------------------------------------------
           sh_cmd = TRIM(python_version)//" "//&
                    TRIM(write_hdf5_file)//" "//&
                    TRIM(ascii_dir_che)//" "//&
                    TRIM(out_dir)//" "//&
                    TRIM(ADJUSTL(modele))//"_c"//" "//&
                    TRIM(ADJUSTL(ii2c(ifaf)))//" "//&
                    TRIM(version_code)//" "//&
                    "0"
           PRINT *,"Launch command : "
           PRINT *, TRIM(sh_cmd)
           CALL SYSTEM(sh_cmd)
           ! -------------------------------------------------------
           ! Remove both the ascii files and the directory
           ! -------------------------------------------------------
           sh_cmd = "rm -r "//TRIM(ascii_dir_che)
           CALL SYSTEM(sh_cmd)
        ENDIF
        ! --------------------------------------------------------------------------------
        ! Write the analysis hdf5 output files
        ! --------------------------------------------------------------------------------
        IF (F_W_HDF5_ANA == 1) THEN
           ! -------------------------------------------------------
           ! Write analysis ascii files in a temporary directory
           ! -------------------------------------------------------
           ascii_dir_ana = TRIM(out_dir)//TRIM(ascii_ana)
           CALL WRITE_ASCII(ascii_dir_ana, metatab_ana, nhdf5_ana)
           ! -------------------------------------------------------
           ! Call python script that builds HDF5 from ascii files
           ! -------------------------------------------------------
           sh_cmd = TRIM(python_version)//" "//&
                    TRIM(write_hdf5_file)//" "//&
                    TRIM(ascii_dir_ana)//" "//&
                    TRIM(out_dir)//" "//&
                    TRIM(ADJUSTL(modele))//"_a"//" "//&
                    TRIM(ADJUSTL(ii2c(ifaf)))//" "//&
                    TRIM(version_code)//" "//&
                    "0"
           PRINT *,"Launch command : "
           PRINT *, TRIM(sh_cmd)
           CALL SYSTEM(sh_cmd)
           ! -------------------------------------------------------
           ! Remove both the ascii files and the directory
           ! -------------------------------------------------------
           sh_cmd = "rm -r "//TRIM(ascii_dir_ana)
           CALL SYSTEM(sh_cmd)
        ENDIF
     ENDIF

     WRITE(iscrn,*) " ================================================"
     WRITE(iscrn,*) "   END OF ITERATION: ", ifaf, "/", ifafm
     WRITE(iscrn,*) " ================================================"

        !---------------------------------------------------------------------------------
  ENDDO !-- END OF LOOP ON GLOBAL ITERATIONS
        !---------------------------------------------------------------------------------

  CALL CPU_TIME(runtime(ifafm+1))

  ! Human readable output file
  CALL SORTIE2                                          ! Write logs in the .def file
  WRITE(iwrit2,*) " "
  WRITE(iwrit2,'(I2)') itenua                           ! Write itenua
  WRITE(iwrit2,'("END_OF_MODEL")')                      ! "END_OF_MODEL" - Last line of .def file.
  CLOSE(iwrit2)                                         ! Close the .def file

1030 format (1x,'IFAF:',I3,2x,'SLAB:',i5,2x,'ITER:',i2,2x,'Av:', 1pe18.10,/, &
           ' --------------------------------------------------',/, &
           1x,'proton density [cm-3]:',1pe13.6,2x,'temperature [K]:',0pf10.3,/)

END PROGRAM PXDR
