Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/abort_gcm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/abort_gcm.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/abort_gcm.F90	(revision 5117)
@@ -7,5 +7,5 @@
   USE IOIPSL
   !! ug Pour les sorties XIOS
-  USE wxios
+  USE lmdz_wxios
 
   include "iniprint.h"
@@ -19,7 +19,7 @@
   !     ierr    = severity of situation ( = 0 normal )
 
-  CHARACTER(LEN = *), intent(in) :: modname
-  integer, intent(in) :: ierr
-  CHARACTER(LEN = *), intent(in) :: message
+  CHARACTER(LEN = *), INTENT(IN) :: modname
+  INTEGER, INTENT(IN) :: ierr
+  CHARACTER(LEN = *), INTENT(IN) :: message
 
   WRITE(lunout, *) 'in abort_gcm'
@@ -35,5 +35,5 @@
   WRITE(lunout, *) 'Stopping in ', modname
   WRITE(lunout, *) 'Reason = ', message
-  if (ierr == 0) THEN
+  IF (ierr == 0) THEN
     WRITE(lunout, *) 'Everything is cool'
     stop
@@ -41,4 +41,4 @@
     WRITE(lunout, *) 'Houston, we have a problem, ierr = ', ierr
     stop 1
-  endif
+  ENDIF
 END SUBROUTINE abort_gcm
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/addfi.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/addfi.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/addfi.F90	(revision 5117)
@@ -119,5 +119,5 @@
   ENDDO
 
-  if (planet_type=="earth") THEN
+  IF (planet_type=="earth") THEN
     ! earth case, special treatment for first 2 tracers (water)
     DO iq = 1, 2
@@ -148,5 +148,5 @@
       ENDDO
     ENDDO
-  endif ! of if (planet_type=="earth")
+  ENDIF ! of if (planet_type=="earth")
 
   DO  ij = 1, iim
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/advtrac.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/advtrac.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/advtrac.f90	(revision 5117)
@@ -13,5 +13,5 @@
   USE comconst_mod, ONLY: dtvr
   USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO
-  USE strings_mod, ONLY: int2str
+  USE lmdz_strings, ONLY: int2str
   USE lmdz_description, ONLY: descript
   USE lmdz_libmath, ONLY: minmax
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/bilan_dyn.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/bilan_dyn.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/bilan_dyn.F90	(revision 5117)
@@ -52,5 +52,5 @@
 
   INTEGER :: icum, ncum
-  logical :: first
+  LOGICAL :: first
   REAL :: zz, zqy, zfactv(jjm, llm)
 
@@ -169,5 +169,5 @@
   ndex3d = 0
 
-  if (first) THEN
+  IF (first) THEN
     icum = 0
     ! initialisation des fichiers
@@ -175,5 +175,5 @@
     !   ncum est la frequence de stokage en pas de temps
     ncum = dt_cum / dt_app
-    if (abs(ncum * dt_app - dt_cum)>1.e-5 * dt_app) THEN
+    IF (abs(ncum * dt_app - dt_cum)>1.e-5 * dt_app) THEN
       WRITE(lunout, *) &
               'Pb : le pas de cumule doit etre multiple du pas'
@@ -183,5 +183,5 @@
     endif
 
-    if (i_sortie==1) THEN
+    IF (i_sortie==1) THEN
       file = 'dynzon'
       CALL inigrads(ifile, 1 &
@@ -295,5 +295,5 @@
     CALL histend(fileid)
 
-  endif
+  ENDIF
 
 
@@ -334,5 +334,5 @@
     flux_vQ_cum = 0.
     flux_uQ_cum = 0.
-  endif
+  ENDIF
 
   IF (prt_level > 5) &
@@ -407,5 +407,5 @@
   !   PAS DE TEMPS D'ECRITURE
   !=====================================================================
-  if (icum==ncum) THEN
+  IF (icum==ncum) THEN
     !=====================================================================
 
@@ -528,5 +528,5 @@
     ! PRINT*,'4OK'
     !   sorties proprement dites
-    if (i_sortie==1) THEN
+    IF (i_sortie==1) THEN
       do iQ = 1, nQ
         do itr = 1, ntr
@@ -573,5 +573,5 @@
     !/////////////////////////////////////////////////////////////////////
     icum = 0                  !///////////////////////////////////////
-  endif ! icum.eq.ncum    !///////////////////////////////////////
+  ENDIF ! icum.EQ.ncum    !///////////////////////////////////////
   !/////////////////////////////////////////////////////////////////////
   !=====================================================================
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/caladvtrac.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/caladvtrac.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/caladvtrac.F90	(revision 5117)
@@ -50,5 +50,5 @@
   !
   ! Earth-specific stuff for the first 2 tracers (water)
-  if (planet_type=="earth") THEN
+  IF (planet_type=="earth") THEN
     ! initialisation
     ! CRisi: il faut gérer tous les traceurs si on veut pouvoir faire des
@@ -60,5 +60,5 @@
     !c        CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur (a) ')
     !c        CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide(a) ')
-  endif ! of if (planet_type.eq."earth")
+  ENDIF ! of if (planet_type.EQ."earth")
   !   advection
 
@@ -70,5 +70,5 @@
 
   IF(iapptrac==iapp_tracvl) THEN
-    if (planet_type=="earth") THEN
+    IF (planet_type=="earth") THEN
       ! Earth-specific treatment for the first 2 tracers (water)
       !
@@ -105,10 +105,10 @@
       ENDDO
       !
-    endif ! of if (planet_type.eq."earth")
+    endif ! of if (planet_type.EQ."earth")
   ELSE
-    if (planet_type=="earth") THEN
+    IF (planet_type=="earth") THEN
       ! Earth-specific treatment for the first 2 tracers (water)
       dq(:, :, 1:nqtot) = 0.
-    endif ! of if (planet_type.eq."earth")
+    endif ! of if (planet_type.EQ."earth")
   ENDIF ! of IF( iapptrac.EQ.iapp_tracvl )
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/check_isotopes.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/check_isotopes.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/check_isotopes.F90	(revision 5117)
@@ -1,4 +1,4 @@
 SUBROUTINE check_isotopes_seq(q, ip1jmp1, err_msg)
-   USE strings_mod, ONLY: maxlen, msg, strIdx, strStack, int2str, real2str
+   USE lmdz_strings, ONLY: maxlen, msg, strIdx, strStack, int2str, real2str
    USE infotrac,    ONLY: nqtot, niso, nphas, isotope, isoCheck, iqIsoPha, isoSelect, &
                           ntiso, iH2O, nzone, tracers, isoName,  itZonIso, getKey
@@ -35,5 +35,5 @@
       iso_O17 = strIdx(isoName,'H217O')
       iso_HTO = strIdx(isoName,'HTO')
-      if (tnat1) THEN
+      IF (tnat1) THEN
               tnat(:)=1.0
       else
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/conf_gcm.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/conf_gcm.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/conf_gcm.f90	(revision 5117)
@@ -4,7 +4,7 @@
 
   USE control_mod
-  use IOIPSL
+  USE IOIPSL
   USE infotrac, ONLY: type_trac
-  use lmdz_assert, ONLY: assert
+  USE lmdz_assert, ONLY: assert
   USE comconst_mod, ONLY: dissip_deltaz, dissip_factz, dissip_zref, &
           iflag_top_bound, mode_top_bound, tau_top_bound, &
@@ -79,5 +79,5 @@
   lunout = 6
   CALL getin('lunout', lunout)
-  IF (lunout /= 5 .and. lunout /= 6) THEN
+  IF (lunout /= 5 .AND. lunout /= 6) THEN
     OPEN(UNIT = lunout, FILE = 'lmdz.out', ACTION = 'write', &
             STATUS = 'unknown', FORM = 'formatted')
@@ -308,5 +308,5 @@
   maxlatfilter = -1.0
   CALL getin('maxlatfilter', maxlatfilter)
-  if (maxlatfilter > 90) &
+  IF (maxlatfilter > 90) &
           CALL abort_gcm("conf_gcm", 'maxlatfilter should be <=90', 1)
 
@@ -322,5 +322,5 @@
   iflag_top_bound = 1
   CALL getin('iflag_top_bound', iflag_top_bound)
-  IF (iflag_top_bound < 0 .or. iflag_top_bound > 2) &
+  IF (iflag_top_bound < 0 .OR. iflag_top_bound > 2) &
           CALL abort_gcm("conf_gcm", 'iflag_top_bound must be 0, 1 or 2', 1)
 
@@ -396,5 +396,5 @@
   !     .........   (  modif  le 17/04/96 )   .........
 
-  test_etatinit: IF (.not. etatinit) THEN
+  test_etatinit: IF (.NOT. etatinit) THEN
     !Config  Key  = clon
     !Config  Desc = centre du zoom, longitude
@@ -828,7 +828,7 @@
     CALL getin('ok_strato', ok_strato)
 
-    vert_prof_dissip = merge(1, 0, ok_strato .and. llm==39)
+    vert_prof_dissip = merge(1, 0, ok_strato .AND. llm==39)
     CALL getin('vert_prof_dissip', vert_prof_dissip)
-    CALL assert(vert_prof_dissip == 0 .or. vert_prof_dissip ==  1, &
+    CALL assert(vert_prof_dissip == 0 .OR. vert_prof_dissip ==  1, &
             "bad value for vert_prof_dissip")
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/dynetat0.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/dynetat0.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/dynetat0.F90	(revision 5117)
@@ -7,8 +7,8 @@
 !-------------------------------------------------------------------------------
   USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName
-  USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str
+  USE lmdz_strings, ONLY: maxlen, msg, strStack, real2str, int2str
   USE netcdf,      ONLY: nf90_open,  nf90_nowrite, nf90_inq_varid, &
                          nf90_close, nf90_get_var, nf90_noerr
-  USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey
+  USE lmdz_readTracFiles, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey
   USE control_mod, ONLY: planet_type
   USE lmdz_assert_eq, ONLY: assert_eq
@@ -157,5 +157,5 @@
       iqParent = tracers(iq)%iqParent
       IF(tracers(iq)%iso_iZone == 0) THEN
-         if (tnat1) THEN
+         IF (tnat1) THEN
                  tnat=1.0
                  alpha_ideal=1.0
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/dynredem.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/dynredem.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/dynredem.F90	(revision 5117)
@@ -5,5 +5,5 @@
 !-------------------------------------------------------------------------------
   USE IOIPSL
-  USE strings_mod, ONLY: maxlen
+  USE lmdz_strings, ONLY: maxlen
   USE infotrac, ONLY: nqtot, tracers
   USE netcdf, ONLY: nf90_create, nf90_def_dim, nf90_inq_varid, nf90_global,    &
@@ -157,5 +157,5 @@
 ! Purpose: Write the NetCDF restart file (append).
 !-------------------------------------------------------------------------------
-  USE strings_mod, ONLY: maxlen
+  USE lmdz_strings, ONLY: maxlen
   USE infotrac, ONLY: nqtot, tracers, type_trac
   USE control_mod
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/fluxstokenc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/fluxstokenc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/fluxstokenc.F90	(revision 5117)
@@ -41,5 +41,5 @@
   SAVE iadvtr, massem, pbaruc, pbarvc, irec
   SAVE phic, tetac
-  logical :: first
+  LOGICAL :: first
   save first
   data first/.TRUE./
@@ -72,5 +72,5 @@
     first = .FALSE.
 
-  endif
+  ENDIF
 
   IF(iadvtr==0) THEN
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/friction.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/friction.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/friction.F90	(revision 5117)
@@ -28,7 +28,7 @@
 
   ! arguments:
-  REAL, INTENT(out) :: ucov(iip1, jjp1, llm)
-  REAL, INTENT(out) :: vcov(iip1, jjm, llm)
-  REAL, INTENT(in) :: pdt ! time step
+  REAL, INTENT(OUT) :: ucov(iip1, jjp1, llm)
+  REAL, INTENT(OUT) :: vcov(iip1, jjm, llm)
+  REAL, INTENT(IN) :: pdt ! time step
 
   ! local variables:
@@ -47,5 +47,5 @@
     ! set friction type
     CALL getin("friction_type", friction_type)
-    if ((friction_type<0).or.(friction_type>1)) THEN
+    IF ((friction_type<0).OR.(friction_type>1)) THEN
       abort_message = "wrong friction type"
       WRITE(lunout, *)'Friction: wrong friction type', friction_type
@@ -55,5 +55,5 @@
   ENDIF
 
-  if (friction_type==0) THEN
+  IF (friction_type==0) THEN
     !   calcul des composantes au carre du vent naturel
     do j = 1, jjp1
@@ -116,12 +116,12 @@
       vcov(iip1, j, 1) = vcov(1, j, 1)
     enddo
-  endif ! of if (friction_type.eq.0)
+  ENDIF ! of if (friction_type.EQ.0)
 
-  if (friction_type==1) THEN
+  IF (friction_type==1) THEN
     do l = 1, llm
       ucov(:, :, l) = ucov(:, :, l) * (1. - pdt * kfrict(l))
       vcov(:, :, l) = vcov(:, :, l) * (1. - pdt * kfrict(l))
     enddo
-  endif
+  ENDIF
 
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/gcm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/gcm.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/gcm.F90	(revision 5117)
@@ -7,5 +7,5 @@
 
   USE IOIPSL
-  USE wxios  ! ug Pour les sorties XIOS
+  USE lmdz_wxios  ! ug Pour les sorties XIOS
 
   USE lmdz_filtreg, ONLY: inifilr
@@ -91,5 +91,5 @@
 
 
-  real time_step, t_wrt, t_ops
+  REAL time_step, t_wrt, t_ops
 
   !      LOGICAL call_iniphys
@@ -108,11 +108,11 @@
 
 
-  character (len=80) :: dynhist_file, dynhistave_file
-  character (len=20) :: modname
-  character (len=80) :: abort_message
+  CHARACTER (LEN=80) :: dynhist_file, dynhistave_file
+  CHARACTER (LEN=20) :: modname
+  CHARACTER (LEN=80) :: abort_message
   ! locales pour gestion du temps
   INTEGER :: an, mois, jour
   REAL :: heure
-  logical use_filtre_fft
+  LOGICAL use_filtre_fft
 
   !-----------------------------------------------------------------------
@@ -135,5 +135,5 @@
   CALL conf_gcm( 99, .TRUE.)
 
-  if (mod(iphysiq, iperiod) /= 0) CALL abort_gcm("conf_gcm", &
+  IF (mod(iphysiq, iperiod) /= 0) CALL abort_gcm("conf_gcm", &
        "iphysiq must be a multiple of iperiod", 1)
 
@@ -167,11 +167,11 @@
   !      calend = 'earth_365d'
 
-  if (calend == 'earth_360d') THEN
+  IF (calend == 'earth_360d') THEN
      CALL ioconf_calendar('360_day')
      WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
-  else if (calend == 'earth_365d') THEN
+  ELSE IF (calend == 'earth_365d') THEN
      CALL ioconf_calendar('noleap')
      WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
-  else if (calend == 'gregorian') THEN
+  ELSE IF (calend == 'gregorian') THEN
      CALL ioconf_calendar('gregorian')
      WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre bissextile'
@@ -179,5 +179,5 @@
      abort_message = 'Mauvais choix de calendrier'
      CALL abort_gcm(modname,abort_message,1)
-  endif
+  ENDIF
   !-----------------------------------------------------------------------
 
@@ -203,16 +203,16 @@
 
   !  lecture du fichier start.nc
-  if (read_start) THEN
+  IF (read_start) THEN
      ! we still need to run iniacademic to initialize some
      ! constants & fields, if we run the 'newtonian' or 'SW' cases:
-     if (iflag_phys/=1) THEN
+     IF (iflag_phys/=1) THEN
         CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
      endif
 
-     !        if (planet_type.eq."earth") THEN
+     !        if (planet_type.EQ."earth") THEN
      ! Load an Earth-format start file
      CALL dynetat0("start.nc",vcov,ucov, &
           teta,q,masse,ps,phis, time_0)
-     !        endif ! of if (planet_type.eq."earth")
+     !        endif ! of if (planet_type.EQ."earth")
 
      !       WRITE(73,*) 'ucov',ucov
@@ -222,5 +222,5 @@
      !       WRITE(77,*) 'q',q
 
-  endif ! of if (read_start)
+  ENDIF ! of if (read_start)
 
 
@@ -228,9 +228,9 @@
   IF (prt_level > 9) WRITE(lunout,*) &
        'GCM: AVANT iniacademic AVANT AVANT AVANT AVANT'
-  if (.not.read_start) THEN
+  IF (.NOT.read_start) THEN
      start_time=0.
      annee_ref=anneeref
      CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
-  endif
+  ENDIF
 
 
@@ -279,5 +279,5 @@
      WRITE(lunout,*) &
           'GCM: On reinitialise a la date lue dans gcm.def'
-  ELSE IF (annee_ref /= anneeref .or. day_ref /= dayref) THEN
+  ELSE IF (annee_ref /= anneeref .OR. day_ref /= dayref) THEN
      WRITE(lunout,*) &
           'GCM: Attention les dates initiales lues dans le fichier'
@@ -290,5 +290,5 @@
   ENDIF
 
-  !      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) THEN
+  !      if (annee_ref .NE. anneeref .OR. day_ref .NE. dayref) THEN
   !        WRITE(lunout,*)
   !     .  'GCM: Attention les dates initiales lues dans le fichier'
@@ -298,5 +298,5 @@
   !        WRITE(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
   !        WRITE(lunout,*)' day_ref=',day_ref," dayref=",dayref
-  !        if (raz_date .ne. 1) THEN
+  !        if (raz_date .NE. 1) THEN
   !          WRITE(lunout,*)
   !     .    'GCM: On garde les dates du fichier restart'
@@ -331,5 +331,5 @@
 
 
-  if (iflag_phys==1) THEN
+  IF (iflag_phys==1) THEN
      ! these initialisations have already been done (via iniacademic)
      ! if running in SW or Newtonian mode
@@ -349,5 +349,5 @@
      !   --------------------------
      CALL inifilr
-  endif ! of if (iflag_phys.eq.1)
+  ENDIF ! of if (iflag_phys.EQ.1)
 
   !-----------------------------------------------------------------------
@@ -365,9 +365,9 @@
 
 
-  if (nday>=0) THEN
+  IF (nday>=0) THEN
      day_end = day_ini + nday
   else
      day_end = day_ini - nday/day_step
-  endif
+  ENDIF
   WRITE(lunout,300)day_ini,day_end
 300 FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)
@@ -384,5 +384,5 @@
   !   -------------------------------
 
-  IF ((iflag_phys==1).or.(iflag_phys>=100)) THEN
+  IF ((iflag_phys==1).OR.(iflag_phys>=100)) THEN
     ! Physics:
     IF (CPPKEY_PHYS) THEN
@@ -393,7 +393,7 @@
           iflag_phys)
     END IF
-  ENDIF ! of IF ((iflag_phys==1).or.(iflag_phys>=100))
-
-  !      if (planet_type.eq."earth") THEN
+  ENDIF ! of IF ((iflag_phys==1).OR.(iflag_phys>=100))
+
+  !      if (planet_type.EQ."earth") THEN
   ! Write an Earth-format restart file
 
@@ -404,5 +404,5 @@
 
   time_step = zdtvr
-  if (ok_dyn_ins) THEN
+  IF (ok_dyn_ins) THEN
      ! initialize output file for instantaneous outputs
      ! t_ops = iecri * daysec ! do operations every t_ops
@@ -411,5 +411,5 @@
      CALL inithist(day_ref,annee_ref,time_step, &
           t_ops,t_wrt)
-  endif
+  ENDIF
 
   IF (ok_dyn_ave) THEN 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/groupe.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/groupe.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/groupe.F90	(revision 5117)
@@ -3,5 +3,5 @@
 SUBROUTINE groupe(pext, pbaru, pbarv, pbarum, pbarvm, wm)
 
-  use comconst_mod, ONLY: ngroup
+  USE comconst_mod, ONLY: ngroup
 
   IMPLICIT NONE
@@ -37,5 +37,5 @@
   INTEGER :: i, j, l
 
-  logical :: firstcall, groupe_ok
+  LOGICAL :: firstcall, groupe_ok
   save firstcall, groupe_ok
 
@@ -43,15 +43,15 @@
   data groupe_ok/.TRUE./
 
-  if (iim==1) THEN
+  IF (iim==1) THEN
     groupe_ok = .FALSE.
-  endif
+  ENDIF
 
-  if (firstcall) THEN
-    if (groupe_ok) THEN
+  IF (firstcall) THEN
+    IF (groupe_ok) THEN
       IF(mod(iim, 2**ngroup)/=0) &
               CALL abort_gcm('groupe', 'probleme du nombre de point', 1)
     endif
     firstcall = .FALSE.
-  endif
+  ENDIF
 
 
@@ -63,5 +63,5 @@
   CALL scopy(ijmllm, pbarv, 1, pbarvm, 1)
 
-  if (groupe_ok) THEN
+  IF (groupe_ok) THEN
     CALL groupeun(jjp1, llm, zconvmm)
     CALL groupeun(jjm, llm, pbarvm)
@@ -84,5 +84,5 @@
     pbarum(:, :, :) = pbaru(:, :, :)
     pbarvm(:, :, :) = pbarv(:, :, :)
-  endif
+  ENDIF
 
   !    integration de la convergence de masse de haut  en bas ......
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/guide_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/guide_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/guide_mod.F90	(revision 5117)
@@ -10,5 +10,5 @@
 
   USE getparam, ONLY: ini_getparam, fin_getparam, getpar
-  USE Write_Field
+  USE lmdz_write_field
   USE netcdf, ONLY: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &
           nf90_inq_dimid, nf90_inquire_dimension, nf90_float, nf90_def_var, &
@@ -16,5 +16,5 @@
           nf90_close, nf90_inq_varid, nf90_get_var, nf90_noerr, nf90_clobber, &
           nf90_64bit_offset, nf90_inq_dimid, nf90_inquire_dimension, nf90_put_var
-  USE pres2lev_mod, ONLY: pres2lev
+  USE lmdz_pres2lev, ONLY: pres2lev
 
   IMPLICIT NONE
@@ -72,5 +72,5 @@
   SUBROUTINE guide_init
 
-    use netcdf, ONLY: nf90_noerr
+    USE netcdf, ONLY: nf90_noerr
     USE control_mod, ONLY: day_step
     USE serre_mod, ONLY: grossismx
@@ -101,5 +101,5 @@
     CALL getpar('guide_add',.FALSE.,guide_add,'forçage constant?')
     CALL getpar('guide_zon',.FALSE.,guide_zon,'guidage moy zonale')
-    if (guide_zon .and. abs(grossismx - 1.) > 0.01) &
+    IF (guide_zon .AND. abs(grossismx - 1.) > 0.01) &
          CALL abort_gcm("guide_init", &
          "zonal nudging requires grid regular in longitude", 1)
@@ -173,8 +173,8 @@
 ! ---------------------------------------------
     ncidpl=-99
-    if (guide_plevs==1) THEN
-       if (ncidpl==-99) THEN
+    IF (guide_plevs==1) THEN
+       IF (ncidpl==-99) THEN
           rcod=nf90_open('apbp.nc',nf90_nowrite, ncidpl)
-          if (rcod/=nf90_noerr) THEN
+          IF (rcod/=nf90_noerr) THEN
              abort_message=' Nudging error -> no file apbp.nc'
              CALL abort_gcm(modname,abort_message,1)
@@ -182,7 +182,7 @@
        endif
     elseif (guide_plevs==2) THEN
-       if (ncidpl==-99) THEN
+       IF (ncidpl==-99) THEN
           rcod=nf90_open('P.nc',nf90_nowrite,ncidpl)
-          if (rcod/=nf90_noerr) THEN
+          IF (rcod/=nf90_noerr) THEN
              abort_message=' Nudging error -> no file P.nc'
              CALL abort_gcm(modname,abort_message,1)
@@ -191,7 +191,7 @@
 
     elseif (guide_u) THEN
-           if (ncidpl==-99) THEN
+           IF (ncidpl==-99) THEN
                rcod=nf90_open('u.nc',nf90_nowrite,ncidpl)
-               if (rcod/=nf90_noerr) THEN
+               IF (rcod/=nf90_noerr) THEN
                   CALL abort_gcm(modname, &
                        ' Nudging error -> no file u.nc',1)
@@ -200,7 +200,7 @@
 
     elseif (guide_v) THEN
-           if (ncidpl==-99) THEN
+           IF (ncidpl==-99) THEN
                rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
-               if (rcod/=nf90_noerr) THEN
+               IF (rcod/=nf90_noerr) THEN
                   CALL abort_gcm(modname, &
                        ' Nudging error -> no file v.nc',1)
@@ -208,7 +208,7 @@
            endif
     elseif (guide_T) THEN
-           if (ncidpl==-99) THEN
+           IF (ncidpl==-99) THEN
                rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
-               if (rcod/=nf90_noerr) THEN
+               IF (rcod/=nf90_noerr) THEN
                   CALL abort_gcm(modname, &
                        ' Nudging error -> no file T.nc',1)
@@ -216,7 +216,7 @@
            endif
     elseif (guide_Q) THEN
-           if (ncidpl==-99) THEN
+           IF (ncidpl==-99) THEN
                rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
-               if (rcod/=nf90_noerr) THEN
+               IF (rcod/=nf90_noerr) THEN
                   CALL abort_gcm(modname, &
                        ' Nudging error -> no file hur.nc',1)
@@ -406,5 +406,5 @@
         CALL tau2alpha(1,iip1,jjp1,factt,tau_min_Q,tau_max_Q,alpha_Q)
 ! correction de rappel dans couche limite
-        if (guide_BL) THEN
+        IF (guide_BL) THEN
              alpha_pcor(:)=1.
         else
@@ -502,5 +502,5 @@
       ! compute pressures at layer interfaces
       CALL pression(ip1jmp1,ap,bp,ps,p)
-      if (pressure_exner) THEN
+      IF (pressure_exner) THEN
         CALL exner_hyb(ip1jmp1,ps,p,pks,pk)
       else
@@ -515,11 +515,11 @@
     ENDIF
     
-    if (guide_u) THEN
-        if (guide_add) THEN
+    IF (guide_u) THEN
+        IF (guide_add) THEN
            f_add=(1.-tau)*ugui1+tau*ugui2
         else
            f_add=(1.-tau)*ugui1+tau*ugui2-ucov
         endif 
-        if (guide_zon) CALL guide_zonave(1,jjp1,llm,f_add)
+        IF (guide_zon) CALL guide_zonave(1,jjp1,llm,f_add)
         CALL guide_addfield(ip1jmp1,llm,f_add,alpha_u)
         IF (f_out) CALL guide_out("ua",jjp1,llm,(1.-tau)*ugui1+tau*ugui2)
@@ -529,11 +529,11 @@
     endif
 
-    if (guide_T) THEN
-        if (guide_add) THEN
+    IF (guide_T) THEN
+        IF (guide_add) THEN
            f_add=(1.-tau)*tgui1+tau*tgui2
         else
            f_add=(1.-tau)*tgui1+tau*tgui2-teta
         endif 
-        if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
+        IF (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
         CALL guide_addfield(ip1jmp1,llm,f_add,alpha_T)
         IF (f_out) CALL guide_out("teta",jjp1,llm,f_add/factt)
@@ -541,11 +541,11 @@
     endif
 
-    if (guide_P) THEN
-        if (guide_add) THEN
+    IF (guide_P) THEN
+        IF (guide_add) THEN
            f_add(1:ip1jmp1,1)=(1.-tau)*psgui1+tau*psgui2
         else
            f_add(1:ip1jmp1,1)=(1.-tau)*psgui1+tau*psgui2-ps
         endif 
-        if (guide_zon) CALL guide_zonave(2,jjp1,1,f_add(1:ip1jmp1,1))
+        IF (guide_zon) CALL guide_zonave(2,jjp1,1,f_add(1:ip1jmp1,1))
         CALL guide_addfield(ip1jmp1,1,f_add(1:ip1jmp1,1),alpha_P)
 !        IF (f_out) CALL guide_out("ps",jjp1,1,f_add(1:ip1jmp1,1)/factt)
@@ -555,11 +555,11 @@
     endif
 
-    if (guide_Q) THEN
-        if (guide_add) THEN
+    IF (guide_Q) THEN
+        IF (guide_add) THEN
            f_add=(1.-tau)*qgui1+tau*qgui2
         else
            f_add=(1.-tau)*qgui1+tau*qgui2-q
         endif 
-        if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
+        IF (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
         CALL guide_addfield(ip1jmp1,llm,f_add,alpha_Q)
         IF (f_out) CALL guide_out("q",jjp1,llm,f_add/factt)
@@ -567,11 +567,11 @@
     endif
 
-    if (guide_v) THEN
-        if (guide_add) THEN
+    IF (guide_v) THEN
+        IF (guide_add) THEN
            f_add(1:ip1jm,:)=(1.-tau)*vgui1+tau*vgui2
         else
            f_add(1:ip1jm,:)=(1.-tau)*vgui1+tau*vgui2-vcov
         endif 
-        if (guide_zon) CALL guide_zonave(2,jjm,llm,f_add(1:ip1jm,:))
+        IF (guide_zon) CALL guide_zonave(2,jjm,llm,f_add(1:ip1jm,:))
         CALL guide_addfield(ip1jm,llm,f_add(1:ip1jm,:),alpha_v)
         IF (f_out) CALL guide_out("v",jjm,llm,vcov)
@@ -670,8 +670,9 @@
   SUBROUTINE guide_interp(psi,teta)
   
-  use exner_hyb_m, ONLY: exner_hyb
-  use exner_milieu_m, ONLY: exner_milieu
-  use comconst_mod, ONLY: kappa, cpp
-  use comvert_mod, ONLY: preff, pressure_exner, bp, ap
+  USE exner_hyb_m, ONLY: exner_hyb
+  USE exner_milieu_m, ONLY: exner_milieu
+  USE comconst_mod, ONLY: kappa, cpp
+  USE comvert_mod, ONLY: preff, pressure_exner, bp, ap
+  USE lmdz_q_sat, ONLY: q_sat
   IMPLICIT NONE
 
@@ -729,5 +730,5 @@
 
 END IF
-    if (first) THEN
+    IF (first) THEN
         first=.FALSE.
         WRITE(*,*)trim(modname)//' : check vertical level order'
@@ -742,10 +743,10 @@
         enddo
         WRITE(*,*)trim(modname)//' invert ordering: invert_p=',invert_p
-        if (guide_u) THEN
+        IF (guide_u) THEN
             do l=1,nlevnc
               WRITE(*,*)trim(modname)//' U(',l,')=',unat2(1,1,l)
             enddo
         endif
-        if (guide_T) THEN
+        IF (guide_T) THEN
             do l=1,nlevnc
               WRITE(*,*)trim(modname)//' T(',l,')=',tnat2(1,1,l)
@@ -758,5 +759,5 @@
 ! -----------------------------------------------------------------
     CALL pression( ip1jmp1, ap, bp, psi, p )
-    if (pressure_exner) THEN
+    IF (pressure_exner) THEN
       CALL exner_hyb(ip1jmp1,psi,p,pks,pk)
     else
@@ -803,5 +804,5 @@
 ! Conversion en variables gcm (ucov, vcov...)
 ! -----------------------------------------------------------------
-    if (guide_P) THEN
+    IF (guide_P) THEN
         do j=1,jjp1
             do i=1,iim
@@ -921,6 +922,6 @@
 ! Calcul des constantes de rappel alpha (=1/tau)
 
-    use comconst_mod, ONLY: pi
-    use serre_mod, ONLY: clon, clat, grossismx, grossismy
+    USE comconst_mod, ONLY: pi
+    USE serre_mod, ONLY: clon, clat, grossismx, grossismy
     
     IMPLICIT NONE
@@ -944,8 +945,8 @@
     REAL, DIMENSION (iip1,jjp1) :: dxdys,dxdyu
     REAL, DIMENSION (iip1,jjm)  :: dxdyv
-    real dxdy_
-    real zlat,zlon
-    real alphamin,alphamax,xi
-    integer i,j,ilon,ilat
+    REAL dxdy_
+    REAL zlat,zlon
+    REAL alphamin,alphamax,xi
+    INTEGER i,j,ilon,ilat
     CHARACTER(LEN=20),parameter :: modname="tau2alpha"
     CHARACTER (len = 80)   :: abort_message
@@ -962,5 +963,5 @@
             do j=1,pjm
                 do i=1,pim
-                    if (typ==2) THEN
+                    IF (typ==2) THEN
                        zlat=rlatu(j)*180./pi
                        zlon=rlonu(i)*180./pi
@@ -1037,5 +1038,5 @@
             enddo
             ! Calcul de gamma
-            if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) THEN
+            IF (abs(grossismx-1.)<0.1.OR.abs(grossismy-1.)<0.1) THEN
               WRITE(*,*)trim(modname)//' ATTENTION modele peu zoome'
               WRITE(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste'
@@ -1044,5 +1045,5 @@
               gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
               WRITE(*,*)trim(modname)//' gamma=',gamma
-              if (gamma<1.e-5) THEN
+              IF (gamma<1.e-5) THEN
                 WRITE(*,*)trim(modname)//' gamma =',gamma,'<1e-5'
                 abort_message='stopped'
@@ -1050,5 +1051,5 @@
               endif
               gamma=log(0.5)/log(gamma)
-              if (gamma4) THEN
+              IF (gamma4) THEN
                 gamma=min(gamma,4.)
               endif
@@ -1059,5 +1060,5 @@
         do j=1,pjm
             do i=1,pim
-                if (typ==1) THEN
+                IF (typ==1) THEN
                    dxdy_=dxdys(i,j)
                    zlat=rlatu(j)*180./pi
@@ -1069,5 +1070,5 @@
                    zlat=rlatv(j)*180./pi
                 endif
-                if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) THEN
+                IF (abs(grossismx-1.)<0.1.OR.abs(grossismy-1.)<0.1) THEN
                 ! pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin
                     alpha(i,j)=alphamin
@@ -1075,5 +1076,5 @@
                     xi=((dxdy_max-dxdy_)/(dxdy_max-dxdy_min))**gamma
                     xi=min(xi,1.)
-                    IF(lat_min_g<=zlat .and. zlat<=lat_max_g) THEN
+                    IF(lat_min_g<=zlat .AND. zlat<=lat_max_g) THEN
                         alpha(i,j)=xi*alphamin+(1.-xi)*alphamax
                     else
@@ -1085,5 +1086,5 @@
     ENDIF ! guide_reg
 
-    if (.not. guide_add) alpha = 1. - exp(- alpha)
+    IF (.NOT. guide_add) alpha = 1. - exp(- alpha)
 
   END SUBROUTINE tau2alpha
@@ -1113,9 +1114,9 @@
 ! Premier appel: initialisation de la lecture des fichiers
 ! -----------------------------------------------------------------
-    if (first) THEN
+    IF (first) THEN
          ncidpl=-99
          WRITE(*,*) trim(modname)//': opening nudging files '
 ! Niveaux de pression si non constants
-         if (guide_plevs==1) THEN
+         IF (guide_plevs==1) THEN
              WRITE(*,*) trim(modname)//' Reading nudging on model levels'
              rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
@@ -1138,5 +1139,5 @@
 
 ! Pression si guidage sur niveaux P variables
-         if (guide_plevs==2) THEN
+         IF (guide_plevs==2) THEN
              rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
              IF (rcode/=nf90_noerr) THEN
@@ -1150,9 +1151,9 @@
              ENDIF
              WRITE(*,*) trim(modname)//' ncidp,varidp',ncidp,varidp
-             if (ncidpl==-99) ncidpl=ncidp
+             IF (ncidpl==-99) ncidpl=ncidp
          endif
 
 ! Vent zonal
-         if (guide_u) THEN
+         IF (guide_u) THEN
              rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
              IF (rcode/=nf90_noerr) THEN
@@ -1166,5 +1167,5 @@
              ENDIF
              WRITE(*,*) trim(modname)//' ncidu,varidu',ncidu,varidu
-             if (ncidpl==-99) ncidpl=ncidu
+             IF (ncidpl==-99) ncidpl=ncidu
 
              status=nf90_inq_dimid(ncidu, "LONU", dimid)
@@ -1185,5 +1186,5 @@
 
 ! Vent meridien
-         if (guide_v) THEN
+         IF (guide_v) THEN
              rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
              IF (rcode/=nf90_noerr) THEN
@@ -1197,5 +1198,5 @@
              ENDIF
              WRITE(*,*) trim(modname)//' ncidv,varidv',ncidv,varidv
-             if (ncidpl==-99) ncidpl=ncidv
+             IF (ncidpl==-99) ncidpl=ncidv
              
              status=nf90_inq_dimid(ncidv, "LONV", dimid)
@@ -1218,5 +1219,5 @@
 
 ! Temperature
-         if (guide_T) THEN
+         IF (guide_T) THEN
              rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
              IF (rcode/=nf90_noerr) THEN
@@ -1230,5 +1231,5 @@
              ENDIF
              WRITE(*,*) trim(modname)//' ncidT,varidT',ncidt,varidt
-             if (ncidpl==-99) ncidpl=ncidt
+             IF (ncidpl==-99) ncidpl=ncidt
 
              status=nf90_inq_dimid(ncidt, "LONV", dimid)
@@ -1249,5 +1250,5 @@
 
 ! Humidite
-         if (guide_Q) THEN
+         IF (guide_Q) THEN
              rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
              IF (rcode/=nf90_noerr) THEN
@@ -1261,5 +1262,5 @@
              ENDIF
              WRITE(*,*) trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
-             if (ncidpl==-99) ncidpl=ncidQ
+             IF (ncidpl==-99) ncidpl=ncidQ
 
              status=nf90_inq_dimid(ncidQ, "LONV", dimid)
@@ -1280,5 +1281,5 @@
 
 ! Pression de surface
-         if ((guide_P).OR.(guide_modele)) THEN
+         IF ((guide_P).OR.(guide_modele)) THEN
              rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
              IF (rcode/=nf90_noerr) THEN
@@ -1294,5 +1295,5 @@
          endif
 ! Coordonnee verticale
-         if (guide_plevs==0) THEN
+         IF (guide_plevs==0) THEN
               rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
               IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
@@ -1300,5 +1301,5 @@
          endif
 ! Coefs ap, bp pour calcul de la pression aux differents niveaux
-         if (guide_plevs==1) THEN
+         IF (guide_plevs==1) THEN
              status=nf90_get_var(ncidpl,varidap,apnc,[1],[nlevnc])
              status=nf90_get_var(ncidpl,varidbp,bpnc,[1],[nlevnc])
@@ -1328,5 +1329,5 @@
 
 ! Pression 
-     if (guide_plevs==2) THEN
+     IF (guide_plevs==2) THEN
          status=nf90_get_var(ncidp,varidp,pnat2,start,count)
          IF (invert_y) THEN
@@ -1338,5 +1339,5 @@
 
 !  Vent zonal
-     if (guide_u) THEN
+     IF (guide_u) THEN
          status=nf90_get_var(ncidu,varidu,unat2,start,count)
          IF (invert_y) THEN
@@ -1346,5 +1347,5 @@
 
 !  Temperature
-     if (guide_T) THEN
+     IF (guide_T) THEN
          status=nf90_get_var(ncidt,varidt,tnat2,start,count)
          IF (invert_y) THEN
@@ -1354,5 +1355,5 @@
 
 !  Humidite
-     if (guide_Q) THEN
+     IF (guide_Q) THEN
          status=nf90_get_var(ncidQ,varidQ,qnat2,start,count)
          IF (invert_y) THEN
@@ -1363,5 +1364,5 @@
 
 !  Vent meridien
-     if (guide_v) THEN
+     IF (guide_v) THEN
          count(2)=jjm
          status=nf90_get_var(ncidv,varidv,vnat2,start,count)
@@ -1372,5 +1373,5 @@
 
 !  Pression de surface
-     if ((guide_P).OR.(guide_modele))  THEN
+     IF ((guide_P).OR.(guide_modele))  THEN
          start(3)=timestep
          start(4)=0
@@ -1413,9 +1414,9 @@
 ! Premier appel: initialisation de la lecture des fichiers
 ! -----------------------------------------------------------------
-    if (first) THEN
+    IF (first) THEN
          ncidpl=-99
          WRITE(*,*)trim(modname)//' : opening nudging files '
 ! Ap et Bp si niveaux de pression hybrides
-         if (guide_plevs==1) THEN
+         IF (guide_plevs==1) THEN
            WRITE(*,*)trim(modname)//' Reading nudging on model levels'
            rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
@@ -1437,5 +1438,5 @@
          endif
 ! Pression
-         if (guide_plevs==2) THEN
+         IF (guide_plevs==2) THEN
            rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
            IF (rcode/=nf90_noerr) THEN
@@ -1449,8 +1450,8 @@
            ENDIF
            WRITE(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp
-           if (ncidpl==-99) ncidpl=ncidp
+           IF (ncidpl==-99) ncidpl=ncidp
          endif
 ! Vent zonal
-         if (guide_u) THEN
+         IF (guide_u) THEN
            rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
            IF (rcode/=nf90_noerr) THEN
@@ -1464,8 +1465,8 @@
            ENDIF
            WRITE(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu
-           if (ncidpl==-99) ncidpl=ncidu
+           IF (ncidpl==-99) ncidpl=ncidu
          endif
 ! Vent meridien
-         if (guide_v) THEN
+         IF (guide_v) THEN
            rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
            IF (rcode/=nf90_noerr) THEN
@@ -1479,8 +1480,8 @@
            ENDIF
            WRITE(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv
-           if (ncidpl==-99) ncidpl=ncidv
+           IF (ncidpl==-99) ncidpl=ncidv
          endif
 ! Temperature
-         if (guide_T) THEN
+         IF (guide_T) THEN
            rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
            IF (rcode/=nf90_noerr) THEN
@@ -1494,8 +1495,8 @@
            ENDIF
            WRITE(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt
-           if (ncidpl==-99) ncidpl=ncidt
+           IF (ncidpl==-99) ncidpl=ncidt
          endif
 ! Humidite
-         if (guide_Q) THEN
+         IF (guide_Q) THEN
            rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
            IF (rcode/=nf90_noerr) THEN
@@ -1509,8 +1510,8 @@
            ENDIF
            WRITE(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
-           if (ncidpl==-99) ncidpl=ncidQ
+           IF (ncidpl==-99) ncidpl=ncidQ
          endif
 ! Pression de surface
-         if ((guide_P).OR.(guide_modele)) THEN
+         IF ((guide_P).OR.(guide_modele)) THEN
            rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
            IF (rcode/=nf90_noerr) THEN
@@ -1526,5 +1527,5 @@
          endif
 ! Coordonnee verticale
-         if (guide_plevs==0) THEN
+         IF (guide_plevs==0) THEN
            rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
            IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
@@ -1532,5 +1533,5 @@
          endif
 ! Coefs ap, bp pour calcul de la pression aux differents niveaux
-         if (guide_plevs==1) THEN
+         IF (guide_plevs==1) THEN
              status=nf90_get_var(ncidpl,varidap,apnc,[1],[nlevnc])
              status=nf90_get_var(ncidpl,varidbp,bpnc,[1],[nlevnc])
@@ -1559,5 +1560,5 @@
 
 !  Pression
-     if (guide_plevs==2) THEN
+     IF (guide_plevs==2) THEN
          status=nf90_get_var(ncidp,varidp,zu,start,count)
          DO i=1,iip1
@@ -1572,5 +1573,5 @@
      endif
 !  Vent zonal
-     if (guide_u) THEN
+     IF (guide_u) THEN
          status=nf90_get_var(ncidu,varidu,zu,start,count)
          DO i=1,iip1
@@ -1585,5 +1586,5 @@
 
 !  Temperature
-     if (guide_T) THEN
+     IF (guide_T) THEN
          status=nf90_get_var(ncidt,varidt,zu,start,count)
          DO i=1,iip1
@@ -1598,5 +1599,5 @@
 
 !  Humidite
-     if (guide_Q) THEN
+     IF (guide_Q) THEN
          status=nf90_get_var(ncidQ,varidQ,zu,start,count)
          DO i=1,iip1
@@ -1611,5 +1612,5 @@
 
 !  Vent meridien
-     if (guide_v) THEN
+     IF (guide_v) THEN
          count(2)=jjm
          status=nf90_get_var(ncidv,varidv,zv,start,count)
@@ -1625,5 +1626,5 @@
 
 !  Pression de surface
-     if ((guide_P).OR.(guide_plevs==1))  THEN
+     IF ((guide_P).OR.(guide_plevs==1))  THEN
          start(3)=timestep
          start(4)=0
@@ -1797,8 +1798,8 @@
 !===========================================================================
   SUBROUTINE correctbid(iim,nl,x)
-    integer iim,nl
-    real x(iim+1,nl)
-    integer i,l
-    real zz
+    INTEGER iim,nl
+    REAL x(iim+1,nl)
+    INTEGER i,l
+    REAL zz
 
     do l=1,nl
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/iniacademic.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/iniacademic.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/iniacademic.F90	(revision 5117)
@@ -7,8 +7,8 @@
   USE infotrac,    ONLY: nqtot, niso, iqIsoPha, tracers, getKey, isoName
   USE control_mod, ONLY: day_step,planet_type
-  use exner_hyb_m, ONLY: exner_hyb
-  use exner_milieu_m, ONLY: exner_milieu
+  USE exner_hyb_m, ONLY: exner_hyb
+  USE exner_milieu_m, ONLY: exner_milieu
   USE IOIPSL, ONLY: getin
-  USE Write_Field
+  USE lmdz_write_field
   USE comconst_mod, ONLY: cpp, kappa, g, daysec, dtvr, pi, im, jm
   USE logic_mod, ONLY: iflag_phys, read_start
@@ -16,6 +16,7 @@
   USE temps_mod, ONLY: annee_ref, day_ini, day_ref
   USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
-  USE readTracFiles_mod, ONLY: addPhase
-  use netcdf, ONLY: nf90_nowrite,nf90_open,nf90_noerr,nf90_inq_varid,nf90_close,nf90_get_var
+  USE lmdz_readTracFiles, ONLY: addPhase
+  USE netcdf, ONLY: nf90_nowrite,nf90_open,nf90_noerr,nf90_inq_varid,nf90_close,nf90_get_var
+  USE lmdz_ran1, ONLY: ran1
 
   !   Author:    Frederic Hourdin      original: 15/01/93
@@ -56,10 +57,10 @@
   REAL phi(ip1jmp1,llm)                  ! geopotentiel
   REAL ddsin,zsig,tetapv,w_pv  ! variables auxiliaires
-  real tetastrat ! potential temperature in the stratosphere, in K
-  real tetajl(jjp1,llm)
+  REAL tetastrat ! potential temperature in the stratosphere, in K
+  REAL tetajl(jjp1,llm)
   INTEGER i,j,l,lsup,ij, iq, iName, iPhase, iqParent
 
   INTEGER :: nid_relief,varid,ierr
-  real, dimension(iip1,jjp1) :: relief
+  REAL, DIMENSION(iip1,jjp1) :: relief
 
   REAL teta0,ttp,delt_y,delt_z,eps ! Constantes pour profil de T
@@ -69,6 +70,6 @@
   REAL phi_pv,dphi_pv,gam_pv,tetanoise   ! Constantes pour polar vortex 
 
-  real zz,ran1
-  integer idum
+  REAL zz
+  INTEGER idum
 
   REAL zdtvr, tnat, alpha_ideal
@@ -79,5 +80,5 @@
 
   ! Sanity check: verify that options selected by user are not incompatible
-  if ((iflag_phys==1).and. .not. read_start) THEN
+  IF ((iflag_phys==1).AND. .NOT. read_start) THEN
     WRITE(lunout,*) trim(modname)," error: if read_start is set to ", &
     " false then iflag_phys should not be 1"
@@ -85,5 +86,5 @@
     " (iflag_phys >= 100)"
     CALL abort_gcm(modname,"incompatible iflag_phys==1 and read_start==.FALSE.",1)
-  endif
+  ENDIF
   
   !-----------------------------------------------------------------------
@@ -109,8 +110,8 @@
   ang0       = 0.
 
-  if (llm == 1) THEN
+  IF (llm == 1) THEN
      ! specific initializations for the shallow water case
      kappa=1
-  endif
+  ENDIF
 
   CALL iniconst
@@ -136,7 +137,7 @@
      relief=0.
      ierr = nf90_open ('relief_in.nc', nf90_nowrite,nid_relief)
-     if (ierr==nf90_noerr) THEN
+     IF (ierr==nf90_noerr) THEN
          ierr=nf90_inq_varid(nid_relief,'RELIEF',varid)
-         if (ierr==nf90_noerr) THEN
+         IF (ierr==nf90_noerr) THEN
               ierr=nf90_get_var(nid_relief,varid,relief(1:iim,1:jjp1))
               relief(iip1,:)=relief(1,:)
@@ -164,5 +165,5 @@
      CALL pression ( ip1jmp1, ap, bp, ps, p       )
 
-     if (pressure_exner) THEN
+     IF (pressure_exner) THEN
        CALL exner_hyb( ip1jmp1, ps, p, pks, pk)
      else
@@ -172,12 +173,12 @@
   ENDIF
 
-  if (llm == 1) THEN
+  IF (llm == 1) THEN
      ! initialize fields for the shallow water case, if required
-     if (.not.read_start) THEN
+     IF (.NOT.read_start) THEN
         phis(:)=0.
         q(:,:,:)=0
         CALL sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
      endif
-  endif
+  ENDIF
 
   academic_case: if (iflag_phys >= 2) THEN
@@ -249,5 +250,5 @@
            tetajl(j,l)=teta0-delt_y*ddsin*ddsin+eps*ddsin &
                 -delt_z*(1.-ddsin*ddsin)*log(zsig)
-           if (planet_type=="giant") THEN
+           IF (planet_type=="giant") THEN
              tetajl(j,l)=teta0+(delt_y*                   &
                 ((sin(rlatu(j)*3.14159*eps+0.0001))**2)   &
@@ -293,5 +294,5 @@
 
         ! winds
-        if (ok_geost) THEN
+        IF (ok_geost) THEN
            CALL ugeostr(phi,ucov)
         else
@@ -301,5 +302,5 @@
 
         ! bulk initialization of tracers
-        if (planet_type=="earth") THEN
+        IF (planet_type=="earth") THEN
            ! Earth: first two tracers will be water
            do iq=1,nqtot
@@ -311,9 +312,9 @@
               ! distill de Rayleigh très simplifiée
               iName    = tracers(iq)%iso_iName
-              if (niso <= 0 .OR. iName <= 0) CYCLE
+              IF (niso <= 0 .OR. iName <= 0) CYCLE
               iPhase   = tracers(iq)%iso_iPhase
               iqParent = tracers(iq)%iqParent
               IF(tracers(iq)%iso_iZone == 0) THEN
-                 if (tnat1) THEN
+                 IF (tnat1) THEN
                          tnat=1.0
                          alpha_ideal=1.0
@@ -358,5 +359,5 @@
 
      ENDIF ! of IF (.NOT. read_start)
-  endif academic_case
+  ENDIF academic_case
 
 END SUBROUTINE iniacademic
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/iniinterp_horiz.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/iniinterp_horiz.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/iniinterp_horiz.F90	(revision 5117)
@@ -116,12 +116,12 @@
   do jj = 1, jmn + 1
     do j = 1, jmo + 1
-      if((cn(jj)<d(j)).and.(dn(jj)>c(j)))THEN
+      IF((cn(jj)<d(j)).AND.(dn(jj)>c(j)))THEN
         do ii = 1, imn + 1
           do i = 1, imo + 1
-            if (((an(ii)<b(i)).and.(bn(ii)>a(i))) &
-                    .or. ((an(ii)<b(i) - 2 * pi).and.(bn(ii)>a(i) - 2 * pi) &
-                            .and.(b(i) - 2 * pi<-pi)) &
-                    .or. ((an(ii)<b(i) + 2 * pi).and.(bn(ii)>a(i) + 2 * pi) &
-                            .and.(a(i) + 2 * pi>pi)) &
+            IF (((an(ii)<b(i)).AND.(bn(ii)>a(i))) &
+                    .OR. ((an(ii)<b(i) - 2 * pi).AND.(bn(ii)>a(i) - 2 * pi) &
+                            .AND.(b(i) - 2 * pi<-pi)) &
+                    .OR. ((an(ii)<b(i) + 2 * pi).AND.(bn(ii)>a(i) + 2 * pi) &
+                            .AND.(a(i) + 2 * pi>pi)) &
                     )THEN
               ktotal = ktotal + 1
@@ -133,19 +133,19 @@
               dd = min(d(j), dn(jj))
               cc = cn(jj)
-              if (cc< c(j))cc = c(j)
-              if((an(ii)<b(i) - 2 * pi).and. &
+              IF (cc< c(j))cc = c(j)
+              IF((an(ii)<b(i) - 2 * pi).AND. &
                       (bn(ii)>a(i) - 2 * pi)) THEN
                 bb = min(b(i) - 2 * pi, bn(ii))
                 aa = an(ii)
-                if (aa<a(i) - 2 * pi) aa = a(i) - 2 * pi
-              else if((an(ii)<b(i) + 2 * pi).and. &
+                IF (aa<a(i) - 2 * pi) aa = a(i) - 2 * pi
+              ELSE IF((an(ii)<b(i) + 2 * pi).AND. &
                       (bn(ii)>a(i) + 2 * pi)) THEN
                 bb = min(b(i) + 2 * pi, bn(ii))
                 aa = an(ii)
-                if (aa<a(i) + 2 * pi) aa = a(i) + 2 * pi
+                IF (aa<a(i) + 2 * pi) aa = a(i) + 2 * pi
               else
                 bb = min(b(i), bn(ii))
                 aa = an(ii)
-                if (aa<a(i)) aa = a(i)
+                IF (aa<a(i)) aa = a(i)
               end if
               intersec(ktotal) = (bb - aa) * (sin(dd) - sin(cc))
@@ -165,6 +165,6 @@
   !  i = ik(k)
   !  j = jk(k)
-  !  if ((ii.eq.10).and.(jj.eq.10).and.(i.eq.10).and.(j.eq.10))THEN
-  !  if (jj.eq.2.and.(ii.eq.1))THEN
+  !  if ((ii.EQ.10).AND.(jj.EQ.10).AND.(i.EQ.10).AND.(j.EQ.10))THEN
+  !  if (jj.EQ.2.AND.(ii.EQ.1))THEN
   !      WRITE(*,*) '**************** jj=',jj,'ii=',ii
   !      WRITE(*,*) 'i,j =',i,j
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/integrd.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/integrd.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/integrd.F90	(revision 5117)
@@ -6,8 +6,8 @@
         )
 
-  use control_mod, ONLY: planet_type
-  use comconst_mod, ONLY: pi
+  USE control_mod, ONLY: planet_type
+  USE comconst_mod, ONLY: pi
   USE logic_mod, ONLY: leapf
-  use comvert_mod, ONLY: ap, bp
+  USE comvert_mod, ONLY: ap, bp
   USE temps_mod, ONLY: dt
 
@@ -38,25 +38,25 @@
   !   ----------
 
-  integer, intent(in) :: nq ! number of tracers to handle in this routine
-  real, intent(inout) :: vcov(ip1jm, llm) ! covariant meridional wind
-  real, intent(inout) :: ucov(ip1jmp1, llm) ! covariant zonal wind
-  real, intent(inout) :: teta(ip1jmp1, llm) ! potential temperature
-  real, intent(inout) :: q(ip1jmp1, llm, nq) ! advected tracers
-  real, intent(inout) :: ps(ip1jmp1) ! surface pressure
-  real, intent(inout) :: masse(ip1jmp1, llm) ! atmospheric mass
-  real, intent(in) :: phis(ip1jmp1) ! ground geopotential !!! unused
+  INTEGER, INTENT(IN) :: nq ! number of tracers to handle in this routine
+  REAL, INTENT(INOUT) :: vcov(ip1jm, llm) ! covariant meridional wind
+  REAL, INTENT(INOUT) :: ucov(ip1jmp1, llm) ! covariant zonal wind
+  REAL, INTENT(INOUT) :: teta(ip1jmp1, llm) ! potential temperature
+  REAL, INTENT(INOUT) :: q(ip1jmp1, llm, nq) ! advected tracers
+  REAL, INTENT(INOUT) :: ps(ip1jmp1) ! surface pressure
+  REAL, INTENT(INOUT) :: masse(ip1jmp1, llm) ! atmospheric mass
+  REAL, INTENT(IN) :: phis(ip1jmp1) ! ground geopotential !!! unused
   ! values at previous time step
-  real, intent(inout) :: vcovm1(ip1jm, llm)
-  real, intent(inout) :: ucovm1(ip1jmp1, llm)
-  real, intent(inout) :: tetam1(ip1jmp1, llm)
-  real, intent(inout) :: psm1(ip1jmp1)
-  real, intent(inout) :: massem1(ip1jmp1, llm)
+  REAL, INTENT(INOUT) :: vcovm1(ip1jm, llm)
+  REAL, INTENT(INOUT) :: ucovm1(ip1jmp1, llm)
+  REAL, INTENT(INOUT) :: tetam1(ip1jmp1, llm)
+  REAL, INTENT(INOUT) :: psm1(ip1jmp1)
+  REAL, INTENT(INOUT) :: massem1(ip1jmp1, llm)
   ! the tendencies to add
-  real, intent(in) :: dv(ip1jm, llm)
-  real, intent(in) :: du(ip1jmp1, llm)
-  real, intent(in) :: dteta(ip1jmp1, llm)
-  real, intent(in) :: dp(ip1jmp1)
-  real, intent(in) :: dq(ip1jmp1, llm, nq) !!! unused
-  ! real,intent(out) :: finvmaold(ip1jmp1,llm) !!! unused
+  REAL, INTENT(IN) :: dv(ip1jm, llm)
+  REAL, INTENT(IN) :: du(ip1jmp1, llm)
+  REAL, INTENT(IN) :: dteta(ip1jmp1, llm)
+  REAL, INTENT(IN) :: dp(ip1jmp1)
+  REAL, INTENT(IN) :: dq(ip1jmp1, llm, nq) !!! unused
+  ! REAL,INTENT(OUT) :: finvmaold(ip1jmp1,llm) !!! unused
 
   !   Local:
@@ -203,5 +203,5 @@
   !$$$      ENDIF
 
-  if (planet_type=="earth") THEN
+  IF (planet_type=="earth") THEN
     ! Earth-specific treatment of first 2 tracers (water)
     DO l = 1, llm
@@ -238,5 +238,5 @@
     ! CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
 
-  endif ! of if (planet_type.eq."earth")
+  ENDIF ! of if (planet_type.EQ."earth")
   !
   !
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/interp_horiz.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/interp_horiz.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/interp_horiz.F90	(revision 5117)
@@ -48,5 +48,5 @@
   REAL :: totn, tots
 
-  logical :: firstcall, firsttest, aire_ok
+  LOGICAL :: firstcall, firsttest, aire_ok
   save firsttest
   data firsttest /.TRUE./
@@ -108,5 +108,5 @@
   !---------------------------------------------------------------
   !  TEST  TEST  TEST  TEST  TEST  TEST  TEST  TEST  TEST  TEST
-  !!       if (.not.(firsttest)) goto 99
+  !!       if (.NOT.(firsttest)) goto 99
   !!       firsttest = .FALSE.
   !! !     write (*,*) 'INTERP. HORIZ. : TEST SUR LES AIRES:'
@@ -128,5 +128,5 @@
   !!        do ii=1, imn+1
   !!          r = airen(ii,jj)/airetest(ii,jj)
-  !!          if ((r.gt.1.001).or.(r.lt.0.999)) THEN
+  !!          if ((r.gt.1.001).OR.(r.lt.0.999)) THEN
   !! !             write (*,*) '********** PROBLEME D'' AIRES !!!',
   !! !     &                   ' DANS L''INTERPOLATION HORIZONTALE'
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/leapfrog.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/leapfrog.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/leapfrog.F90	(revision 5117)
@@ -7,14 +7,14 @@
 
   !IM : pour sortir les param. du modele dans un fis. netcdf 110106
-  use IOIPSL
+  USE IOIPSL
   USE infotrac, ONLY: nqtot, isoCheck
   USE guide_mod, ONLY: guide_main
-  USE write_field, ONLY: writefield
+  USE lmdz_write_field, ONLY: writefield
   USE control_mod, ONLY: nday, day_step, planet_type, offline, &
           iconser, iphysiq, iperiod, dissip_period, &
           iecri, ip_ebil_dyn, ok_dynzon, ok_dyn_ins, &
           periodav, ok_dyn_ave, output_grads_dyn
-  use exner_hyb_m, ONLY: exner_hyb
-  use exner_milieu_m, ONLY: exner_milieu
+  USE exner_hyb_m, ONLY: exner_hyb
+  USE exner_milieu_m, ONLY: exner_milieu
   USE comvert_mod, ONLY: ap, bp, pressure_exner, presnivs
   USE comconst_mod, ONLY: cpp, dtphys, dtvr, pi, ihf
@@ -23,5 +23,5 @@
   USE temps_mod, ONLY: jD_ref, jH_ref, itaufin, day_ini, day_ref, &
           start_time, dt
-  USE strings_mod, ONLY: msg
+  USE lmdz_strings, ONLY: msg
   USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_PHYS
   USE lmdz_description, ONLY: descript
@@ -146,7 +146,7 @@
   REAL :: zx_tmp_2d(iip1, jjp1)
   INTEGER :: ndex2d(iip1 * jjp1)
-  logical :: ok_sync
+  LOGICAL :: ok_sync
   parameter (ok_sync = .TRUE.)
-  logical :: physic
+  LOGICAL :: physic
 
   data callinigrads/.TRUE./
@@ -174,5 +174,5 @@
   CHARACTER(LEN = 80) :: abort_message
 
-  logical :: dissip_conservative
+  LOGICAL :: dissip_conservative
   save dissip_conservative
   data dissip_conservative/.TRUE./
@@ -188,13 +188,13 @@
   INTEGER :: itau_w   ! pas de temps ecriture = itap + itau_phy
 
-  if (nday>=0) THEN
+  IF (nday>=0) THEN
     itaufin = nday * day_step
   else
     itaufin = -nday
-  endif
+  ENDIF
   itaufinp1 = itaufin + 1
   itau = 0
   physic = .TRUE.
-  if (iflag_phys==0.or.iflag_phys==2) physic = .FALSE.
+  IF (iflag_phys==0.OR.iflag_phys==2) physic = .FALSE.
 
   ! iday = day_ini+itau/day_step
@@ -212,9 +212,9 @@
   dq(:, :, :) = 0.
   CALL pression (ip1jmp1, ap, bp, ps, p)
-  if (pressure_exner) THEN
+  IF (pressure_exner) THEN
     CALL exner_hyb(ip1jmp1, ps, p, pks, pk, pkf)
   else
     CALL exner_milieu(ip1jmp1, ps, p, pks, pk, pkf)
-  endif
+  ENDIF
 
   !-----------------------------------------------------------------------
@@ -236,7 +236,7 @@
   CALL check_isotopes_seq(q, ip1jmp1, 'leapfrog 321')
 
-  if (ok_guide) THEN
+  IF (ok_guide) THEN
     CALL guide_main(itau,ucov,vcov,teta,q,masse,ps)
-  endif
+  ENDIF
 
 
@@ -299,5 +299,5 @@
             apdiss = .TRUE.
     IF(MOD(itau, iphysiq)==0.AND..NOT.forward &
-            .and. physic) apphys = .TRUE.
+            .AND. physic) apphys = .TRUE.
   ELSE
     ! Leapfrog/Matsuno time stepping
@@ -310,7 +310,7 @@
   ! Ehouarn: for Shallow Water case (ie: 1 vertical layer),
   ! supress dissipation step
-  if (llm==1) THEN
+  IF (llm==1) THEN
     apdiss = .FALSE.
-  endif
+  ENDIF
 
   CALL check_isotopes_seq(q, ip1jmp1, 'leapfrog 589')
@@ -389,5 +389,5 @@
 
     CALL pression (ip1jmp1, ap, bp, ps, p)
-    if (pressure_exner) THEN
+    IF (pressure_exner) THEN
       CALL exner_hyb(ip1jmp1, ps, p, pks, pk, pkf)
     else
@@ -453,5 +453,5 @@
     CALL pression (ip1jmp1, ap, bp, ps, p)
     CALL massdair(p, masse)
-    if (pressure_exner) THEN
+    IF (pressure_exner) THEN
       CALL exner_hyb(ip1jmp1, ps, p, pks, pk, pkf)
     else
@@ -485,5 +485,5 @@
     ENDDO ! of DO l=1,llm
 
-    if (planet_type=="giant") THEN
+    IF (planet_type=="giant") THEN
       ! add an intrinsic heat flux at the base of the atmosphere
       teta(:, 1) = teta(:, 1) + dtvr * aire(:) * ihf / cpp / masse(:, 1)
@@ -511,9 +511,9 @@
 
   CALL pression (ip1jmp1, ap, bp, ps, p)
-  if (pressure_exner) THEN
+  IF (pressure_exner) THEN
     CALL exner_hyb(ip1jmp1, ps, p, pks, pk, pkf)
   else
     CALL exner_milieu(ip1jmp1, ps, p, pks, pk, pkf)
-  endif
+  ENDIF
   CALL massdair(p, masse)
 
@@ -539,5 +539,5 @@
 
     !------------------------------------------------------------------------
-    if (dissip_conservative) THEN
+    IF (dissip_conservative) THEN
       ! On rajoute la tendance due a la transform. Ec -> E therm. cree
       ! lors de la dissipation
@@ -570,5 +570,5 @@
     ENDDO
 
-    if (1 == 0) THEN
+    IF (1 == 0) THEN
       !!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
       !!!                     2) should probably not be here anyway
@@ -621,5 +621,5 @@
 
     IF(itau == itaufinp1) THEN
-      if (flag_verif) THEN
+      IF (flag_verif) THEN
         WRITE(79, *) 'ucov', ucov
         WRITE(80, *) 'vcov', vcov
@@ -668,5 +668,5 @@
     IF(MOD(itau, iecri)==0) THEN
       ! ! Ehouarn: output only during LF or Backward Matsuno
-      if (leapf.or.(.not.leapf.and.(.not.forward))) THEN
+      IF (leapf.OR.(.NOT.leapf.AND.(.NOT.forward))) THEN
         CALL geopot(ip1jmp1, teta, pk, pks, phis, phi)
         unat = 0.
@@ -675,5 +675,5 @@
           vnat(:, l) = vcov(:, l) / cv(:)
         enddo
-          if (ok_dyn_ins) THEN
+          IF (ok_dyn_ins) THEN
             ! WRITE(lunout,*) "leapfrog: CALL writehist, itau=",itau
            CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis)
@@ -685,8 +685,8 @@
           endif ! of if (ok_dyn_ins)
         ! For some Grads outputs of fields
-        if (output_grads_dyn) THEN
+        IF (output_grads_dyn) THEN
           include "write_grads_dyn.h"
         endif
-      endif ! of if (leapf.or.(.not.leapf.and.(.not.forward)))
+      endif ! of if (leapf.OR.(.NOT.leapf.AND.(.NOT.forward)))
     ENDIF ! of IF(MOD(itau,iecri).EQ.0)
 
@@ -694,12 +694,12 @@
 
 
-      ! if (planet_type.eq."earth") THEN
+      ! if (planet_type.EQ."earth") THEN
       ! Write an Earth-format restart file
       CALL dynredem1("restart.nc", start_time, &
               vcov, ucov, teta, q, masse, ps)
-      ! endif ! of if (planet_type.eq."earth")
+      ! END IF ! of if (planet_type.EQ."earth")
 
       CLOSE(99)
-      if (ok_guide) THEN
+      IF (ok_guide) THEN
         ! ! set ok_guide to false to avoid extra output
         ! ! in following forward step
@@ -741,5 +741,5 @@
     ! !    ELSEIF (MOD(itau-1,iperiod).EQ.0)
 
-  ELSE ! of IF (.not.purmats)
+  ELSE ! of IF (.NOT.purmats)
 
     CALL check_isotopes_seq(q, ip1jmp1, 'leapfrog 1664')
@@ -799,5 +799,5 @@
           vnat(:, l) = vcov(:, l) / cv(:)
         enddo
-          if (ok_dyn_ins) THEN
+          IF (ok_dyn_ins) THEN
              ! WRITE(lunout,*) "leapfrog: CALL writehist (b)",
   ! &                        itau,iecri
@@ -805,5 +805,5 @@
           endif ! of if (ok_dyn_ins)
         ! For some Grads outputs
-        if (output_grads_dyn) THEN
+        IF (output_grads_dyn) THEN
           include "write_grads_dyn.h"
         endif
@@ -812,9 +812,9 @@
 
       IF(itau==itaufin) THEN
-        ! if (planet_type.eq."earth") THEN
+        ! if (planet_type.EQ."earth") THEN
         CALL dynredem1("restart.nc", start_time, &
                 vcov, ucov, teta, q, masse, ps)
-        ! endif ! of if (planet_type.eq."earth")
-        if (ok_guide) THEN
+        ! END IF ! of if (planet_type.EQ."earth")
+        IF (ok_guide) THEN
           ! ! set ok_guide to false to avoid extra output
           ! ! in following forward step
@@ -828,5 +828,5 @@
     ENDIF ! of IF (forward)
 
-  END IF ! of IF(.not.purmats)
+  END IF ! of IF(.NOT.purmats)
 
 END SUBROUTINE leapfrog
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/qminimum.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/qminimum.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/qminimum.F90	(revision 5117)
@@ -4,6 +4,6 @@
 
   USE infotrac, ONLY: niso, ntiso, iqIsoPha, tracers
-  USE strings_mod, ONLY: strIdx
-  USE readTracFiles_mod, ONLY: addPhase
+  USE lmdz_strings, ONLY: strIdx
+  USE lmdz_readTracFiles, ONLY: addPhase
   IMPLICIT none
   !
@@ -64,6 +64,6 @@
   DO k = 1, llm
     DO i = 1, ip1jmp1
-      if (seuil_liq - q(i, k, iq_liq) > 0.d0) THEN
-        if (niso > 0) zx_defau_diag(i, k, 2) = AMAX1 &
+      IF (seuil_liq - q(i, k, iq_liq) > 0.d0) THEN
+        IF (niso > 0) zx_defau_diag(i, k, 2) = AMAX1 &
                 (seuil_liq - q(i, k, iq_liq), 0.0)
 
@@ -80,6 +80,6 @@
     !cc      zx_abc = dpres(k) / dpres(k-1)
     DO i = 1, ip1jmp1
-      if (seuil_vap - q(i, k, iq_vap) > 0.d0) THEN
-        if (niso > 0) zx_defau_diag(i, k, 1) &
+      IF (seuil_vap - q(i, k, iq_vap) > 0.d0) THEN
+        IF (niso > 0) zx_defau_diag(i, k, 1) &
                 = AMAX1(seuil_vap - q(i, k, iq_vap), 0.0)
 
@@ -112,5 +112,5 @@
 
   !WRITE(*,*) 'qminimum 128'
-  if (niso > 0) THEN
+  IF (niso > 0) THEN
     ! CRisi: traiter de même les traceurs d'eau
     ! Mais il faut les prendre à l'envers pour essayer de conserver la
@@ -121,5 +121,5 @@
     ! génant
     DO i = 1, ip1jmp1
-      if (zx_pump(i)>0.0) THEN
+      IF (zx_pump(i)>0.0) THEN
         q_follow(i, 1, 1) = q_follow(i, 1, 1) + zx_pump(i)
       endif !if (zx_pump(i).gt.0.0) THEN
@@ -130,5 +130,5 @@
     do k = 2, llm
       DO i = 1, ip1jmp1
-        if (zx_defau_diag(i, k, 1)>0.0) THEN
+        IF (zx_defau_diag(i, k, 1)>0.0) THEN
           ! on ajoute la vapeur en k
           do ixt = 1, ntiso
@@ -162,5 +162,5 @@
     do k = 1, llm
       DO i = 1, ip1jmp1
-        if (zx_defau_diag(i, k, 2)>0.0) THEN
+        IF (zx_defau_diag(i, k, 2)>0.0) THEN
           ! ! on ajoute eau liquide en k en k
           do ixt = 1, ntiso
@@ -183,5 +183,5 @@
     CALL check_isotopes_seq(q, ip1jmp1, 'qminimum 197')
 
-  endif !if (niso > 0) THEN
+  ENDIF !if (niso > 0) THEN
   ! !WRITE(*,*) 'qminimum 188'
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/replay3d.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/replay3d.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/replay3d.F90	(revision 5117)
@@ -101,5 +101,5 @@
   CALL conf_gcm( 99, .TRUE.)
 
-  if (mod(iphysiq, iperiod) /= 0) CALL abort_gcm("conf_gcm", &
+  IF (mod(iphysiq, iperiod) /= 0) CALL abort_gcm("conf_gcm", &
        "iphysiq must be a multiple of iperiod", 1)
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j.F90	(revision 5117)
@@ -29,5 +29,5 @@
 
   INTEGER :: ilon, ilev
-  logical :: lnew
+  LOGICAL :: lnew
 
   REAL :: pgcm(ilon, ilev)
@@ -54,5 +54,5 @@
   ! PRINT*,'tetalevel pres=',pres
   !=====================================================================
-  if (lnew) THEN
+  IF (lnew) THEN
     !   on réinitialise les réindicages et les poids
     !=====================================================================
@@ -110,5 +110,5 @@
     enddo
 
-  endif ! lnew
+  ENDIF ! lnew
 
   !======================================================================
@@ -125,5 +125,5 @@
   do i = 1, ilon
     !IM      if (pgcm(i,1).LT.pres) THEN
-    if (pgcm(i, 1)>pres) THEN
+    IF (pgcm(i, 1)>pres) THEN
       ! Qpres(i)=1e33
       Qpres(i) = 1e+20
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j1.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j1.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j1.F90	(revision 5117)
@@ -29,5 +29,5 @@
 
   INTEGER :: ilon, ilev
-  logical :: lnew
+  LOGICAL :: lnew
 
   REAL :: pgcm(ilon, ilev)
@@ -54,5 +54,5 @@
   ! PRINT*,'tetalevel pres=',pres
   !=====================================================================
-  if (lnew) THEN
+  IF (lnew) THEN
     !   on réinitialise les réindicages et les poids
     !=====================================================================
@@ -110,5 +110,5 @@
     enddo
 
-  endif ! lnew
+  ENDIF ! lnew
 
   !======================================================================
@@ -125,5 +125,5 @@
   do i = 1, ilon
     !IM      if (pgcm(i,1).LT.pres) THEN
-    if (pgcm(i, 1)>pres) THEN
+    IF (pgcm(i, 1)>pres) THEN
       ! Qpres(i)=1e33
       Qpres(i) = 1e+20
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/top_bound.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/top_bound.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/top_bound.F90	(revision 5117)
@@ -58,9 +58,9 @@
   !   ----------
 
-  real, intent(inout) :: ucov(iip1, jjp1, llm) ! covariant zonal wind
-  real, intent(inout) :: vcov(iip1, jjm, llm) ! covariant meridional wind
-  real, intent(inout) :: teta(iip1, jjp1, llm) ! potential temperature
-  real, intent(in) :: masse(iip1, jjp1, llm) ! mass of atmosphere
-  real, intent(in) :: dt ! time step (s) of sponge model
+  REAL, INTENT(INOUT) :: ucov(iip1, jjp1, llm) ! covariant zonal wind
+  REAL, INTENT(INOUT) :: vcov(iip1, jjm, llm) ! covariant meridional wind
+  REAL, INTENT(INOUT) :: teta(iip1, jjp1, llm) ! potential temperature
+  REAL, INTENT(IN) :: masse(iip1, jjp1, llm) ! mass of atmosphere
+  REAL, INTENT(IN) :: dt ! time step (s) of sponge model
 
   !   Local:
@@ -72,5 +72,5 @@
   INTEGER :: i
   REAL, SAVE :: rdamp(llm) ! quenching coefficient
-  real, save :: lambda(llm) ! inverse or quenching time scale (Hz)
+  REAL, save :: lambda(llm) ! inverse or quenching time scale (Hz)
 
   LOGICAL, SAVE :: first = .TRUE.
@@ -78,8 +78,8 @@
   INTEGER :: j, l
 
-  if (iflag_top_bound==0) return
+  IF (iflag_top_bound==0) return
 
-  if (first) THEN
-    if (iflag_top_bound==1) THEN
+  IF (first) THEN
+    IF (iflag_top_bound==1) THEN
       ! sponge quenching over the topmost 4 atmospheric layers
       lambda(:) = 0.
@@ -88,5 +88,5 @@
       lambda(llm - 2) = tau_top_bound / 4.
       lambda(llm - 3) = tau_top_bound / 8.
-    else if (iflag_top_bound==2) THEN
+    ELSE IF (iflag_top_bound==2) THEN
       ! sponge quenching over topmost layers down to pressures which are
       ! higher than 100 times the topmost layer pressure
@@ -103,5 +103,5 @@
     WRITE(lunout, *)'p (Pa)  z(km)  tau(s)   1./tau (Hz)'
     do l = 1, llm
-      if (rdamp(l)/=0.) THEN
+      IF (rdamp(l)/=0.) THEN
         WRITE(lunout, '(6(1pe12.4,1x))') &
                 presnivs(l), log(preff / presnivs(l)) * scaleheight, &
@@ -110,10 +110,10 @@
     enddo
     first = .FALSE.
-  endif ! of if (first)
+  ENDIF ! of if (first)
 
   CALL massbar(masse, massebx, masseby)
 
   ! compute zonal average of vcov and u
-  if (mode_top_bound>=2) THEN
+  IF (mode_top_bound>=2) THEN
     do l = 1, llm
       do j = 1, jjm
@@ -144,8 +144,8 @@
     vzon(:, :) = 0.
     uzon(:, :) = 0.
-  endif ! of if (mode_top_bound.ge.2)
+  ENDIF ! of if (mode_top_bound.ge.2)
 
   ! compute zonal average of potential temperature, if necessary
-  if (mode_top_bound>=3) THEN
+  IF (mode_top_bound>=3) THEN
     do l = 1, llm
       do j = 2, jjm ! excluding poles
@@ -159,7 +159,7 @@
       enddo
     enddo
-  endif ! of if (mode_top_bound.ge.3)
+  ENDIF ! of if (mode_top_bound.ge.3)
 
-  if (mode_top_bound>=1) THEN
+  IF (mode_top_bound>=1) THEN
     ! Apply sponge quenching on vcov:
     do l = 1, llm
@@ -181,7 +181,7 @@
       enddo
     enddo
-  endif ! of if (mode_top_bound.ge.1)
+  ENDIF ! of if (mode_top_bound.ge.1)
 
-  if (mode_top_bound>=3) THEN
+  IF (mode_top_bound>=3) THEN
     ! Apply sponge quenching on teta:
     do l = 1, llm
@@ -193,5 +193,5 @@
       enddo
     enddo
-  endif ! of if (mode_top_bound.ge.3)
+  ENDIF ! of if (mode_top_bound.ge.3)
 
 END SUBROUTINE top_bound
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/vlsplt.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/vlsplt.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/vlsplt.F90	(revision 5117)
@@ -293,5 +293,5 @@
 
   IF(n0>0) THEN
-  if (prt_level > 2) PRINT *, &
+  IF (prt_level > 2) PRINT *, &
         'Nombre de points pour lesquels on advect plus que le' &
         ,'contenu de la maille : ',n0
@@ -302,5 +302,5 @@
   !   indicage des mailles concernees par le traitement special
            DO ij=iip2,ip1jm
-              IF(iadvplus(ij,l)==1.and.mod(ij,iip1)/=0) THEN
+              IF(iadvplus(ij,l)==1.AND.mod(ij,iip1)/=0) THEN
                  iju=iju+1
                  indu(iju)=ij
@@ -372,5 +372,5 @@
         !Mvals: veiller a ce qu'on n'ait pas de denominateur nul
         masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
-        if (q(ij,l,iq)>min_qParent) THEN
+        IF (q(ij,l,iq)>min_qParent) THEN
           Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
         else
@@ -688,5 +688,5 @@
         ! !MVals: veiller a ce qu'on n'ait pas de denominateur nul
         masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
-        if (q(ij,l,iq)>min_qParent) THEN
+        IF (q(ij,l,iq)>min_qParent) THEN
           Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
         else
@@ -855,5 +855,5 @@
         ! !MVals: veiller a ce qu'on n'ait pas de denominateur nul
         masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
-        if (q(ij,l,iq)>min_qParent) THEN
+        IF (q(ij,l,iq)>min_qParent) THEN
           Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
         else
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/vlspltqs.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/vlspltqs.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/vlspltqs.F90	(revision 5117)
@@ -391,5 +391,5 @@
         !   indicage des mailles concernees par le traitement special
         DO ij = iip2, ip1jm
-          IF(iadvplus(ij, l)==1.and.mod(ij, iip1)/=0) THEN
+          IF(iadvplus(ij, l)==1.AND.mod(ij, iip1)/=0) THEN
             iju = iju + 1
             indu(iju) = ij
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/wrgrads.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/wrgrads.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/wrgrads.f90	(revision 5117)
@@ -18,5 +18,5 @@
   REAL :: field(imx * jmx * lmx)
 
-  integer, parameter :: wp = selected_real_kind(p = 6, r = 36)
+  INTEGER, parameter :: wp = selected_real_kind(p = 6, r = 36)
   real(wp) field4(imx * jmx * lmx)
 
@@ -28,7 +28,7 @@
   INTEGER :: im, jm, lm, i, j, l, iv, iii, iji, iif, ijf
 
-  logical :: writectl
+  LOGICAL :: writectl
 
-  writectl = .false.
+  writectl = .FALSE.
 
   ! print*,if,iid(if),jid(if),ifd(if),jfd(if)
@@ -46,5 +46,5 @@
   IF(firsttime(if)) THEN
     IF(name==var(1, if)) THEN
-      firsttime(if) = .false.
+      firsttime(if) = .FALSE.
       ivar(if) = 1
       print*, 'fin de l initialiation de l ecriture du fichier'
@@ -63,10 +63,10 @@
       ! print*,'if ivar(if) nld ',if,ivar(if),nld(ivar(if),if)
     endif
-    writectl = .true.
+    writectl = .TRUE.
     itime(if) = 1
   else
     ivar(if) = mod(ivar(if), nvar(if)) + 1
-    if (ivar(if)==nvar(if)) THEN
-      writectl = .true.
+    IF (ivar(if)==nvar(if)) THEN
+      writectl = .TRUE.
       itime(if) = itime(if) + 1
     endif
@@ -81,5 +81,5 @@
       CALL abort_gcm("wrgrads", "problem", 1)
     endif
-  endif
+  ENDIF
 
   ! print*,'ivar(if),nvar(if),var(ivar(if),if),writectl'
@@ -95,5 +95,5 @@
                     , i = iii, iif), j = iji, ijf)
   enddo
-  if (writectl) THEN
+  IF (writectl) THEN
     file = fichier(if)
     !   WARNING! on reecrase le fichier .ctl a chaque ecriture
@@ -105,7 +105,7 @@
     WRITE(unit(if), '(a12)') 'UNDEF 1.0E30'
     WRITE(unit(if), '(a5,1x,a40)') 'TITLE ', title(if)
-    CALL formcoord(unit(if), im, xd(iii, if), 1., .false., 'XDEF')
-    CALL formcoord(unit(if), jm, yd(iji, if), 1., .true., 'YDEF')
-    CALL formcoord(unit(if), lm, zd(1, if), 1., .false., 'ZDEF')
+    CALL formcoord(unit(if), im, xd(iii, if), 1., .FALSE., 'XDEF')
+    CALL formcoord(unit(if), jm, yd(iji, if), 1., .TRUE., 'YDEF')
+    CALL formcoord(unit(if), lm, zd(1, if), 1., .FALSE., 'ZDEF')
     WRITE(unit(if), '(a4,i10,a30)') &
             'TDEF ', itime(if), ' LINEAR 02JAN1987 1MO '
@@ -123,5 +123,5 @@
     close(unit(if))
 
-  endif ! writectl
+  ENDIF ! writectl
 
 END SUBROUTINE wrgrads
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d/write_paramLMDZ_dyn.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d/write_paramLMDZ_dyn.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d/write_paramLMDZ_dyn.h	(revision 5117)
@@ -107,9 +107,9 @@
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
 c
-      if (calend == 'earth_360d') THEN
+      IF (calend == 'earth_360d') THEN
         zx_tmp_2d(1:iip1,1:jjp1)=1.
-      else if (calend == 'earth_365d') THEN
+      ELSE IF (calend == 'earth_365d') THEN
         zx_tmp_2d(1:iip1,1:jjp1)=2.
-      else if (calend == 'earth_366d') THEN
+      ELSE IF (calend == 'earth_366d') THEN
         zx_tmp_2d(1:iip1,1:jjp1)=3.
       endif
@@ -240,5 +240,5 @@
 c=================================================================
 c
-      if (ok_sync) THEN
+      IF (ok_sync) THEN
         CALL histsync(nid_ctesGCM)
       endif
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/adaptdt.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/adaptdt.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/adaptdt.f90	(revision 5117)
@@ -40,5 +40,5 @@
     n=int(CFLmax)+1
   ! pour reproduire cas VL du code qui appele x,y,z,y,x
-     ! if (nadv.eq.30) n=n/2   ! Pour Prather
+     ! if (nadv.EQ.30) n=n/2   ! Pour Prather
     dtbon=dtvr/n
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/advn.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/advn.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/advn.f90	(revision 5117)
@@ -148,5 +148,5 @@
   REAL :: dxqu(ip1jmp1),zqu(ip1jmp1)
   REAL :: zqmax(ip1jmp1),zqmin(ip1jmp1)
-  logical :: extremum(ip1jmp1)
+  LOGICAL :: extremum(ip1jmp1)
 
   INTEGER :: mode
@@ -156,5 +156,5 @@
   !   calcul des pentes en u:
   !   -----------------------
-  if (mode==0) THEN
+  IF (mode==0) THEN
      do l=1,llm
         do ij=1,ip1jm
@@ -230,5 +230,5 @@
      enddo
      do ij=iip2,ip1jm-1
-        if (extremum(ij).and..not.extremum(ij+1)) &
+        IF (extremum(ij).and..not.extremum(ij+1)) &
               qg(ij+1,l)=q(ij,l)
      enddo
@@ -239,5 +239,5 @@
 8888   continue
   enddo
-  endif
+  ENDIF
   RETURN
 END SUBROUTINE advnqx
@@ -265,5 +265,5 @@
   REAL :: dyqv(ip1jm),zqv(ip1jm,llm)
   REAL :: zqmax(ip1jm),zqmin(ip1jm)
-  logical :: extremum(ip1jmp1)
+  LOGICAL :: extremum(ip1jmp1)
 
   INTEGER :: mode
@@ -271,5 +271,5 @@
   data mode/1/
 
-  if (mode==0) THEN
+  IF (mode==0) THEN
      do l=1,llm
         do ij=1,ip1jmp1
@@ -318,6 +318,6 @@
            qs(ij,l)=q(ij,l)
            qn(ij,l)=q(ij,l)
-           ! if (.not.extremum(ij-iip1)) qs(ij-iip1,l)=q(ij,l)
-           ! if (.not.extremum(ij+iip1)) qn(ij+iip1,l)=q(ij,l)
+           ! if (.NOT.extremum(ij-iip1)) qs(ij-iip1,l)=q(ij,l)
+           ! if (.NOT.extremum(ij+iip1)) qn(ij+iip1,l)=q(ij,l)
         else
            qs(ij,l)=zqv(ij,l)
@@ -334,5 +334,5 @@
 
   enddo
-  endif
+  ENDIF
   RETURN
 END SUBROUTINE advnqy
@@ -361,5 +361,5 @@
   REAL :: dzqw(ip1jmp1,llm+1),zqw(ip1jmp1,llm+1)
   REAL :: zqmax(ip1jmp1,llm),zqmin(ip1jmp1,llm)
-  logical :: extremum(ip1jmp1,llm)
+  LOGICAL :: extremum(ip1jmp1,llm)
 
   INTEGER :: mode
@@ -371,5 +371,5 @@
   !   -----------------------
 
-  if (mode==0) THEN
+  IF (mode==0) THEN
      do l=1,llm
         do ij=1,ip1jmp1
@@ -436,6 +436,6 @@
   !    do ij=1,ip1jmp1
   !       IF(extremum(ij,l)) THEN
-  !          if (.not.extremum(ij,l-1)) qh(ij,l-1)=q(ij,l)
-  !          if (.not.extremum(ij,l+1)) qb(ij,l+1)=q(ij,l)
+  !          if (.NOT.extremum(ij,l-1)) qh(ij,l-1)=q(ij,l)
+  !          if (.NOT.extremum(ij,l+1)) qb(ij,l+1)=q(ij,l)
   !       endif
   !    enddo
@@ -449,5 +449,5 @@
   enddo
 
-  endif
+  ENDIF
 
   RETURN
@@ -491,5 +491,5 @@
   REAL :: zm,zq,zsigm,zsigp,zqm,zqp,zu
 
-  logical :: ladvplus(ip1jmp1,llm)
+  LOGICAL :: ladvplus(ip1jmp1,llm)
 
   REAL :: prec
@@ -506,9 +506,9 @@
            !    qd(ij,l)=q(ij,l)
            !    qg(ij,l)=q(ij,l)
-           ! endif
+           ! END IF
            IF(abs(zdq)>prec) THEN
               zsigd(ij,l)=(q(ij,l)-qg(ij,l))/zdq
               zsigg(ij,l)=1.-zsigd(ij,l)
-              ! IF(.not.(zsigd(ij,l).ge.0..and.zsigd(ij,l).le.1. .and.
+              ! IF(.NOT.(zsigd(ij,l).ge.0..and.zsigd(ij,l).le.1. .AND.
   !    s               zsigg(ij,l).ge.0..or.zsigg(ij,l).le.1.) ) THEN
               !    PRINT*,'probleme au point ij=',ij,'  l=',l
@@ -516,5 +516,5 @@
               !    PRINT*,'q d,c,g ',qd(ij,l),q(ij,l),qg(ij,l),zdq
               !    stop
-              ! endif
+              ! END IF
            else
               zsigd(ij,l)=0.5
@@ -530,5 +530,5 @@
    do l=1,llm
    do ij=iip2,ip1jm-1
-      if (u_m(ij,l)>=0.) THEN
+      IF (u_m(ij,l)>=0.) THEN
          zsigp=zsigd(ij,l)
          zsigm=zsigg(ij,l)
@@ -549,13 +549,13 @@
       zsig=zu/zm
       IF(zsig==0.) zsigp=0.1
-      if (mode==1) THEN
-         if (zsig<=zsigp) THEN
+      IF (mode==1) THEN
+         IF (zsig<=zsigp) THEN
              u_mq(ij,l)=u_m(ij,l)*zqp
-         else if (mode==1) THEN
+         ELSE IF (mode==1) THEN
              u_mq(ij,l)= &
                    sign(zm,u_m(ij,l))*(zsigp*zqp+(zsig-zsigp)*zqm)
          endif
       else
-         if (zsig<=zsigp) THEN
+         IF (zsig<=zsigp) THEN
              u_mq(ij,l)=u_m(ij,l)*(zqp-0.5*zsig/zsigp*(zqp-zq))
          else
@@ -568,5 +568,5 @@
       !    PRINT*,'au point ij=',ij,'  l=',l,'  sig=',zsig
       !    stop
-      ! endif
+      ! END IF
   enddo
   enddo
@@ -605,5 +605,5 @@
   !   indicage des mailles concernees par le traitement special
            do ij=iip2,ip1jm
-              IF(ladvplus(ij,l).and.mod(ij,iip1)/=0) THEN
+              IF(ladvplus(ij,l).AND.mod(ij,iip1)/=0) THEN
                  iju=iju+1
                  indu(iju)=ij
@@ -639,5 +639,5 @@
       ! goto 8888
             zz=0.5*(zsig-zsigd(ijq,l))/zsigg(ijq,l)
-            IF(.not.(zz>0..and.zz<=0.5)) THEN
+            IF(.NOT.(zz>0..and.zz<=0.5)) THEN
                  WRITE(lunout,*)'probleme2 au point ij=',ij, &
                        '  l=',l
@@ -669,5 +669,5 @@
         ! goto 9999
             zz=0.5*(zsig-zsigg(ijq,l))/zsigd(ijq,l)
-            IF(.not.(zz>0..and.zz<=0.5)) THEN
+            IF(.NOT.(zz>0..and.zz<=0.5)) THEN
                  WRITE(lunout,*)'probleme22 au point ij=',ij &
                        ,'  l=',l
@@ -685,5 +685,5 @@
         endif
      enddo
-  endif  ! n0.gt.0
+  ENDIF  ! n0.gt.0
 
   !   bouclage en latitude
@@ -763,14 +763,14 @@
            !    qn(ij,l)=q(ij,l)
            !    qs(ij,l)=q(ij,l)
-           ! endif
+           ! END IF
            IF(abs(zdq)>prec) THEN
               zsign(ij)=(q(ij,l)-qs(ij,l))/zdq
               zsigs(ij)=1.-zsign(ij)
-              ! IF(.not.(zsign(ij).ge.0..and.zsign(ij).le.1. .and.
+              ! IF(.NOT.(zsign(ij).ge.0..and.zsign(ij).le.1. .AND.
   !    s               zsigs(ij).ge.0..or.zsigs(ij).le.1.) ) THEN
               !    PRINT*,'probleme au point ij=',ij,'  l=',l
               !    PRINT*,'sigs=',zsigs(ij),'  sign=',zsign(ij)
               !    stop
-              ! endif
+              ! END IF
            else
               zsign(ij)=0.5
@@ -782,5 +782,5 @@
 
    do ij=1,ip1jm
-      if (v_m(ij,l)>=0.) THEN
+      IF (v_m(ij,l)>=0.) THEN
          zsigp=zsign(ij+iip1)
          zsigm=zsigs(ij+iip1)
@@ -799,5 +799,5 @@
       zsig=abs(v_m(ij,l))/zm
       IF(zsig==0.) zsigp=0.1
-      if (zsig<=zsigp) THEN
+      IF (zsig<=zsigp) THEN
           v_mq(ij,l)=v_m(ij,l)*(zqp-0.5*zsig/zsigp*(zqp-zq))
       else
@@ -890,5 +890,5 @@
            !    qh(ij,l)=q(ij,l)
            !    qb(ij,l)=q(ij,l)
-           ! endif
+           ! END IF
 
            IF(abs(zdq)>prec) THEN
@@ -907,5 +907,5 @@
    do l=2,llm
    do ij=1,ip1jmp1
-      if (w_m(ij,l)>=0.) THEN
+      IF (w_m(ij,l)>=0.) THEN
          zsigp=zsigb(ij,l)
          zsigm=zsigh(ij,l)
@@ -924,5 +924,5 @@
       zsig=abs(w_m(ij,l))/zm
       IF(zsig==0.) zsigp=0.1
-      if (zsig<=zsigp) THEN
+      IF (zsig<=zsigp) THEN
           w_mq(ij,l)=w_m(ij,l)*(zqp-0.5*zsig/zsigp*(zqp-zq))
       else
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/comdissnew.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/comdissnew.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/comdissnew.h	(revision 5117)
@@ -17,5 +17,5 @@
       INTEGER nitergdiv, nitergrot, niterh
 
-      integer vert_prof_dissip ! vertical profile of horizontal dissipation
+      INTEGER vert_prof_dissip ! vertical profile of horizontal dissipation
 !     Allowed values:
 !     0: rational fraction, function of pressure
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/diagedyn.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/diagedyn.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/diagedyn.f90	(revision 5117)
@@ -273,5 +273,5 @@
   ! ===================================
   !
-  IF ( (idiag2>0) .and. (pas(idiag2) /= 0) ) THEN
+  IF ( (idiag2>0) .AND. (pas(idiag2) /= 0) ) THEN
     d_h_vcol  = (h_vcol_tot - h_vcol_pre(idiag2) )/dtime
     d_h_dair = (h_dair_tot- h_dair_pre(idiag2))/dtime
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert.F90	(revision 5117)
@@ -3,7 +3,7 @@
 SUBROUTINE disvert()
 
-  use ioipsl, ONLY: getin
-  use new_unit_m, ONLY: new_unit
-  use lmdz_assert, ONLY: assert
+  USE ioipsl, ONLY: getin
+  USE lmdz_new_unit, ONLY: new_unit
+  USE lmdz_assert, ONLY: assert
   USE comvert_mod, ONLY: ap, bp, aps, bps, nivsigs, nivsig, dpres, presnivs, &
                          pseudoalt, pa, preff, scaleheight, presinter
@@ -62,9 +62,9 @@
   CALL getin('vert_sampling', vert_sampling)
   WRITE(lunout,*) TRIM(modname)//' vert_sampling = ' // vert_sampling
-  if (llm==39 .and. vert_sampling=="strato") THEN
+  IF (llm==39 .AND. vert_sampling=="strato") THEN
      dsigmin=0.3 ! Vieille option par défaut pour CMIP5
   else
      dsigmin=1.
-  endif
+  ENDIF
   CALL getin('dsigmin', dsigmin)
   WRITE(LUNOUT,*) trim(modname), 'Discretisation verticale DSIGMIN=',dsigmin
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert_noterre.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert_noterre.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert_noterre.f90	(revision 5117)
@@ -6,5 +6,5 @@
   !    On l'utilise aussi pour Venus et Titan, legerment modifiee.
 
-  use IOIPSL
+  USE IOIPSL
   USE comvert_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt, &
         nivsig,nivsigs,pa,preff,scaleheight
@@ -168,5 +168,5 @@
   !
 
-  if (hybrid) then  ! use hybrid coordinates
+  IF (hybrid) then  ! use hybrid coordinates
      WRITE(lunout,*) "*********************************"
      WRITE(lunout,*) "Using hybrid vertical coordinates"
@@ -191,5 +191,5 @@
      ENDDO
      ap(llmp1) = 0.
-  endif
+  ENDIF
 
   bp(llmp1) =   0.
@@ -213,5 +213,5 @@
   ENDDO
 
-  if (hybrid) THEN
+  IF (hybrid) THEN
      aps(llm) = aps(llm-1)**2 / aps(llm-2)
      bps(llm) = 0.5*(bp(llm) + bp(llm+1))
@@ -301,11 +301,11 @@
   x1=0
   x2=1
-  if (sig>=1) THEN
+  IF (sig>=1) THEN
         newsig= sig
-  else if (sig*preff/pa>=0.25) THEN
+  ELSE IF (sig*preff/pa>=0.25) THEN
     DO J=1,9999  ! nombre d''iteration max
       F=((1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig)/sig
       ! WRITE(0,*) J, ' newsig =', newsig, ' F= ', F
-      if (F>1) THEN
+      IF (F>1) THEN
           X2 = newsig
           newsig=(X1+newsig)*0.5
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/exner_hyb_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/exner_hyb_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/exner_hyb_m.F90	(revision 5117)
@@ -45,5 +45,5 @@
     INTEGER  ngrid
     REAL p(ngrid,llmp1),pk(ngrid,llm)
-    real, optional:: pkf(ngrid,llm)
+    REAL, optional:: pkf(ngrid,llm)
     REAL ps(ngrid),pks(ngrid), alpha(ngrid,llm),beta(ngrid,llm)
 
@@ -57,16 +57,16 @@
 
     ! Sanity check
-    if (firstcall) THEN
+    IF (firstcall) THEN
        ! sanity checks for Shallow Water case (1 vertical layer)
-       if (llm==1) THEN
-          if (kappa/=1) THEN
+       IF (llm==1) THEN
+          IF (kappa/=1) THEN
              CALL abort_gcm(modname, &
                   "kappa!=1 , but running in Shallow Water mode!!",42)
           endif
-          if (cpp/=r) THEN
+          IF (cpp/=r) THEN
              CALL abort_gcm(modname, &
                   "cpp!=r , but running in Shallow Water mode!!",42)
           endif
-       endif ! of if (llm.eq.1)
+       endif ! of if (llm.EQ.1)
 
        firstcall=.FALSE.
@@ -74,5 +74,5 @@
 
     ! Specific behaviour for Shallow Water (1 vertical layer) case:
-    if (llm==1) THEN
+    IF (llm==1) THEN
        ! Compute pks(:),pk(:),pkf(:)
 
@@ -82,5 +82,5 @@
        ENDDO
 
-       if (present(pkf)) THEN
+       IF (present(pkf)) THEN
           pkf = pk
           CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 ) 
@@ -89,5 +89,5 @@
        ! our work is done, exit routine
        RETURN
-    endif ! of if (llm.eq.1)
+    endif ! of if (llm.EQ.1)
 
     ! General case:
@@ -137,5 +137,5 @@
     ENDDO
 
-    if (present(pkf)) THEN
+    IF (present(pkf)) THEN
        !    calcul de pkf
        pkf = pk
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/exner_milieu_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/exner_milieu_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/exner_milieu_m.F90	(revision 5117)
@@ -42,5 +42,5 @@
     INTEGER  ngrid
     REAL p(ngrid,llmp1),pk(ngrid,llm)
-    real, optional:: pkf(ngrid,llm)
+    REAL, optional:: pkf(ngrid,llm)
     REAL ps(ngrid),pks(ngrid)
 
@@ -54,16 +54,16 @@
 
     ! Sanity check
-    if (firstcall) THEN
+    IF (firstcall) THEN
        ! sanity checks for Shallow Water case (1 vertical layer)
-       if (llm==1) THEN
-          if (kappa/=1) THEN
+       IF (llm==1) THEN
+          IF (kappa/=1) THEN
              CALL abort_gcm(modname, &
                   "kappa!=1 , but running in Shallow Water mode!!",42)
           endif
-          if (cpp/=r) THEN
+          IF (cpp/=r) THEN
              CALL abort_gcm(modname, &
                   "cpp!=r , but running in Shallow Water mode!!",42)
           endif
-       endif ! of if (llm.eq.1)
+       endif ! of if (llm.EQ.1)
 
        firstcall=.FALSE.
@@ -71,5 +71,5 @@
 
     ! Specific behaviour for Shallow Water (1 vertical layer) case:
-    if (llm==1) THEN
+    IF (llm==1) THEN
        ! Compute pks(:),pk(:),pkf(:)
 
@@ -79,5 +79,5 @@
        ENDDO
 
-       if (present(pkf)) THEN
+       IF (present(pkf)) THEN
           pkf = pk
           CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 ) 
@@ -86,5 +86,5 @@
        ! our work is done, exit routine
        RETURN
-    endif ! of if (llm.eq.1)
+    endif ! of if (llm.EQ.1)
 
     ! General case:
@@ -116,5 +116,5 @@
     ENDDO
 
-    if (present(pkf)) THEN
+    IF (present(pkf)) THEN
        !    calcul de pkf
        pkf = pk
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/fxhyp_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/fxhyp_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/fxhyp_m.F90	(revision 5117)
@@ -18,20 +18,20 @@
     ! 1., taux=0., clon=0.) est à - 180 degrés.
 
-    use lmdz_arth, ONLY: arth
-    use invert_zoom_x_m, ONLY: invert_zoom_x, nmax
-    use nrtype, ONLY: pi, pi_d, twopi, twopi_d, k8
-    use principal_cshift_m, ONLY: principal_cshift
-    use serre_mod, ONLY: clon, grossismx, dzoomx, taux
+    USE lmdz_arth, ONLY: arth
+    USE invert_zoom_x_m, ONLY: invert_zoom_x, nmax
+    USE lmdz_physical_constants, ONLY: pi, pi_d, twopi, twopi_d, k8
+    USE principal_cshift_m, ONLY: principal_cshift
+    USE serre_mod, ONLY: clon, grossismx, dzoomx, taux
 
     include "dimensions.h"
     ! for iim
 
-    REAL, intent(out):: xprimm025(:), rlonv(:), xprimv(:) ! (iim + 1)
-    real, intent(out):: rlonu(:), xprimu(:), xprimp025(:) ! (iim + 1)
+    REAL, INTENT(OUT):: xprimm025(:), rlonv(:), xprimv(:) ! (iim + 1)
+    REAL, INTENT(OUT):: rlonu(:), xprimu(:), xprimp025(:) ! (iim + 1)
 
     ! Local:
-    real rlonm025(iim + 1), rlonp025(iim + 1)
+    REAL rlonm025(iim + 1), rlonp025(iim + 1)
     REAL dzoom, step
-    real d_rlonv(iim)
+    REAL d_rlonv(iim)
     REAL(K8) xtild(0:2 * nmax)
     REAL(K8) fhyp(nmax:2 * nmax), ffdx, beta, Xprimt(0:2 * nmax)
@@ -185,13 +185,13 @@
 
        IF (MINval(rlonm025(:iim)) < - pi - 0.1 &
-            .or. MAXval(rlonm025(:iim)) > pi + 0.1) THEN
+            .OR. MAXval(rlonm025(:iim)) > pi + 0.1) THEN
           IF (clon <= 0.) THEN
              is2 = 1
 
-             do while (rlonm025(is2) < - pi .and. is2 < iim)
+             do while (rlonm025(is2) < - pi .AND. is2 < iim)
                 is2 = is2 + 1
              END DO
 
-             if (rlonm025(is2) < - pi) THEN
+             IF (rlonm025(is2) < - pi) THEN
                 print *, 'Rlonm025 plus petit que - pi !'
                 STOP 1
@@ -200,9 +200,9 @@
              is2 = iim
 
-             do while (rlonm025(is2) > pi .and. is2 > 1)
+             do while (rlonm025(is2) > pi .AND. is2 > 1)
                 is2 = is2 - 1
              END DO
 
-             if (rlonm025(is2) > pi) THEN
+             IF (rlonm025(is2) > pi) THEN
                 print *, 'Rlonm025 plus grand que pi !'
                 STOP 1
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/fyhyp_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/fyhyp_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/fyhyp_m.F90	(revision 5117)
@@ -16,14 +16,14 @@
     ! Il vaut mieux avoir : grossismy * dzoom < pi / 2
 
-    use lmdz_coefpoly, ONLY: coefpoly
-    use nrtype, ONLY: k8
-    use serre_mod, ONLY: clat, grossismy, dzoomy, tauy
+    USE lmdz_coefpoly, ONLY: coefpoly
+    USE lmdz_physical_constants, ONLY: k8
+    USE serre_mod, ONLY: clat, grossismy, dzoomy, tauy
 
     include "dimensions.h"
     ! for jjm
 
-    REAL, intent(out):: rlatu(jjm + 1), yyprimu(jjm + 1)
-    REAL, intent(out):: rlatv(jjm)
-    real, intent(out):: rlatu2(jjm), yprimu2(jjm), rlatu1(jjm), yprimu1(jjm)
+    REAL, INTENT(OUT):: rlatu(jjm + 1), yyprimu(jjm + 1)
+    REAL, INTENT(OUT):: rlatv(jjm)
+    REAL, INTENT(OUT):: rlatu2(jjm), yprimu2(jjm), rlatu1(jjm), yprimu1(jjm)
 
     ! Local: 
@@ -179,5 +179,5 @@
 
           it = nmax2
-          DO while (it >= 1 .and. yfi < yf(it))
+          DO while (it >= 1 .AND. yfi < yf(it))
              it = it - 1
           END DO
@@ -201,5 +201,5 @@
           DO
              yi = yi - (yf1-yfi)/yprimin
-             IF (abs(yi-yo1)<=epsilon .or. iter == 300) exit
+             IF (abs(yi-yo1)<=epsilon .OR. iter == 300) exit
              yo1 = yi
              yi2 = yi*yi
@@ -207,5 +207,5 @@
              yprimin = a1 + 2.*a2*yi + 3.*a3*yi2
           END DO
-          if (abs(yi-yo1) > epsilon) THEN
+          IF (abs(yi-yo1) > epsilon) THEN
              print *, 'Pas de solution.', j, ylon2
              STOP 1
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/gr_int_dyn.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/gr_int_dyn.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/gr_int_dyn.f90	(revision 5117)
@@ -34,7 +34,7 @@
   do j = 1, jp1
     do i = 1, iim
-      if (j == 1) THEN
+      IF (j == 1) THEN
         champdyn(i, j) = polenord
-      else if (j == jp1) THEN
+      ELSE IF (j == jp1) THEN
         champdyn(i, j) = polesud
       else
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/gradsdef.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/gradsdef.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/gradsdef.h	(revision 5117)
@@ -2,16 +2,16 @@
 ! $Header$
 
-integer nfmx,imx,jmx,lmx,nvarmx
+INTEGER nfmx,imx,jmx,lmx,nvarmx
 parameter(nfmx=10,imx=200,jmx=150,lmx=200,nvarmx=1000)
 
-real xd(imx,nfmx),yd(jmx,nfmx),zd(lmx,nfmx),dtime(nfmx)
+REAL xd(imx,nfmx),yd(jmx,nfmx),zd(lmx,nfmx),dtime(nfmx)
 
-integer imd(imx),jmd(jmx),lmd(lmx)
-integer iid(imx),jid(jmx)
-integer ifd(imx),jfd(jmx)
-integer unit(nfmx),irec(nfmx),itime(nfmx),nld(nvarmx,nfmx)
+INTEGER imd(imx),jmd(jmx),lmd(lmx)
+INTEGER iid(imx),jid(jmx)
+INTEGER ifd(imx),jfd(jmx)
+INTEGER unit(nfmx),irec(nfmx),itime(nfmx),nld(nvarmx,nfmx)
 
-integer nvar(nfmx),ivar(nfmx)
-logical firsttime(nfmx)
+INTEGER nvar(nfmx),ivar(nfmx)
+LOGICAL firsttime(nfmx)
 
 character*10 var(nvarmx,nfmx),fichier(nfmx)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/infotrac.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/infotrac.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/infotrac.F90	(revision 5117)
@@ -3,6 +3,6 @@
 MODULE infotrac
 
-  USE       strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse
-  USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
+  USE       lmdz_strings, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse
+  USE lmdz_readTracFiles, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
           delPhase, niso, getKey, isot_type, processIsotopes, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
           addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate, iqWIsoPha, nbIso, ntiso, isoName, isoCheck
@@ -176,5 +176,5 @@
     IF (nt > 1) THEN
       IF (nt > 2) CALL abort_gcm(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1)
-      if (nt == 2) type_trac = types_trac(2)
+      IF (nt == 2) type_trac = types_trac(2)
     ENDIF
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/iniconst.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/iniconst.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/iniconst.F90	(revision 5117)
@@ -5,5 +5,5 @@
 
   USE control_mod
-  use IOIPSL
+  USE IOIPSL
   USE comconst_mod, ONLY: im, imp1, jm, jmp1, lllm, lllmm1, lllmp1, &
                           unsim, pi, r, kappa, cpp, dtvr, dtphys
@@ -53,9 +53,9 @@
 
   ! vertical discretization: default behavior depends on planet_type flag
-  if (planet_type=="earth") THEN
+  IF (planet_type=="earth") THEN
      disvert_type=1
   else
      disvert_type=2
-  endif
+  ENDIF
   ! but user can also specify using one or the other in run.def:
   CALL getin('disvert_type',disvert_type)
@@ -65,8 +65,8 @@
   CALL getin('pressure_exner', pressure_exner)
 
-  if (disvert_type==1) THEN
+  IF (disvert_type==1) THEN
      ! standard case for Earth (automatic generation of levels)
      CALL disvert()
-  else if (disvert_type==2) THEN
+  ELSE IF (disvert_type==2) THEN
      ! standard case for planets (levels generated using z2sig.def file)
      CALL disvert_noterre
@@ -74,5 +74,5 @@
      WRITE(abort_message,*) "Wrong value for disvert_type: ", disvert_type
      CALL abort_gcm(modname,abort_message,0)
-  endif
+  ENDIF
 
 END SUBROUTINE iniconst
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inidissip.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inidissip.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inidissip.F90	(revision 5117)
@@ -16,4 +16,5 @@
   USE lmdz_filtreg, ONLY: filtreg
   USE lmdz_libmath, ONLY: minmax
+  USE lmdz_ran1, ONLY: ran1
 
   IMPLICIT NONE
@@ -23,9 +24,9 @@
   include "iniprint.h"
 
-  LOGICAL, INTENT(in) :: lstardis
-  INTEGER, INTENT(in) :: nitergdiv, nitergrot, niterh
-  REAL, INTENT(in) :: tetagdiv, tetagrot, tetatemp
-
-  integer, INTENT(in) :: vert_prof_dissip
+  LOGICAL, INTENT(IN) :: lstardis
+  INTEGER, INTENT(IN) :: nitergdiv, nitergrot, niterh
+  REAL, INTENT(IN) :: tetagdiv, tetagrot, tetatemp
+
+  INTEGER, INTENT(IN) :: vert_prof_dissip
   ! Vertical profile of horizontal dissipation
   ! Allowed values:
@@ -36,5 +37,5 @@
   REAL fact, zvert(llm), zz
   REAL zh(ip1jmp1), zu(ip1jmp1), gx(ip1jmp1), divgra(ip1jmp1)
-  real zv(ip1jm), gy(ip1jm), deltap(ip1jmp1, llm)
+  REAL zv(ip1jm), gy(ip1jm), deltap(ip1jmp1, llm)
   REAL ullm, vllm, umin, vmin, zhmin, zhmax
   REAL zllm
@@ -43,8 +44,5 @@
   REAL tetamin
   REAL pseudoz
-  character (len = 80) :: abort_message
-
-  REAL ran1
-
+  CHARACTER (LEN = 80) :: abort_message
 
   !-----------------------------------------------------------------------
@@ -174,5 +172,5 @@
   !   --------------------------------------------------
 
-  if (vert_prof_dissip == 1) THEN
+  IF (vert_prof_dissip == 1) THEN
     do l = 1, llm
       pseudoz = 8. * log(preff / presnivs(l))
@@ -190,5 +188,5 @@
       zvert(l) = fact - (fact - 1.) / (1. + zz * zz)
     ENDDO
-  endif
+  ENDIF
 
   WRITE(lunout, *)'inidissip: Constantes de temps de la diffusion horizontale'
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inigeom.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inigeom.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inigeom.f90	(revision 5117)
@@ -16,6 +16,6 @@
   !
   !
-  use fxhyp_m, ONLY: fxhyp
-  use fyhyp_m, ONLY: fyhyp
+  USE fxhyp_m, ONLY: fxhyp
+  USE fyhyp_m, ONLY: fyhyp
   USE comconst_mod, ONLY: pi, g, omeg, rad
   USE logic_mod, ONLY: fxyhypb, ysinus
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inigrads.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inigrads.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inigrads.f90	(revision 5117)
@@ -11,6 +11,6 @@
   REAL :: xmin, xmax, ymin, ymax
 
-  CHARACTER(LEN = *), intent(in) :: file
-  CHARACTER(LEN = *), intent(in) :: titlel
+  CHARACTER(LEN = *), INTENT(IN) :: file
+  CHARACTER(LEN = *), INTENT(IN) :: titlel
 
   INCLUDE "gradsdef.h"
@@ -31,5 +31,5 @@
   unit(9) = 46
 
-  if (if<=nf) stop 'verifier les appels a inigrads'
+  IF (if<=nf) stop 'verifier les appels a inigrads'
 
   PRINT*, 'Entree dans inigrads'
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/initdynav.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/initdynav.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/initdynav.F90	(revision 5117)
@@ -5,5 +5,5 @@
   USE IOIPSL
   USE infotrac, ONLY: nqtot
-  use com_io_dyn_mod, ONLY: histaveid,histvaveid,histuaveid, &
+  USE com_io_dyn_mod, ONLY: histaveid,histvaveid,histuaveid, &
        dynhistave_file,dynhistvave_file,dynhistuave_file
   USE comconst_mod, ONLY: pi
@@ -42,17 +42,17 @@
   !   Arguments
 
-  integer day0, anne0
-  real tstep, t_ops, t_wrt
+  INTEGER day0, anne0
+  REAL tstep, t_ops, t_wrt
 
   ! This routine needs IOIPSL to work
   !   Variables locales
 
-  integer tau0
-  real zjulian
-  integer iq
-  real rlong(iip1,jjp1), rlat(iip1,jjp1)
-  integer uhoriid, vhoriid, thoriid, zvertiid
-  integer ii,jj
-  integer zan, dayref
+  INTEGER tau0
+  REAL zjulian
+  INTEGER iq
+  REAL rlong(iip1,jjp1), rlat(iip1,jjp1)
+  INTEGER uhoriid, vhoriid, thoriid, zvertiid
+  INTEGER ii,jj
+  INTEGER zan, dayref
 
   !--------------------------------------------------------------------
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/initfluxsto.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/initfluxsto.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/initfluxsto.f90	(revision 5117)
@@ -64,5 +64,5 @@
   INTEGER :: ii, jj
   INTEGER :: zan, idayref
-  logical :: ok_sync
+  LOGICAL :: ok_sync
   !
   !  Initialisations
@@ -211,9 +211,9 @@
   CALL histend(filevid)
   CALL histend(filedid)
-  if (ok_sync) THEN
+  IF (ok_sync) THEN
     CALL histsync(fileid)
     CALL histsync(filevid)
     CALL histsync(filedid)
-  endif
+  ENDIF
 
   RETURN
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inter_barxy_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inter_barxy_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inter_barxy_m.F90	(revision 5117)
@@ -14,6 +14,6 @@
   SUBROUTINE inter_barxy(dlonid, dlatid, champ, rlonimod, rlatimod, champint)
 
-    use lmdz_assert_eq, ONLY: assert_eq
-    use lmdz_assert, ONLY: assert
+    USE lmdz_assert_eq, ONLY: assert_eq
+    USE lmdz_assert, ONLY: assert
 
     include "dimensions.h"
@@ -26,13 +26,13 @@
     ! (for "aire", "apoln", "apols")
 
-    REAL, intent(in) :: dlonid(:)
+    REAL, INTENT(IN) :: dlonid(:)
     ! (longitude from input file, in rad, from -pi to pi)
 
-    REAL, intent(in) :: dlatid(:), champ(:, :), rlonimod(:)
-
-    REAL, intent(in) :: rlatimod(:)
+    REAL, INTENT(IN) :: dlatid(:), champ(:, :), rlonimod(:)
+
+    REAL, INTENT(IN) :: rlatimod(:)
     ! (latitude angle, in degrees or rad, in strictly decreasing order)
 
-    real, intent(out) :: champint(:, :)
+    REAL, INTENT(OUT) :: champint(:, :)
     ! Si taille de la seconde dim = jjm + 1, on veut interpoler sur les
     ! jjm+1 latitudes rlatu du modele (latitudes des scalaires et de U)
@@ -43,5 +43,5 @@
 
     REAL champy(iim, size(champ, 2))
-    integer j, i, jnterfd, jmods
+    INTEGER j, i, jnterfd, jmods
 
     REAL yjmod(size(champint, 2))
@@ -78,5 +78,5 @@
     ENDIF
 
-    if (jmods == jjm + 1) yjmod(jjm + 1) = 90.
+    IF (jmods == jjm + 1) yjmod(jjm + 1) = 90.
 
     DO j = 1, jnterfd + 1
@@ -121,9 +121,9 @@
     IMPLICIT NONE
 
-    REAL, intent(in) :: dlonid(:)
-    real, intent(in) :: fdat(:)
-    real, intent(in) :: rlonimod(:)
-
-    real inter_barx(size(rlonimod))
+    REAL, INTENT(IN) :: dlonid(:)
+    REAL, INTENT(IN) :: fdat(:)
+    REAL, INTENT(IN) :: rlonimod(:)
+
+    REAL inter_barx(size(rlonimod))
 
     !    ...  Variables locales ... 
@@ -184,5 +184,5 @@
 
     i = 2
-    DO while (xxd(i) >= xxd(i - 1) .and. i < idatmax)
+    DO while (xxd(i) >= xxd(i - 1) .AND. i < idatmax)
       i = i + 1
     ENDDO
@@ -299,15 +299,15 @@
     ! L'indice 1 correspond à l'interface maille 1 -- maille 2.
 
-    use lmdz_assert, ONLY: assert
+    USE lmdz_assert, ONLY: assert
 
     IMPLICIT NONE
 
-    REAL, intent(in) :: yjdat(:)
+    REAL, INTENT(IN) :: yjdat(:)
     ! (angles, ordonnées des interfaces des mailles des données, in
     ! degrees, in increasing order)
 
-    REAL, intent(in) :: fdat(:) ! champ de données
-
-    REAL, intent(in) :: yjmod(:)
+    REAL, INTENT(IN) :: fdat(:) ! champ de données
+
+    REAL, INTENT(IN) :: yjmod(:)
     ! (ordonnées des interfaces des mailles du modèle)
     ! (in degrees, in strictly increasing order)
@@ -319,5 +319,5 @@
     REAL y0, dy, dym
     INTEGER jdat ! indice du champ de données
-    integer jmod ! indice du champ du modèle
+    INTEGER jmod ! indice du champ du modèle
 
     !------------------------------------
@@ -373,10 +373,10 @@
     ! Finally, the procedure adds 90° as the last value of the array.
 
-    use lmdz_assert_eq, ONLY: assert_eq
-    use comconst_mod, ONLY: pi
+    USE lmdz_assert_eq, ONLY: assert_eq
+    USE comconst_mod, ONLY: pi
 
     IMPLICIT NONE
 
-    REAL, intent(in) :: xi(:)
+    REAL, INTENT(IN) :: xi(:)
     ! (latitude, in degrees or radians, in increasing or decreasing order)
     ! ("xi" should contain latitudes from pole to pole.
@@ -385,6 +385,6 @@
     ! So the extreme values should not be 90° and -90°.)
 
-    REAL, intent(out) :: xo(:) ! angles in degrees
-    LOGICAL, intent(out) :: decrois
+    REAL, INTENT(OUT) :: xo(:) ! angles in degrees
+    LOGICAL, INTENT(OUT) :: decrois
 
     ! Variables  local to the procedure:
@@ -410,5 +410,5 @@
     end IF
 
-    IF (ABS(abs(xo(1)) - 90) < 0.001 .or. ABS(abs(xo(nmax)) - 90) < 0.001) THEN
+    IF (ABS(abs(xo(1)) - 90) < 0.001 .OR. ABS(abs(xo(nmax)) - 90) < 0.001) THEN
       print *, "ord_coord"
       PRINT *, '"xi" should contain the latitudes of the boundaries of ' &
@@ -429,9 +429,9 @@
     ! order.
 
-    use comconst_mod, ONLY: pi
+    USE comconst_mod, ONLY: pi
 
     IMPLICIT NONE
 
-    REAL, intent(in) :: xi(:) ! angle, in rad or degrees
+    REAL, INTENT(IN) :: xi(:) ! angle, in rad or degrees
     REAL ord_coordm(size(xi)) ! angle, in degrees
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/invert_zoom_x_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/invert_zoom_x_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/invert_zoom_x_m.F90	(revision 5117)
@@ -9,15 +9,15 @@
   SUBROUTINE invert_zoom_x(xf, xtild, Xprimt, xlon, xprimm, xuv)
 
-    use lmdz_coefpoly, ONLY: coefpoly
-    use nrtype, ONLY: pi, pi_d, twopi_d, k8
-    use serre_mod, ONLY: clon
+    USE lmdz_coefpoly, ONLY: coefpoly
+    USE lmdz_physical_constants, ONLY: pi, pi_d, twopi_d, k8
+    USE serre_mod, ONLY: clon
 
     include "dimensions.h"
     ! for iim
 
-    REAL(K8), intent(in):: Xf(0:), xtild(0:), Xprimt(0:) ! (0:2 * nmax)
-    real, intent(out):: xlon(:), xprimm(:) ! (iim)
+    REAL(K8), INTENT(IN):: Xf(0:), xtild(0:), Xprimt(0:) ! (0:2 * nmax)
+    REAL, INTENT(OUT):: xlon(:), xprimm(:) ! (iim)
 
-    REAL(K8), intent(in):: xuv
+    REAL(K8), INTENT(IN):: xuv
     ! 0. si calcul aux points scalaires 
     ! 0.5 si calcul aux points U 
@@ -25,5 +25,5 @@
     ! Local:
     REAL(K8) xo1, Xfi, a0, a1, a2, a3, Xf1, Xprimin
-    integer i, it, iter
+    INTEGER i, it, iter
     REAL(K8), parameter:: my_eps = 1e-6_k8
 
@@ -37,5 +37,5 @@
 
        it = 2 * nmax
-       do while (xfi < xf(it) .and. it >= 1)
+       do while (xfi < xf(it) .AND. it >= 1)
           it = it - 1
        END DO
@@ -56,7 +56,7 @@
        iter = 1
 
-       do
+       DO
           xvrai(i) = xvrai(i) - (Xf1 - Xfi) / Xprimin
-          IF (ABS(xvrai(i) - xo1) <= my_eps .or. iter == 300) exit
+          IF (ABS(xvrai(i) - xo1) <= my_eps .OR. iter == 300) exit
           xo1 = xvrai(i)
           Xf1 = a0 + xvrai(i) * (a1 + xvrai(i) * (a2 + xvrai(i) * a3))
@@ -64,5 +64,5 @@
        end DO
 
-       if (ABS(xvrai(i) - xo1) > my_eps) THEN
+       IF (ABS(xvrai(i) - xo1) > my_eps) THEN
           ! iter == 300
           print *, 'Pas de solution.'
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/iso_verif_dyn.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/iso_verif_dyn.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/iso_verif_dyn.f90	(revision 5117)
@@ -13,5 +13,5 @@
     INTEGER :: iso_verif_noNaN_nostop
 
-    if ((x>-borne).and.(x<borne)) THEN
+    IF ((x>-borne).AND.(x<borne)) THEN
             iso_verif_noNAN_nostop=0
     else
@@ -47,6 +47,6 @@
     iso_verif_egalite_nostop=0
 
-    if (abs(a-b)>errmax) THEN
-      if (abs((a-b)/max(max(abs(b),abs(a)),1e-18)) &
+    IF (abs(a-b)>errmax) THEN
+      IF (abs((a-b)/max(max(abs(b),abs(a)),1e-18)) &
             >errmaxrel) THEN
         WRITE(*,*) 'erreur detectee par iso_verif_egalite:'
@@ -84,5 +84,5 @@
 
     ! verifier que HDO est raisonable
-     if (q>qmin) THEN
+     IF (q>qmin) THEN
          IF(getKey('tnat', tnat, isoName(iso))) THEN
               err_msg = 'Missing isotopic parameter "tnat"'
@@ -91,5 +91,5 @@
          END IF
          deltaD=(x/q/tnat-1)*1000
-         if ((deltaD>deltaDmax).or.(deltaD<deltaDmin)) THEN
+         IF ((deltaD>deltaDmax).OR.(deltaD<deltaDmin)) THEN
               WRITE(*,*) 'erreur detectee par iso_verif_aberrant:'
               WRITE(*,*) err_msg
@@ -98,5 +98,5 @@
               WRITE(*,*) 'iso=',iso
               iso_verif_aberrant_nostop=1
-         endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) THEN
+         endif !if ((deltaD.gt.deltaDmax).OR.(deltaD.lt.deltaDmin)) THEN
       endif !if (q(i,k,iq).gt.qmin) THEN
     RETURN
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limx.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limx.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limx.f90	(revision 5117)
@@ -85,5 +85,5 @@
      do ij=iip2+1,ip1jm
         IF(     dxqu(ij-1)*dxqu(ij)>0. &
-              .and. dxq(ij,l)*dxqu(ij)>0.) THEN
+              .AND. dxq(ij,l)*dxqu(ij)>0.) THEN
           dxq(ij,l)= &
                 sign(min(abs(dxq(ij,l)),dxqmax(ij)),dxq(ij,l))
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limy.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limy.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limy.f90	(revision 5117)
@@ -67,5 +67,5 @@
      sinlon(1)=sinlon(iip1)
      sinlondlon(1)=sinlondlon(iip1)
-  endif
+  ENDIF
 
   !
@@ -158,5 +158,5 @@
         dyqmax(ij)=pente_max*abs(dyqv(ij))
      enddo
-  endif
+  ENDIF
 
   IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)* &
@@ -170,5 +170,5 @@
         dyqmax(ij)=pente_max*abs(dyqv(ij-iip1))
      enddo
-  endif
+  ENDIF
 
   !   calcul des pentes limitees
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limz.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limz.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limz.f90	(revision 5117)
@@ -78,5 +78,5 @@
      do l=2,llm-1
         IF(     dzqw(l-1)*dzqw(l)>0. &
-              .and. dzq(ij,l)*dzqw(l)>0.) THEN
+              .AND. dzq(ij,l)*dzqw(l)>0.) THEN
           dzq(ij,l)= &
                 sign(min(abs(dzq(ij,l)),dzqmax(l)),dzq(ij,l))
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/misc_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/misc_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/misc_mod.F90	(revision 5117)
@@ -1,6 +1,6 @@
 module misc_mod
-  integer,save :: itaumax
+  INTEGER,save :: itaumax
   logical,save :: adjust
-  integer,save :: ItCount
+  INTEGER,save :: ItCount
   logical,save :: debug
 end module misc_mod 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/pentes_ini.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/pentes_ini.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/pentes_ini.f90	(revision 5117)
@@ -58,5 +58,5 @@
   INTEGER :: ismax,ismin,lati,latf
   EXTERNAL  SSUM, ismin,ismax
-  logical :: first
+  LOGICAL :: first
   save first
   !   fin modif
@@ -72,7 +72,7 @@
   limit = .TRUE.
   pente_max=2
-  ! if (mode.eq.1.or.mode.eq.3) THEN
-  ! if (mode.eq.1) THEN
-  if (mode>=1) THEN
+  ! if (mode.EQ.1.OR.mode.EQ.3) THEN
+  ! if (mode.EQ.1) THEN
+  IF (mode>=1) THEN
     lati=2
     latf=jjm
@@ -80,5 +80,5 @@
     lati=1
     latf=jjp1
-  endif
+  ENDIF
 
   qmin=0.4995
@@ -110,5 +110,5 @@
     ENDDO
 
-  endif
+  ENDIF
   !   Fin modif Fred
 
@@ -245,7 +245,7 @@
         sx(1,jjp1,l)=sx(iip1,jjp1,l)
       enddo
-  endif
-
-  if (mode==4) THEN
+  ENDIF
+
+  IF (mode==4) THEN
      do l=1,llm
         do i=1,iip1
@@ -256,10 +256,10 @@
         enddo
      enddo
-  endif
+  ENDIF
   CALL limx(s0,sx,sm,pente_max)
   ! CALL minmaxq(zq,1.e33,-1.e33,'avant advx     ')
    CALL advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf)
   ! CALL minmaxq(zq,1.e33,-1.e33,'avant advy     ')
-  if (mode==4) THEN
+  IF (mode==4) THEN
      do l=1,llm
         do i=1,iip1
@@ -270,5 +270,5 @@
         enddo
      enddo
-  endif
+  ENDIF
    CALL   limy(s0,sy,sm,pente_max)
    CALL advy( limit,.5*dtvr,pbarv,sm,s0,sx,sy,sz )
@@ -282,5 +282,5 @@
    CALL limz(s0,sz,sm,pente_max)
    CALL advz( limit,dtvr,w,sm,s0,sx,sy,sz )
-  if (mode==4) THEN
+  IF (mode==4) THEN
      do l=1,llm
         do i=1,iip1
@@ -291,5 +291,5 @@
         enddo
      enddo
-  endif
+  ENDIF
     CALL limy(s0,sy,sm,pente_max)
    CALL advy( limit,.5*dtvr,pbarv,sm,s0,sx,sy,sz )
@@ -306,5 +306,5 @@
 
   ! CALL minmaxq(zq,1.e33,-1.e33,'avant advx     ')
-  if (mode==4) THEN
+  IF (mode==4) THEN
      do l=1,llm
         do i=1,iip1
@@ -315,5 +315,5 @@
         enddo
      enddo
-  endif
+  ENDIF
    CALL limx(s0,sx,sm,pente_max)
    CALL advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/ppm3d.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/ppm3d.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/ppm3d.f90	(revision 5117)
@@ -269,5 +269,5 @@
   ! User modifiable parameters
   !
-  integer,parameter :: Jmax = 361, kmax = 150
+  INTEGER,parameter :: Jmax = 361, kmax = 150
   !
   ! ****6***0*********0*********0*********0*********0*********0**********72
@@ -282,5 +282,5 @@
   INTEGER :: IMRD2
   REAL :: PT
-  logical :: cross, fill, dum
+  LOGICAL :: cross, fill, dum
   !
   ! Local dynamic arrays
@@ -327,20 +327,20 @@
     WRITE(6,*) 'NLAY must be >= 6'
     stop
-  endif
-  if (JNP<NLAY) THEN
+  ENDIF
+  IF (JNP<NLAY) THEN
      WRITE(6,*) 'JNP must be >= NLAY'
     stop
-  endif
+  ENDIF
   IMRD2=mod(IMR,2)
-  if (j1==2.and.IMRD2/=0) THEN
+  IF (j1==2.AND.IMRD2/=0) THEN
      WRITE(6,*) 'if j1=2 IMR must be an even integer'
     stop
-  endif
-
-  !
-  IF(Jmax<JNP .or. Kmax<NLAY) THEN
+  ENDIF
+
+  !
+  IF(Jmax<JNP .OR. Kmax<NLAY) THEN
     WRITE(6,*) 'Jmax or Kmax is too small'
     stop
-  endif
+  ENDIF
   !
   DO k=1,NLAY
@@ -359,5 +359,5 @@
   ! Define cosine consistent with GEOS-GCM (using dycore2.0 or later)
         CALL cosc(cosp,cose,JNP,PI,DP)
-  endif
+  ENDIF
   !
   do J=2,JMR
@@ -370,5 +370,5 @@
   acosp(1)   = RCAP
   acosp(JNP) = RCAP
-  endif
+  ENDIF
   !
   IF(NDT0 /= NDT) THEN
@@ -384,5 +384,5 @@
   IF(MaxDT < abs(NDT)) THEN
         WRITE(6,*) 'Warning!!! NDT maybe too large!'
-  endif
+  ENDIF
   !
   IF(CR1>=0.95) THEN
@@ -398,5 +398,5 @@
   IML = min(6*JS0/(J1-1)+2, 4*IMR/5)
   JN0 = JNP-JS0+1
-  endif
+  ENDIF
   !
   !
@@ -414,5 +414,5 @@
   !
   !  WRITE(6,*) 'J1=',J1,' J2=', J2
-  endif
+  ENDIF
   !
   ! *********** End Initialization **********************
@@ -438,5 +438,5 @@
   END DO
   END DO
-  endif
+  ENDIF
   !
   ! Compute "tracer density"
@@ -472,5 +472,5 @@
   CRY(i,2) = DTDY*V(i,1,k)
   END DO
-  endif
+  ENDIF
   !
   ! Determine JS and JN
@@ -483,5 +483,5 @@
         JS = j
         go to 2222
-  endif
+  ENDIF
   enddo
   enddo
@@ -493,5 +493,5 @@
         JN = j
         go to 2233
-  endif
+  ENDIF
   enddo
   enddo
@@ -503,5 +503,5 @@
   DPI(i,JMR,k) = 0.
   enddo
-  endif
+  ENDIF
   !
   ! ******* Compute horizontal mass fluxes ************
@@ -596,5 +596,5 @@
   VA(IMR,1)=VA(1,1)
   VA(IMR,JNP)=VA(1,JNP)
-  endif
+  ENDIF
   !
   ! ****6***0*********0*********0*********0*********0*********0**********72
@@ -608,5 +608,5 @@
   ! E-W advective cross term
   do j=J1,J2
-  IF(J>JS  .and. J<JN) GO TO 250
+  IF(J>JS  .AND. J<JN) GO TO 250
   !
   do i=1,IMR
@@ -627,5 +627,5 @@
   else
   wk1(i,j,1) = qtmp(iiu)+ru*(qtmp(iiu)-qtmp(iiu+1))
-  endif
+  ENDIF
   wk1(i,j,1) = wk1(i,j,1) - qtmp(i)
   END DO
@@ -648,5 +648,5 @@
   enddo
   enddo
-  endif
+  ENDIF
   ! ****6***0*********0*********0*********0*********0*********0**********72
   ! Contribution from the N-S advection
@@ -681,5 +681,5 @@
   enddo
   enddo
-  endif
+  ENDIF
   !
   CALL xtp(IMR,JNP,IML,j1,j2,JN,JS,PU,DQ(1,1,k,IC),wk1(1,1,2) &
@@ -773,5 +773,5 @@
   END DO
   END DO
-  endif
+  ENDIF
   END DO
   !
@@ -783,5 +783,5 @@
   END DO
   END DO
-  endif
+  ENDIF
   !
   RETURN
@@ -792,6 +792,6 @@
         flux,wk1,wk2,wz2,delp,KORD)
   IMPLICIT NONE
-  integer,parameter :: kmax = 150
-  real,parameter :: R23 = 2./3., R3 = 1./3.
+  INTEGER,parameter :: kmax = 150
+  REAL,parameter :: R23 = 2./3., R3 = 1./3.
   INTEGER :: IMR,JNP,NLAY,J1,KORD
   REAL :: WZ(IMR,JNP,NLAY),P(IMR,JNP,NLAY),DC(IMR,JNP,NLAY), &
@@ -838,5 +838,5 @@
   !
   DO j=1,JNP
-  if((j==2 .or. j==JMR) .and. j1/=2) goto 2000
+  IF((j==2 .OR. j==JMR) .AND. j1/=2) goto 2000
   !
   DO k=1,NLAY
@@ -942,5 +942,5 @@
     flux(i,2) = AL(i,2)+0.5*CP*(AL(i,2)-AR(i,2)-A6(i,2)*(1.+R23*CP))
      ! print *,'test2',i, AL(i,2),AR(i,2),A6(i,2),R23
-  endif
+  ENDIF
   END DO
   !
@@ -990,5 +990,5 @@
   enddo
   !
-  IF(j>=JN .or. j<=JS) goto 2222
+  IF(j>=JN .OR. j<=JS) goto 2222
   ! ************* Eulerian **********
   !
@@ -998,5 +998,5 @@
   qtmp(IMP+1) = q(2,J)
   !
-  IF(IORD==1 .or. j==j1 .or. j==j2) THEN
+  IF(IORD==1 .OR. j==j1 .OR. j==j2) THEN
   DO i=1,IMR
   iu = REAL(i) - uc(i,j)
@@ -1007,5 +1007,5 @@
   DC(0) = DC(IMR)
   !
-  IF(IORD==2 .or. j<=j1vl .or. j>=j2vl) THEN
+  IF(IORD==2 .OR. j<=j1vl .OR. j>=j2vl) THEN
   DO i=1,IMR
   iu = REAL(i) - uc(i,j)
@@ -1014,5 +1014,5 @@
   else
   CALL fxppm(IMR,IML,UC(1,j),Qtmp,DC,fx1,IORD)
-  endif
+  ENDIF
   !
   ENDIF
@@ -1033,5 +1033,5 @@
   enddo
   !
-  IF(IORD==1 .or. j==j1 .or. j==j2) THEN
+  IF(IORD==1 .OR. j==j1 .OR. j==j2) THEN
   DO i=1,IMR
   itmp = INT(uc(i,j))
@@ -1068,5 +1068,5 @@
     enddo
   !DIR$ VECTOR
-  endif
+  ENDIF
   END DO
   do i=1,IMR
@@ -1091,9 +1091,9 @@
   INTEGER :: IMR,IML,IORD
   REAL :: UT,P,DC,flux
-  real,parameter ::  R3 = 1./3., R23 = 2./3.
+  REAL,parameter ::  R3 = 1./3., R23 = 2./3.
   DIMENSION UT(*),flux(*),P(-IML:IMR+IML+1),DC(-IML:IMR+IML+1)
   REAL :: AR(0:IMR),AL(0:IMR),A6(0:IMR)
   INTEGER :: LMT,IMP,JLVL,i
-   ! logical first
+   ! LOGICAL first
    ! data first /.TRUE./
    ! SAVE LMT
@@ -1112,10 +1112,10 @@
   !  else
   !        LMT = IORD - 3
-  !  endif
+  !  ENDIF
   !
   LMT = IORD - 3
    ! WRITE(6,*) 'PPM option in E-W direction = ', LMT
    ! first = .FALSE.
-   ! endif
+   ! END IF
   !
   DO i=1,IMR
@@ -1145,5 +1145,5 @@
   flux(i) = AL(i) - 0.5*UT(i)*(AR(i) - AL(i) + &
         A6(i)*(1.+R23*UT(i)))
-  endif
+  ENDIF
   enddo
   RETURN
@@ -1153,5 +1153,5 @@
   IMPLICIT NONE
   INTEGER :: IMR,IML
-  real,parameter :: R24 = 1./24.
+  REAL,parameter :: R24 = 1./24.
   REAL :: P(-IML:IMR+1+IML),DC(-IML:IMR+1+IML)
   INTEGER :: i
@@ -1191,5 +1191,5 @@
   CALL ymist(IMR,JNP,j1,P,DC2,4)
   !
-  IF(JORD<=0 .or. JORD>=3) THEN
+  IF(JORD<=0 .OR. JORD>=3) THEN
   CALL fyppm(VC,P,DC2,fx,IMR,JNP,j1,j2,A6,AR,AL,JORD)
 
@@ -1199,6 +1199,6 @@
   fx(i,j1) = p(i,JT) + (sign(1.,VC(i,j1))-VC(i,j1))*DC2(i,JT)
   END DO
-  endif
-  endif
+  ENDIF
+  ENDIF
   !
   DO i=1,len
@@ -1232,5 +1232,5 @@
   DQ(i,JMR) = sum2
   enddo
-  endif
+  ENDIF
   !
   RETURN
@@ -1240,5 +1240,5 @@
   IMPLICIT NONE
   INTEGER :: IMR,JNP,j1,ID
-  real,parameter :: R24 = 1./24.
+  REAL,parameter :: R24 = 1./24.
   REAL :: P(IMR,JNP),DC(IMR,JNP)
   INTEGER :: iimh,jmr,ijm3,imh,i
@@ -1315,5 +1315,5 @@
   DC(i,JNP) =  - DC(i-imh,JNP)
   END DO
-  endif
+  ENDIF
   RETURN
 END SUBROUTINE ymist
@@ -1322,5 +1322,5 @@
   IMPLICIT NONE
   INTEGER :: IMR,JNP,j1,j2,JORD
-  real,parameter :: R3 = 1./3., R23 = 2./3.
+  REAL,parameter :: R3 = 1./3., R23 = 2./3.
   REAL :: VC(IMR,*),flux(IMR,*),P(IMR,*),DC(IMR,*)
   ! Local work arrays.
@@ -1328,5 +1328,5 @@
   INTEGER :: LMT,i
   INTEGER :: IMH,JMR,j11,IMJM1,len
-   ! logical first
+   ! LOGICAL first
    ! data first /.TRUE./
    ! SAVE LMT
@@ -1348,8 +1348,8 @@
    ! else
    !       LMT = JORD - 3
-   ! endif
+   ! END IF
   !
   !  first = .FALSE.
-  !  endif
+  !  ENDIF
   !
   ! modifs pour pouvoir choisir plusieurs schemas PPM
@@ -1394,5 +1394,5 @@
   flux(i,j1) = AL(i,j1) - 0.5*VC(i,j1)*(AR(i,j1) - AL(i,j1) + &
         A6(i,j1)*(1.+R23*VC(i,j1)))
-  endif
+  ENDIF
   END DO
   RETURN
@@ -1498,5 +1498,5 @@
     JMR = JNP-1
   do j=j1,j2
-  IF(J>JS  .and. J<JN) GO TO 1309
+  IF(J>JS  .AND. J<JN) GO TO 1309
   !
   do i=1,IMR
@@ -1527,5 +1527,5 @@
   else
   adx(i,j) = qtmp(iiu)+ru*(qtmp(iiu)-qtmp(iiu+1))
-  endif
+  ENDIF
   enddo
   ENDIF
@@ -1598,5 +1598,5 @@
   ! LMT = 2: POSITIVE-DEFINITE CONSTRAINT
   !
-  real,parameter :: R12 = 1./12.
+  REAL,parameter :: R12 = 1./12.
   REAL :: A6(IM),AR(IM),AL(IM),P(IM),DC(IM)
   INTEGER :: IM,LMT
@@ -1621,6 +1621,6 @@
         A6(i) = 3.*(AR(i)-p(i))
         AL(i) = AR(i) - A6(i)
-  endif
-  endif
+  ENDIF
+  ENDIF
   END DO
   elseif(LMT==1) THEN
@@ -1628,5 +1628,5 @@
   do i=1,IM
   IF(abs(AR(i)-AL(i)) >= -A6(i)) go to 150
-  IF(p(i)<AR(i) .and. p(i)<AL(i)) THEN
+  IF(p(i)<AR(i) .AND. p(i)<AL(i)) THEN
         AR(i) = p(i)
         AL(i) = p(i)
@@ -1638,5 +1638,5 @@
         A6(i) = 3.*(AR(i)-p(i))
         AL(i) = AR(i) - A6(i)
-  endif
+  ENDIF
 150   continue
   END DO
@@ -1646,5 +1646,5 @@
   fmin = p(i) + 0.25*(AR(i)-AL(i))**2/A6(i) + A6(i)*R12
   IF(fmin>=0.) go to 250
-  IF(p(i)<AR(i) .and. p(i)<AL(i)) THEN
+  IF(p(i)<AR(i) .AND. p(i)<AL(i)) THEN
         AR(i) = p(i)
         AL(i) = p(i)
@@ -1656,8 +1656,8 @@
         A6(i) = 3.*(AR(i)-p(i))
         AL(i) = AR(i) - A6(i)
-  endif
+  ENDIF
 250   continue
   END DO
-  endif
+  ENDIF
   RETURN
 END SUBROUTINE lmtppm
@@ -1708,5 +1708,5 @@
    cose(j) =  cose(JNP+2-j)
    enddo
-  endif
+  ENDIF
   !
   do j=2,JMR
@@ -1746,8 +1746,8 @@
         cross,IC,NSTEP)
   !
-  real,parameter :: tiny = 1.E-60
+  REAL,parameter :: tiny = 1.E-60
   INTEGER :: IMR,JNP,NLAY,j1,j2,IC,NSTEP
   REAL :: Q(IMR,JNP,NLAY),qtmp(IMR,JNP),cosp(*),acosp(*)
-  logical :: cross
+  LOGICAL :: cross
   INTEGER :: NLAYM1,len,ip,L,icr,ipy,ipx,i
   REAL :: qup,qly,dup,sum
@@ -1767,5 +1767,5 @@
   IF(cross) THEN
   CALL filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
-  endif
+  ENDIF
   IF(icr==0) goto 50
   !
@@ -1776,5 +1776,5 @@
       Q(i,j1,2) = Q(i,j1,2) + Q(i,j1,1)
       Q(i,j1,1) = 0.
-  endif
+  ENDIF
   enddo
   !
@@ -1789,5 +1789,5 @@
   IF(cross) THEN
   CALL filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
-  endif
+  ENDIF
   IF(icr==0) goto 225
   !
@@ -1843,9 +1843,9 @@
   WRITE(6,*) 'IC=',IC,' STEP=',NSTEP, &
         ' Vertical filling pts=',ip
-  endif
+  ENDIF
   !
   IF(sum>1.e-25) THEN
   WRITE(6,*) IC,NSTEP,' Mass source from the ground=',sum
-  endif
+  ENDIF
   RETURN
 END SUBROUTINE qckxyz
@@ -1875,7 +1875,7 @@
   q(i+1,j-1) = (ds - d2)*acosp(j-1)
   q(i,j) = (d2 - dq)*acosp(j) + tiny
-  endif
-  END DO
-  IF(icr==0 .and. q(IMR,j)>=0.) goto 65
+  ENDIF
+  END DO
+  IF(icr==0 .AND. q(IMR,j)>=0.) goto 65
   DO i=2,IMR
   IF(q(i,j)<0.) THEN
@@ -1894,5 +1894,5 @@
   q(i-1,j-1) = (ds - d2)*acosp(j-1)
   q(i,j) = (d2 - dq)*acosp(j) + tiny
-  endif
+  ENDIF
   END DO
   ! *****************************************
@@ -1914,5 +1914,5 @@
   q(IMR,j-1) = (ds - d2)*acosp(j-1)
   q(i,j) = (d2 - dq)*acosp(j) + tiny
-  endif
+  ENDIF
   ! *****************************************
   ! i=IMR
@@ -1933,5 +1933,5 @@
   q(1,j-1) = (ds - d2)*acosp(j-1)
   q(i,j) = (d2 - dq)*acosp(j) + tiny
-  endif
+  ENDIF
   ! *****************************************
 65   continue
@@ -1939,15 +1939,15 @@
   !
   do i=1,IMR
-  IF(q(i,j1)<0. .or. q(i,j2)<0.) THEN
+  IF(q(i,j1)<0. .OR. q(i,j2)<0.) THEN
   icr = 1
   goto 80
-  endif
+  ENDIF
   enddo
   !
 80   continue
   !
-  IF(q(1,1)<0. .or. q(1,jnp)<0.) THEN
+  IF(q(1,1)<0. .OR. q(1,jnp)<0.) THEN
   icr = 1
-  endif
+  ENDIF
   !
   RETURN
@@ -1960,5 +1960,5 @@
   REAL :: DP,CAP1,dq,dn,d0,d1,ds,d2
   INTEGER :: i,j
-   ! logical first
+   ! LOGICAL first
    ! data first /.TRUE./
    ! save cap1
@@ -1968,5 +1968,5 @@
   CAP1 = IMR*(1.-COS((j1-1.5)*DP))/DP
    ! first = .FALSE.
-   ! endif
+   ! END IF
   !
   ipy = 0
@@ -1988,5 +1988,5 @@
   q(i,j-1) = (ds - d2)*acosp(j-1)
   q(i,j) = (d2 - dq)*acosp(j) + tiny
-  endif
+  ENDIF
   END DO
   END DO
@@ -2002,5 +2002,5 @@
   q(i,j1+1) = (dn - d1)*acosp(j1+1)
   q(i,j1) = (d1 - dq)*acosp(j1) + tiny
-  endif
+  ENDIF
   enddo
   !
@@ -2016,5 +2016,5 @@
   q(i,j-1) = (ds - d2)*acosp(j-1)
   q(i,j) = (d2 - dq)*acosp(j) + tiny
-  endif
+  ENDIF
   enddo
   !
@@ -2027,5 +2027,5 @@
   IF(q(i,j1)<0.) ipy = 1
   enddo
-  endif
+  ENDIF
   !
   IF(q(1,JNP)<0.) THEN
@@ -2036,5 +2036,5 @@
   IF(q(i,j2)<0.) ipy = 1
   enddo
-  endif
+  ENDIF
   !
   RETURN
@@ -2070,5 +2070,5 @@
   qtmp(j,i+1) = qtmp(j,i+1) - d2
   qtmp(j,i) = qtmp(j,i) + d2 + tiny
-  endif
+  ENDIF
   END DO
   END DO
@@ -2089,5 +2089,5 @@
   !
   qtmp(j,i) = qtmp(j,i) + d2 + tiny
-  endif
+  ENDIF
   END DO
   i=IMR
@@ -2106,5 +2106,5 @@
   !
   qtmp(j,i) = qtmp(j,i) + d2 + tiny
-  endif
+  ENDIF
   END DO
   !
@@ -2118,6 +2118,6 @@
   !
   ! Poles.
-  IF(q(1,1)<0 .or. q(1,JNP)<0.) ipx = 1
-  endif
+  IF(q(1,1)<0 .OR. q(1,JNP)<0.) ipx = 1
+  ENDIF
   RETURN
 END SUBROUTINE filew
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/prather.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/prather.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/prather.f90	(revision 5117)
@@ -62,5 +62,5 @@
   INTEGER :: ismax,ismin
   EXTERNAL  SSUM, ismin,ismax
-  logical :: first
+  LOGICAL :: first
   save first
   EXTERNAL advxp,advyp,advzp
@@ -109,5 +109,5 @@
     ENDDO
     ENDDO
-  endif
+  ENDIF
   !   Fin modif Fred
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/principal_cshift_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/principal_cshift_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/principal_cshift_m.F90	(revision 5117)
@@ -11,16 +11,16 @@
     ! xprimm.
 
-    use nrtype, ONLY: twopi
-    use serre_mod, ONLY: clon
+    USE lmdz_physical_constants, ONLY: twopi
+    USE serre_mod, ONLY: clon
 
     include "dimensions.h"
     ! for iim
 
-    integer, intent(in):: is2
-    real, intent(inout):: xlon(:), xprimm(:) ! (iim + 1)
+    INTEGER, INTENT(IN):: is2
+    REAL, INTENT(INOUT):: xlon(:), xprimm(:) ! (iim + 1)
 
     !-----------------------------------------------------
 
-    if (is2 /= 0) THEN
+    IF (is2 /= 0) THEN
        IF (clon <= 0.) THEN
           IF (is2 /= 1) THEN
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/sortvarc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/sortvarc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/sortvarc.f90	(revision 5117)
@@ -70,6 +70,6 @@
   ! Ehouarn: when no initialization fields from file, resetvarc should be
        ! set to false
-   if (firstcal) THEN
-     if (.not.read_start) THEN
+   IF (firstcal) THEN
+     IF (.NOT.read_start) THEN
        resetvarc=.TRUE.
      endif
@@ -147,5 +147,5 @@
   ang   = SSUM(     llm,  angl, 1 )
 
-  IF (firstcal.and.resetvarc) THEN
+  IF (firstcal.AND.resetvarc) THEN
      WRITE(lunout,3500) itau, rjour, heure, time
      WRITE(lunout,*) trim(modname), &
@@ -162,30 +162,30 @@
   ! compute relative changes in etot,... (except if 'reference' values
   ! are zero, which can happen when using iniacademic)
-  if (etot0/=0) THEN
+  IF (etot0/=0) THEN
     etot= etot/etot0
   else
     etot=1.
-  endif
+  ENDIF
   rmsv= SQRT(rmsv/ptot)
-  if (ptot0/=0) THEN
+  IF (ptot0/=0) THEN
     ptot= ptot/ptot0
   else
     ptot=1.
-  endif
-  if (ztot0/=0) THEN
+  ENDIF
+  IF (ztot0/=0) THEN
     ztot= ztot/ztot0
   else
     ztot=1.
-  endif
-  if (stot0/=0) THEN
+  ENDIF
+  IF (stot0/=0) THEN
     stot= stot/stot0
   else
     stot=1.
-  endif
-  if (ang0/=0) THEN
+  ENDIF
+  IF (ang0/=0) THEN
     ang = ang /ang0
   else
     ang=1.
-  endif
+  ENDIF
 
   firstcal = .FALSE.
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/test_period.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/test_period.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/test_period.f90	(revision 5117)
@@ -43,6 +43,6 @@
 
      do ij=1,iim
-      if (teta(ij,l)/=teta(1,l) &
-            .or.teta(ip1jm+ij,l)/=teta(ip1jm+1,l) ) THEN
+      IF (teta(ij,l)/=teta(1,l) &
+            .OR.teta(ip1jm+ij,l)/=teta(ip1jm+1,l) ) THEN
       PRINT *,'STOP dans test_period car ---  TETA  ---  n est pas', &
             ' constant aux poles ! '
@@ -99,6 +99,6 @@
      ENDDO
      do ij=1,iim
-      if (p(ij,l)/=p(1,l) &
-            .or.p(ip1jm+ij,l)/=p(ip1jm+1,l) ) THEN
+      IF (p(ij,l)/=p(1,l) &
+            .OR.p(ip1jm+ij,l)/=p(ip1jm+1,l) ) THEN
       PRINT *,'STOP dans test_period car ---  P     ---  n est pas', &
             ' constant aux poles ! '
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/tracstoke.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/tracstoke.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/tracstoke.h	(revision 5117)
@@ -3,3 +3,3 @@
 
       common /tracstoke/istdyn,istphy,unittrac
-      integer istdyn,istphy,unittrac
+      INTEGER istdyn,istphy,unittrac
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/ugeostr.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/ugeostr.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/ugeostr.F90	(revision 5117)
@@ -11,5 +11,5 @@
   ! levels are pressure levels.
 
-  use comconst_mod, ONLY: omeg, rad
+  USE comconst_mod, ONLY: omeg, rad
   
   IMPLICIT NONE
@@ -19,9 +19,9 @@
   include "comgeom2.h"
 
-  real ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm)
-  real um(jjm,llm),fact,u(iip1,jjm,llm)
-  integer i,j,l
+  REAL ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm)
+  REAL um(jjm,llm),fact,u(iip1,jjm,llm)
+  INTEGER i,j,l
 
-  real zlat
+  REAL zlat
 
   um(:,:)=0 ! initialize um()
@@ -29,5 +29,5 @@
   DO j=1,jjm
 
-     if (abs(sin(rlatv(j)))<1.e-4) THEN
+     IF (abs(sin(rlatv(j)))<1.e-4) THEN
         zlat=1.e-4
      else
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/write_grads_dyn.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/write_grads_dyn.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/write_grads_dyn.h	(revision 5117)
@@ -2,5 +2,5 @@
 ! $Header$
 
-if (callinigrads) THEN
+IF (callinigrads) THEN
    string10='dyn'
    CALL inigrads(1,iip1 &
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writedynav.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writedynav.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writedynav.F90	(revision 5117)
@@ -5,5 +5,5 @@
   USE ioipsl
   USE infotrac, ONLY: nqtot
-  use com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
+  USE com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
   USE comconst_mod, ONLY: cpp
   USE temps_mod, ONLY: itau_dyn
@@ -47,10 +47,10 @@
   !   Variables locales
 
-  integer ndex2d(ip1jmp1), ndexu(ip1jmp1*llm), ndexv(ip1jm*llm)
+  INTEGER ndex2d(ip1jmp1), ndexu(ip1jmp1*llm), ndexv(ip1jm*llm)
   INTEGER iq, ii, ll
-  real tm(ip1jmp1*llm)
+  REAL tm(ip1jmp1*llm)
   REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
-  logical ok_sync
-  integer itau_w
+  LOGICAL ok_sync
+  INTEGER itau_w
 
   !-----------------------------------------------------------------
@@ -120,5 +120,5 @@
   ! CALL histwrite(histaveid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
 
-  if (ok_sync) THEN
+  IF (ok_sync) THEN
      CALL histsync(histaveid)
      CALL histsync(histvaveid)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writehist.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writehist.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writehist.f90	(revision 5117)
@@ -55,5 +55,5 @@
   INTEGER :: iq, ii, ll
   INTEGER :: ndexu(ip1jmp1 * llm), ndexv(ip1jm * llm), ndex2d(ip1jmp1)
-  logical :: ok_sync
+  LOGICAL :: ok_sync
   INTEGER :: itau_w
   REAL :: vnat(ip1jm, llm), unat(ip1jmp1, llm)
@@ -114,9 +114,9 @@
   !  Fin
   !
-  if (ok_sync) THEN
+  IF (ok_sync) THEN
     CALL histsync(histid)
     CALL histsync(histvid)
     CALL histsync(histuid)
-  endif
+  ENDIF
   RETURN
 END SUBROUTINE writehist
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/abort_gcm.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/abort_gcm.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/abort_gcm.f90	(revision 5117)
@@ -18,7 +18,7 @@
   !     ierr    = severity of situation ( = 0 normal )
 
-  CHARACTER(LEN=*), intent(in):: modname
+  CHARACTER(LEN=*), INTENT(IN):: modname
   INTEGER :: ierr, ierror_mpi
-  CHARACTER(LEN=*), intent(in):: message
+  CHARACTER(LEN=*), INTENT(IN):: message
 
   WRITE(lunout,*) 'in abort_gcm'
@@ -26,7 +26,7 @@
   CALL histclo
   CALL restclo
-  if (MPI_rank == 0) THEN
+  IF (MPI_rank == 0) THEN
      CALL getin_dump
-  endif
+  ENDIF
 !$OMP END MASTER
   ! CALL histclo(2)
@@ -36,10 +36,10 @@
   WRITE(lunout,*) 'Stopping in ', modname
   WRITE(lunout,*) 'Reason = ',message
-  if (ierr == 0) THEN
+  IF (ierr == 0) THEN
     WRITE(lunout,*) 'Everything is cool'
   else
     WRITE(lunout,*) 'Houston, we have a problem, ierr = ', ierr
 
-    if (using_mpi) THEN
+    IF (using_mpi) THEN
 !$OMP CRITICAL (MPI_ABORT_GCM)
       CALL MPI_ABORT(COMM_LMDZ, 1, ierror_mpi)
@@ -49,4 +49,4 @@
     endif
 
-  endif
+  ENDIF
 END SUBROUTINE abort_gcm
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/addfi_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/addfi_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/addfi_loc.f90	(revision 5117)
@@ -96,5 +96,5 @@
 !$OMP END DO NOWAIT
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO  k    = 1, llm
@@ -109,7 +109,7 @@
    ENDDO
 !$OMP END DO NOWAIT
-  endif
-
-  if (pole_sud) THEN
+  ENDIF
+
+  IF (pole_sud) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO  k    = 1, llm
@@ -124,11 +124,11 @@
    ENDDO
 !$OMP END DO NOWAIT
-  endif
+  ENDIF
   !
 
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -140,5 +140,5 @@
 !$OMP END DO NOWAIT
 
-  if (pole_nord) ijb=ij_begin
+  IF (pole_nord) ijb=ij_begin
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -151,5 +151,5 @@
 
   !
-  if (pole_sud)  ije=ij_end
+  IF (pole_sud)  ije=ij_end
 !$OMP MASTER
   DO j = ijb,ije
@@ -158,5 +158,5 @@
 !$OMP END MASTER
 
-  if (planet_type=="earth") THEN
+  IF (planet_type=="earth") THEN
   ! earth case, special treatment for first 2 tracers (water)
   DO iq = 1, 2
@@ -193,8 +193,8 @@
 !$OMP END DO NOWAIT
    ENDDO
-  endif ! of if (planet_type=="earth")
+  ENDIF ! of if (planet_type=="earth")
 
 !$OMP MASTER
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
     DO  ij   = 1, iim
       xpn(ij) = aire(   ij   ) * pps(  ij     )
@@ -207,7 +207,7 @@
     ENDDO
 
-  endif
-
-  if (pole_sud) THEN
+  ENDIF
+
+  IF (pole_sud) THEN
     DO  ij   = 1, iim
       xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
@@ -220,8 +220,8 @@
     ENDDO
 
-  endif
+  ENDIF
 !$OMP END MASTER
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
     DO iq = 1, nqtot
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -238,7 +238,7 @@
 !$OMP END DO NOWAIT	
     ENDDO
-  endif
-
-  if (pole_sud) THEN
+  ENDIF
+
+  IF (pole_sud) THEN
     DO iq = 1, nqtot
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -255,5 +255,5 @@
 !$OMP END DO NOWAIT	
     ENDDO
-  endif
+  ENDIF
 
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advect_new_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advect_new_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advect_new_loc.f90	(revision 5117)
@@ -75,6 +75,6 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_nord) ijb = ijb + iip1
-  if (pole_sud)  ije = ije - iip1
+  IF (pole_nord) ijb = ijb + iip1
+  IF (pole_sud)  ije = ije - iip1
 
   DO ij = ijb, ije
@@ -85,5 +85,5 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_sud)  ije = ij_end - iip1
+  IF (pole_sud)  ije = ij_end - iip1
 
   DO ij = ijb, ije
@@ -107,6 +107,6 @@
     ijb = ij_begin
     ije = ij_end
-    if (pole_nord) ijb = ijb + iip1
-    if (pole_sud)  ije = ije - iip1
+    IF (pole_nord) ijb = ijb + iip1
+    IF (pole_sud)  ije = ije - iip1
 
     ! DO    ij     = iip2, ip1jmp1
@@ -124,5 +124,5 @@
     ENDDO
 
-    if (pole_nord) THEN
+    IF (pole_nord) THEN
       DO      ij = 1, iip1
         uav(ij, l) = 0.
@@ -130,5 +130,5 @@
     endif
 
-    if (pole_sud) THEN
+    IF (pole_sud) THEN
       DO      ij = 1, iip1
         uav(ip1jm + ij, l) = 0.
@@ -145,5 +145,5 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_sud)  ije = ij_end - iip1
+  IF (pole_sud)  ije = ij_end - iip1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -180,5 +180,5 @@
     ijb = ij_begin
     ije = ij_end + iip1
-    if (pole_sud)  ije = ij_end
+    IF (pole_sud)  ije = ij_end
 
     DO ij = ijb, ije
@@ -191,6 +191,6 @@
     ijb = ij_begin
     ije = ij_end
-    if (pole_nord) ijb = ijb + iip1
-    if (pole_sud)  ije = ije - iip1
+    IF (pole_nord) ijb = ijb + iip1
+    IF (pole_sud)  ije = ije - iip1
 
     DO ij = ijb, ije - 1
@@ -204,5 +204,5 @@
     ijb = ij_begin
     ije = ij_end
-    if (pole_sud)  ije = ij_end - iip1
+    IF (pole_sud)  ije = ij_end - iip1
 
     DO ij = ijb, ije
@@ -247,6 +247,6 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_nord) ijb = ijb + iip1
-  if (pole_sud)  ije = ije - iip1
+  IF (pole_nord) ijb = ijb + iip1
+  IF (pole_sud)  ije = ije - iip1
   IF (CPPKEY_DEBUGIO) THEN
     CALL WriteField_u('du_bis', du)
@@ -270,5 +270,5 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_sud)  ije = ij_end - iip1
+  IF (pole_sud)  ije = ij_end - iip1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advtrac_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advtrac_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advtrac_loc.f90	(revision 5117)
@@ -14,9 +14,9 @@
   USE Bands
   USE mod_hallo
-  USE Vampir
+  USE lmdz_vampir
   USE times
   USE advtrac_mod, ONLY: finmasse
   USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO
-  USE strings_mod, ONLY: int2str
+  USE lmdz_strings, ONLY: int2str
   USE lmdz_description, ONLY: descript
   USE lmdz_libmath, ONLY: minmax
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bands.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bands.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bands.F90	(revision 5117)
@@ -4,14 +4,14 @@
   module Bands
   USE parallel_lmdz
-    integer, parameter :: bands_caldyn=1
-    integer, parameter :: bands_vanleer=2
-    integer, parameter :: bands_dissip=3
+    INTEGER, parameter :: bands_caldyn=1
+    INTEGER, parameter :: bands_vanleer=2
+    INTEGER, parameter :: bands_dissip=3
     
-    INTEGER,dimension(:),allocatable :: jj_Nb_Caldyn
-    INTEGER,dimension(:),allocatable :: jj_Nb_vanleer
-    INTEGER,dimension(:),allocatable :: jj_Nb_vanleer2
-    INTEGER,dimension(:),allocatable :: jj_Nb_dissip
-    INTEGER,dimension(:),allocatable :: jj_Nb_physic
-    INTEGER,dimension(:),allocatable :: jj_Nb_physic_bis
+    INTEGER,DIMENSION(:),ALLOCATABLE :: jj_Nb_Caldyn
+    INTEGER,DIMENSION(:),ALLOCATABLE :: jj_Nb_vanleer
+    INTEGER,DIMENSION(:),ALLOCATABLE :: jj_Nb_vanleer2
+    INTEGER,DIMENSION(:),ALLOCATABLE :: jj_Nb_dissip
+    INTEGER,DIMENSION(:),ALLOCATABLE :: jj_Nb_physic
+    INTEGER,DIMENSION(:),ALLOCATABLE :: jj_Nb_physic_bis
    
     TYPE(distrib),SAVE,TARGET :: distrib_Caldyn
@@ -22,5 +22,5 @@
     TYPE(distrib),SAVE,TARGET :: distrib_physic_bis
 
-    INTEGER,dimension(:),allocatable :: distrib_phys
+    INTEGER,DIMENSION(:),ALLOCATABLE :: distrib_phys
   
   contains
@@ -46,6 +46,6 @@
     include "dimensions.h"
       INTEGER :: i,j
-      character (len=4) :: siim,sjjm,sllm,sproc
-      character (len=255) :: filename
+      CHARACTER (LEN=4) :: siim,sjjm,sllm,sproc
+      CHARACTER (LEN=255) :: filename
       INTEGER :: unit_number=10
       INTEGER :: ierr
@@ -61,5 +61,5 @@
       OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='old',FORM='formatted',IOSTAT=ierr)
       
-      if (ierr==0) THEN
+      IF (ierr==0) THEN
          do i=0,mpi_size-1
           read (unit_number,*) j,jj_nb_caldyn(i)
@@ -83,5 +83,5 @@
         do i=0,mpi_size-1
           jj_nb_caldyn(i)=(jjm+1)/mpi_size
-	  if (i<MOD(jjm+1,mpi_size)) jj_nb_caldyn(i)=jj_nb_caldyn(i)+1
+	  IF (i<MOD(jjm+1,mpi_size)) jj_nb_caldyn(i)=jj_nb_caldyn(i)+1
         enddo
       
@@ -112,5 +112,5 @@
       do i=0,mpi_size-1
          jj_nb_vanleer2(i)=(jjm+1)/mpi_size
-	 if (i<MOD(jjm+1,mpi_size)) jj_nb_vanleer2(i)=jj_nb_vanleer2(i)+1
+	 IF (i<MOD(jjm+1,mpi_size)) jj_nb_vanleer2(i)=jj_nb_vanleer2(i)+1
       enddo
           
@@ -128,6 +128,6 @@
        do i=0,MPI_Size-1
         jj_Nb_physic(i)=jj_para_end(i)-jj_para_begin(i)+1
-        if (i/=0) THEN
-          if (jj_para_begin(i)==jj_para_end(i-1)) THEN
+        IF (i/=0) THEN
+          IF (jj_para_begin(i)==jj_para_end(i-1)) THEN
             jj_Nb_physic(i-1)=jj_Nb_physic(i-1)-1
           endif
@@ -137,11 +137,11 @@
       do i=0,MPI_Size-1
         jj_Nb_physic_bis(i)=jj_para_end(i)-jj_para_begin(i)+1
-        if (i/=0) THEN
-          if (jj_para_begin(i)==jj_para_end(i-1)) THEN
+        IF (i/=0) THEN
+          IF (jj_para_begin(i)==jj_para_end(i-1)) THEN
             jj_Nb_physic_bis(i)=jj_Nb_physic_bis(i)-1
           else
 	    jj_Nb_physic_bis(i-1)=jj_Nb_physic_bis(i-1)+1
 	    jj_Nb_physic_bis(i)=jj_Nb_physic_bis(i)-1
-	  endif
+	  ENDIF
         endif
       enddo
@@ -174,5 +174,5 @@
 
     SUBROUTINE AdjustBands_caldyn(new_dist)
-      use times
+      USE times
       USE parallel_lmdz
       IMPLICIT NONE
@@ -182,6 +182,6 @@
       INTEGER :: min_proc,max_proc
       INTEGER :: i,j
-      real,allocatable,dimension(:) :: value
-      integer,allocatable,dimension(:) :: index
+      REAL,ALLOCATABLE,DIMENSION(:) :: value
+      INTEGER,ALLOCATABLE,DIMENSION(:) :: index
       REAL :: tmpvalue
       INTEGER :: tmpindex
@@ -200,5 +200,5 @@
       do i=0,mpi_size-2
         do j=i+1,mpi_size-1
-	  if (value(i)>value(j)) THEN
+	  IF (value(i)>value(j)) THEN
 	    tmpvalue=value(i)
 	    value(i)=value(j)
@@ -218,11 +218,11 @@
         minvalue=value(i)
         min_proc=index(i)
-        if (jj_nb_caldyn(max_proc)>2) THEN
-          if (timer_iteration(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc)<=1 ) THEN
+        IF (jj_nb_caldyn(max_proc)>2) THEN
+          IF (timer_iteration(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc)<=1 ) THEN
              jj_nb_caldyn(min_proc)=jj_nb_caldyn(min_proc)+1
              jj_nb_caldyn(max_proc)=jj_nb_caldyn(max_proc)-1
 	     exit
            else
-             if (timer_average(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc)                 &
+             IF (timer_average(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc)                 &
 	        -timer_delta(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc) < maxvalue) THEN
                jj_nb_caldyn(min_proc)=jj_nb_caldyn(min_proc)+1
@@ -241,5 +241,5 @@
     
     SUBROUTINE AdjustBands_vanleer(new_dist)
-      use times
+      USE times
       USE parallel_lmdz
       IMPLICIT NONE
@@ -249,6 +249,6 @@
       INTEGER :: min_proc,max_proc
       INTEGER :: i,j
-      real,allocatable,dimension(:) :: value
-      integer,allocatable,dimension(:) :: index
+      REAL,ALLOCATABLE,DIMENSION(:) :: value
+      INTEGER,ALLOCATABLE,DIMENSION(:) :: index
       REAL :: tmpvalue
       INTEGER :: tmpindex
@@ -267,5 +267,5 @@
       do i=0,mpi_size-2
         do j=i+1,mpi_size-1
-	  if (value(i)>value(j)) THEN
+	  IF (value(i)>value(j)) THEN
 	    tmpvalue=value(i)
 	    value(i)=value(j)
@@ -286,6 +286,6 @@
         min_proc=index(i)
 
-        if (jj_nb_vanleer(max_proc)>2) THEN
-          if (timer_average(jj_nb_vanleer(min_proc)+1,timer_vanleer,min_proc)==0. .or. &
+        IF (jj_nb_vanleer(max_proc)>2) THEN
+          IF (timer_average(jj_nb_vanleer(min_proc)+1,timer_vanleer,min_proc)==0. .OR. &
              timer_average(jj_nb_vanleer(max_proc)-1,timer_vanleer,max_proc)==0.) THEN
              jj_nb_vanleer(min_proc)=jj_nb_vanleer(min_proc)+1
@@ -293,5 +293,5 @@
 	     exit
            else
-             if (timer_average(jj_nb_vanleer(min_proc)+1,timer_vanleer,min_proc) < maxvalue) THEN
+             IF (timer_average(jj_nb_vanleer(min_proc)+1,timer_vanleer,min_proc) < maxvalue) THEN
                jj_nb_vanleer(min_proc)=jj_nb_vanleer(min_proc)+1
                jj_nb_vanleer(max_proc)=jj_nb_vanleer(max_proc)-1
@@ -310,5 +310,5 @@
 
     SUBROUTINE AdjustBands_dissip(new_dist)
-      use times
+      USE times
       USE parallel_lmdz
       IMPLICIT NONE
@@ -318,6 +318,6 @@
       INTEGER :: min_proc,max_proc
       INTEGER :: i,j
-      real,allocatable,dimension(:) :: value
-      integer,allocatable,dimension(:) :: index
+      REAL,ALLOCATABLE,DIMENSION(:) :: value
+      INTEGER,ALLOCATABLE,DIMENSION(:) :: index
       REAL :: tmpvalue
       INTEGER :: tmpindex
@@ -336,5 +336,5 @@
       do i=0,mpi_size-2
         do j=i+1,mpi_size-1
-	  if (value(i)>value(j)) THEN
+	  IF (value(i)>value(j)) THEN
 	    tmpvalue=value(i)
 	    value(i)=value(j)
@@ -355,11 +355,11 @@
         min_proc=index(i)
 
-        if (jj_nb_dissip(max_proc)>3) THEN
-          if (timer_iteration(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc)<=1) THEN
+        IF (jj_nb_dissip(max_proc)>3) THEN
+          IF (timer_iteration(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc)<=1) THEN
              jj_nb_dissip(min_proc)=jj_nb_dissip(min_proc)+1
              jj_nb_dissip(max_proc)=jj_nb_dissip(max_proc)-1
 	     exit
            else
-             if (timer_average(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc)         &
+             IF (timer_average(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc)         &
 	        - timer_delta(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc) < maxvalue) THEN
                jj_nb_dissip(min_proc)=jj_nb_dissip(min_proc)+1
@@ -379,5 +379,5 @@
 
     SUBROUTINE AdjustBands_physic
-      use times
+      USE times
 
       ! Ehouarn: what follows is only related to // physics
@@ -389,6 +389,6 @@
 
       INTEGER :: i,Index
-      real,allocatable,dimension(:) :: value
-      integer,allocatable,dimension(:) :: Inc
+      REAL,ALLOCATABLE,DIMENSION(:) :: value
+      INTEGER,ALLOCATABLE,DIMENSION(:) :: Inc
       REAL :: medium
       INTEGER :: NbTot,sgn
@@ -414,5 +414,5 @@
       enddo
       
-      if (NbTot>=0) THEN
+      IF (NbTot>=0) THEN
         Sgn=1
       else
@@ -425,5 +425,5 @@
         Inc(Index)=Inc(Index)-Sgn
 	Index=Index+1
-	if (Index>mpi_size-1) Index=0
+	IF (Index>mpi_size-1) Index=0
       enddo
       
@@ -441,6 +441,6 @@
 
       INTEGER :: i,j
-      character (len=4) :: siim,sjjm,sllm,sproc
-      character (len=255) :: filename
+      CHARACTER (LEN=4) :: siim,sjjm,sllm,sproc
+      CHARACTER (LEN=255) :: filename
       INTEGER :: unit_number=10
       INTEGER :: ierr
@@ -456,5 +456,5 @@
       OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='replace',FORM='formatted',IOSTAT=ierr)
       
-      if (ierr==0) THEN
+      IF (ierr==0) THEN
 !	write (unit_number,*) '*** Bandes caldyn ***'
 	do i=0,mpi_size-1
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bernoui_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bernoui_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bernoui_loc.f90	(revision 5117)
@@ -45,9 +45,9 @@
   ijb=ij_begin
   ije=ij_end+iip1
-  if (pole_sud) ije=ij_end
+  IF (pole_sud) ije=ij_end
 
   jjb=jj_begin
   jje=jj_end+1
-  if (pole_sud) jje=jj_end
+  IF (pole_sud) jje=jj_end
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bilan_dyn_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bilan_dyn_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bilan_dyn_loc.f90	(revision 5117)
@@ -13,5 +13,5 @@
   USE parallel_lmdz
   USE mod_hallo
-  use misc_mod
+  USE misc_mod
   USE write_field_loc
   USE comconst_mod, ONLY: cpp, pi
@@ -56,5 +56,5 @@
   !   =======
 
-  integer,SAVE :: icum,ncum
+  INTEGER,SAVE :: icum,ncum
 !$OMP THREADPRIVATE(icum,ncum)
   LOGICAL,SAVE :: first=.TRUE.
@@ -76,10 +76,10 @@
   parameter (ifile=4)
 
-  integer,PARAMETER :: itemp=1,igeop=2,iecin=3,iang=4,iu=5
+  INTEGER,PARAMETER :: itemp=1,igeop=2,iecin=3,iang=4,iu=5
   INTEGER,PARAMETER :: iovap=6,iun=7
-  integer,PARAMETER :: i_sortie=1
-
-  real,SAVE :: time=0.
-  integer,SAVE :: itau=0.
+  INTEGER,PARAMETER :: i_sortie=1
+
+  REAL,SAVE :: time=0.
+  INTEGER,SAVE :: itau=0.
 !$OMP THREADPRIVATE(time,itau)
 
@@ -95,16 +95,16 @@
 
   !   champ contenant les scalaires advectés.
-  real,SAVE,ALLOCATABLE :: Q(:,:,:,:)
+  REAL,SAVE,ALLOCATABLE :: Q(:,:,:,:)
 
   !   champs cumulés
-  real,SAVE,ALLOCATABLE ::  ps_cum(:,:)
-  real,SAVE,ALLOCATABLE ::  masse_cum(:,:,:)
-  real,SAVE,ALLOCATABLE ::  flux_u_cum(:,:,:)
-  real,SAVE,ALLOCATABLE ::  flux_v_cum(:,:,:)
-  real,SAVE,ALLOCATABLE ::  Q_cum(:,:,:,:)
-  real,SAVE,ALLOCATABLE ::  flux_uQ_cum(:,:,:,:)
-  real,SAVE,ALLOCATABLE ::  flux_vQ_cum(:,:,:,:)
-  real,SAVE,ALLOCATABLE ::  flux_wQ_cum(:,:,:,:)
-  real,SAVE,ALLOCATABLE ::  dQ(:,:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  ps_cum(:,:)
+  REAL,SAVE,ALLOCATABLE ::  masse_cum(:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  flux_u_cum(:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  flux_v_cum(:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  Q_cum(:,:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  flux_uQ_cum(:,:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  flux_vQ_cum(:,:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  flux_wQ_cum(:,:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  dQ(:,:,:,:)
 
 
@@ -125,9 +125,9 @@
   data ctrs/'  ','TOT','MMC','TRS','STN'/
 
-  real,SAVE,ALLOCATABLE ::  zvQ(:,:,:,:),zvQtmp(:,:)
-  real,SAVE,ALLOCATABLE ::  zavQ(:,:,:),psiQ(:,:,:)
-  real,SAVE,ALLOCATABLE ::  zmasse(:,:),zamasse(:)
-
-  real,SAVE,ALLOCATABLE ::  zv(:,:),psi(:,:)
+  REAL,SAVE,ALLOCATABLE ::  zvQ(:,:,:,:),zvQtmp(:,:)
+  REAL,SAVE,ALLOCATABLE ::  zavQ(:,:,:),psiQ(:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  zmasse(:,:),zamasse(:)
+
+  REAL,SAVE,ALLOCATABLE ::  zv(:,:),psi(:,:)
 
   INTEGER :: i,j,l,iQ
@@ -139,5 +139,5 @@
   CHARACTER(LEN=10) :: infile
 
-  integer, save :: fileid
+  INTEGER, save :: fileid
   INTEGER :: thoriid, zvertiid
 
@@ -153,5 +153,5 @@
   INTEGER :: zan, dayref
   !
-  real,SAVE,ALLOCATABLE :: rlong(:),rlatg(:)
+  REAL,SAVE,ALLOCATABLE :: rlong(:),rlatg(:)
   INTEGER :: jjb,jje,jjn,ijb,ije
   type(Request),SAVE :: Req
@@ -173,10 +173,10 @@
   !   Initialisation
   !=====================================================================
-  if (adjust) return
+  IF (adjust) return
 
   time=time+dt_app
   itau=itau+1
 
-  if (first) THEN
+  IF (first) THEN
 !$OMP BARRIER
 !$OMP MASTER
@@ -223,5 +223,5 @@
   !   ncum est la frequence de stokage en pas de temps
     ncum=dt_cum/dt_app
-    if (abs(ncum*dt_app-dt_cum)>1.e-5*dt_app) THEN
+    IF (abs(ncum*dt_app-dt_cum)>1.e-5*dt_app) THEN
        WRITE(lunout,*) &
              'Pb : le pas de cumule doit etre multiple du pas'
@@ -358,5 +358,5 @@
 
 !$OMP END MASTER
-  endif
+  ENDIF
 
 
@@ -419,10 +419,10 @@
       Q_cum(:,jjb:jje,l,:)=0.
       flux_uQ_cum(:,jjb:jje,l,:)=0.
-      if (pole_sud) jje=jj_end-1
+      IF (pole_sud) jje=jj_end-1
       flux_v_cum(:,jjb:jje,l)=0.
       flux_vQ_cum(:,jjb:jje,l,:)=0.
     ENDDO
 !$OMP END DO NOWAIT
-  endif
+  ENDIF
 
   IF (prt_level > 5) &
@@ -447,5 +447,5 @@
 !$OMP END DO NOWAIT
 
-  if (pole_sud) jje=jj_end-1
+  IF (pole_sud) jje=jj_end-1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -499,5 +499,5 @@
   jjb=jj_begin
   jje=jj_end
-  if (pole_sud) jje=jj_end-1
+  IF (pole_sud) jje=jj_end-1
 
   do iQ=1,nQ
@@ -582,5 +582,5 @@
   !   PAS DE TEMPS D'ECRITURE
   !=====================================================================
-  if (icum==ncum) THEN
+  IF (icum==ncum) THEN
   !=====================================================================
 
@@ -647,5 +647,5 @@
   jjb=jj_begin
   jje=jj_end
-  if (pole_sud) jje=jj_end-1
+  IF (pole_sud) jje=jj_end-1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -670,5 +670,5 @@
   jjb=jj_begin
   jje=jj_end
-  if (pole_sud) jje=jj_end-1
+  IF (pole_sud) jje=jj_end-1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -717,5 +717,5 @@
   jjb=jj_begin
   jje=jj_end
-  if (pole_sud) jje=jj_end-1
+  IF (pole_sud) jje=jj_end-1
 
   zvQ=0.
@@ -776,10 +776,10 @@
   !   sorties proprement dites
 !$OMP MASTER
-  if (i_sortie==1) THEN
+  IF (i_sortie==1) THEN
   jjb=jj_begin
   jje=jj_end
   jjn=jj_nb
-  if (pole_sud) jje=jj_end-1
-  if (pole_sud) jjn=jj_nb-1
+  IF (pole_sud) jje=jj_end-1
+  IF (pole_sud) jjn=jj_nb-1
   do iQ=1,nQ
      do itr=1,ntr
@@ -801,5 +801,5 @@
         jjn*llm,ndex3d)
 
-  endif
+  ENDIF
 
 
@@ -832,5 +832,5 @@
   !/////////////////////////////////////////////////////////////////////
   icum=0                  !///////////////////////////////////////
-  endif ! icum.eq.ncum    !///////////////////////////////////////
+  ENDIF ! icum.EQ.ncum    !///////////////////////////////////////
   !/////////////////////////////////////////////////////////////////////
   !=====================================================================
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caladvtrac_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caladvtrac_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caladvtrac_loc.f90	(revision 5117)
@@ -13,5 +13,5 @@
   USE bands
   USE times
-  USE Vampir
+  USE lmdz_vampir
   USE write_field_loc
   USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO
@@ -60,6 +60,6 @@
   ijbv = ij_begin - iip1
   ijev = ij_end
-  if (pole_nord) ijbv = ij_begin
-  if (pole_sud)  ijev = ij_end - iip1
+  IF (pole_nord) ijbv = ij_begin
+  IF (pole_sud)  ijev = ij_end - iip1
 
   IF(iadvtr==0) THEN
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caldyn_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caldyn_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caldyn_loc.f90	(revision 5117)
@@ -144,6 +144,6 @@
   ije = ij_end + iip1
 
-  if (pole_nord) ijb = ij_begin
-  if (pole_sud) ije = ij_end
+  IF (pole_nord) ijb = ij_begin
+  IF (pole_sud) ije = ij_end
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -162,5 +162,5 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_sud) ije = ij_end - iip1
+  IF (pole_sud) ije = ij_end - iip1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/call_dissip_mod.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/call_dissip_mod.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/call_dissip_mod.f90	(revision 5117)
@@ -82,5 +82,5 @@
     USE mod_hallo
     USE Bands
-    USE vampir
+    USE lmdz_vampir
     USE write_field_loc
     USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO
@@ -240,5 +240,5 @@
       !$OMP END DO NOWAIT
 
-      if (1 == 0) THEN
+      IF (1 == 0) THEN
         !!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
         !!!                     2) should probably not be here anyway
@@ -274,5 +274,5 @@
       !$OMP END DO NOWAIT
 
-      if (1 == 0) THEN
+      IF (1 == 0) THEN
         !!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
         !!!                     2) should probably not be here anyway
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/check_isotopes_loc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/check_isotopes_loc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/check_isotopes_loc.F90	(revision 5117)
@@ -1,5 +1,5 @@
 SUBROUTINE check_isotopes(q, ijb, ije, err_msg)
    USE parallel_lmdz
-   USE strings_mod, ONLY: maxlen, msg, strIdx, strStack, int2str, real2str
+   USE lmdz_strings, ONLY: maxlen, msg, strIdx, strStack, int2str, real2str
    USE infotrac,    ONLY: nqtot, niso, nphas, isotope, isoCheck, iqIsoPha, isoSelect, &
                           ntiso, iH2O, nzone, tracers, isoName,  itZonIso, getKey
@@ -38,5 +38,5 @@
       iso_O17 = strIdx(isoName,'H217O')
       iso_HTO = strIdx(isoName,'HTO')
-      if (tnat1) THEN
+      IF (tnat1) THEN
               tnat(:)=1.0
       else
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/conf_gcm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/conf_gcm.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/conf_gcm.F90	(revision 5117)
@@ -91,5 +91,5 @@
   lunout=6
   CALL getin('lunout', lunout)
-  IF (lunout /= 5 .and. lunout /= 6) THEN
+  IF (lunout /= 5 .AND. lunout /= 6) THEN
      OPEN(UNIT=lunout,FILE='lmdz.out_0000',ACTION='write',  &
           STATUS='unknown',FORM='formatted')
@@ -102,5 +102,5 @@
   ! adjust=y not implemented in case of OpenMP threads...
   !$OMP PARALLEL
-  IF ((OMP_GET_NUM_THREADS()>1).and.adjust) THEN
+  IF ((OMP_GET_NUM_THREADS()>1).AND.adjust) THEN
      WRITE(lunout,*)'conf_gcm: Error, adjust should be set to n' &
           ,' when running with OpenMP threads'
@@ -340,5 +340,5 @@
   maxlatfilter = -1.0
   CALL getin('maxlatfilter',maxlatfilter)
-  if (maxlatfilter > 90) &
+  IF (maxlatfilter > 90) &
        CALL abort_gcm("conf_gcm", 'maxlatfilter should be <=90', 1)
   
@@ -359,5 +359,5 @@
   iflag_top_bound=1
   CALL getin('iflag_top_bound',iflag_top_bound)
-  IF (iflag_top_bound < 0 .or. iflag_top_bound > 2) &
+  IF (iflag_top_bound < 0 .OR. iflag_top_bound > 2) &
        CALL abort_gcm("conf_gcm", 'iflag_top_bound must be 0, 1 or 2', 1)
 
@@ -396,5 +396,5 @@
   CALL getin('ok_guide',ok_guide)
 
-  IF (ok_guide .and. adjust) CALL abort_gcm("conf_gcm", &
+  IF (ok_guide .AND. adjust) CALL abort_gcm("conf_gcm", &
        "adjust does not work with ok_guide", 1)
 
@@ -436,5 +436,5 @@
   !     .........   (  modif  le 17/04/96 )   .........
 
-  test_etatinit: IF (.not. etatinit) THEN
+  test_etatinit: IF (.NOT. etatinit) THEN
      !Config  Key  = clon
      !Config  Desc = centre du zoom, longitude
@@ -933,7 +933,7 @@
      CALL getin('ok_strato',ok_strato)
 
-     vert_prof_dissip = merge(1, 0, ok_strato .and. llm==39)
+     vert_prof_dissip = merge(1, 0, ok_strato .AND. llm==39)
      CALL getin('vert_prof_dissip', vert_prof_dissip)
-     CALL assert(vert_prof_dissip == 0 .or. vert_prof_dissip ==  1, &
+     CALL assert(vert_prof_dissip == 0 .OR. vert_prof_dissip ==  1, &
           "bad value for vert_prof_dissip")
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covcont_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covcont_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covcont_loc.f90	(revision 5117)
@@ -33,13 +33,13 @@
   ijev=ij_end+iip1
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
     ijbu=ij_begin+iip1
     ijbv=ij_begin
-  endif
+  ENDIF
 
-  if (pole_sud) THEN
+  IF (pole_sud) THEN
     ijeu=ij_end-iip1
     ijev=ij_end-iip1
-  endif
+  ENDIF
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covnat_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covnat_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covnat_loc.f90	(revision 5117)
@@ -34,5 +34,5 @@
   ije=ij_end
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l = 1,klevel
@@ -42,7 +42,7 @@
     ENDDO
 !$OMP ENDDO NOWAIT
-  endif
+  ENDIF
 
-  if (pole_sud) THEN
+  IF (pole_sud) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l = 1,klevel
@@ -52,10 +52,10 @@
     ENDDO
 !$OMP ENDDO NOWAIT
-  endif
+  ENDIF
 
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -69,6 +69,6 @@
   ijb=ij_begin-iip1
   ije=ij_end
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end-iip1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dissip_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dissip_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dissip_loc.f90	(revision 5117)
@@ -92,5 +92,5 @@
   !$OMP END DO NOWAIT
 
-  if (pole_sud) ije = ij_end - iip1
+  IF (pole_sud) ije = ij_end - iip1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -121,9 +121,9 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_sud) ije = ij_end - iip1
-
-  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-  DO l = 1, llm
-    if (pole_nord) THEN
+  IF (pole_sud) ije = ij_end - iip1
+
+  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+  DO l = 1, llm
+    IF (pole_nord) THEN
       DO ij = 1, iip1
         gdx(ij, l) = 0.
@@ -131,5 +131,5 @@
     endif
 
-    if (pole_sud) THEN
+    IF (pole_sud) THEN
       DO ij = 1, iip1
         gdx(ij + ip1jm, l) = 0.
@@ -137,10 +137,10 @@
     endif
 
-    if (pole_nord) ijb = ij_begin + iip1
+    IF (pole_nord) ijb = ij_begin + iip1
     DO ij = ijb, ije
       du(ij, l) = du(ij, l) - te1dt(l) * gdx(ij, l)
     ENDDO
 
-    if (pole_nord) ijb = ij_begin
+    IF (pole_nord) ijb = ij_begin
     DO ij = ijb, ije
       dv(ij, l) = dv(ij, l) - te1dt(l) * gdy(ij, l)
@@ -166,10 +166,10 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_sud) ije = ij_end - iip1
-
-  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-  DO l = 1, llm
-
-    if (pole_nord) THEN
+  IF (pole_sud) ije = ij_end - iip1
+
+  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+  DO l = 1, llm
+
+    IF (pole_nord) THEN
       DO ij = 1, iip1
         grx(ij, l) = 0.
@@ -177,10 +177,10 @@
     endif
 
-    if (pole_nord) ijb = ij_begin + iip1
+    IF (pole_nord) ijb = ij_begin + iip1
     DO ij = ijb, ije
       du(ij, l) = du(ij, l) - te2dt(l) * grx(ij, l)
     ENDDO
 
-    if (pole_nord) ijb = ij_begin
+    IF (pole_nord) ijb = ij_begin
     DO ij = ijb, ije
       dv(ij, l) = dv(ij, l) - te2dt(l) * gry(ij, l)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_gam_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_gam_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_gam_loc.f90	(revision 5117)
@@ -47,5 +47,5 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ij_begin+iip1
+  IF (pole_nord) ijb=ij_begin+iip1
   IF(pole_sud)  ije=ij_end-iip1
 
@@ -70,5 +70,5 @@
   ! ....  calcul  aux poles  .....
   !
-   if (pole_nord) THEN
+   IF (pole_nord) THEN
       DO  ij  = 1,iim
        aiy1(ij) =    cuvscvgam(    ij       ) * y(     ij     , l )
@@ -81,5 +81,5 @@
    endif
 
-    if (pole_sud) THEN
+    IF (pole_sud) THEN
       DO  ij  = 1,iim
        aiy2(ij) =    cuvscvgam( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_p.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_p.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_p.f90	(revision 5117)
@@ -43,5 +43,5 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ij_begin+iip1
+  IF (pole_nord) ijb=ij_begin+iip1
   IF(pole_sud)  ije=ij_end-iip1
 
@@ -65,5 +65,5 @@
   ! ....  calcul  aux poles  .....
   !
-    if (pole_nord) THEN
+    IF (pole_nord) THEN
       DO  ij  = 1,iim
        aiy1(ij) =    cuvsurcv(    ij       ) * y(     ij     , l )
@@ -76,5 +76,5 @@
     endif
 
-   if (pole_sud) THEN
+   IF (pole_sud) THEN
       DO  ij  = 1,iim
        aiy2(ij) =    cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/divergf_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/divergf_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/divergf_loc.f90	(revision 5117)
@@ -45,5 +45,5 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ij_begin+iip1
+  IF (pole_nord) ijb=ij_begin+iip1
   IF(pole_sud)  ije=ij_end-iip1
 
@@ -68,5 +68,5 @@
   ! ....  calcul  aux poles  .....
   !
-    if (pole_nord) THEN
+    IF (pole_nord) THEN
       DO  ij  = 1,iim
        aiy1(ij) =    cuvsurcv(    ij       ) * y(     ij     , l )
@@ -81,5 +81,5 @@
     endif
 
-    if (pole_sud) THEN
+    IF (pole_sud) THEN
       DO  ij  = 1,iim
        aiy2(ij) =    cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
@@ -99,5 +99,5 @@
     jjb=jj_begin
     jje=jj_end
-    if (pole_sud) jje=jj_end-1
+    IF (pole_sud) jje=jj_end-1
 
     CALL filtreg_p( div,jjb_u,jje_u,jjb,jje, jjp1, &
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dteta1_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dteta1_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dteta1_loc.f90	(revision 5117)
@@ -44,6 +44,6 @@
   ije=ij_end
 
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij = ijb, ije - 1
@@ -60,5 +60,5 @@
 
   ijb=ij_begin-iip1
-  if (pole_nord) ijb=ij_begin
+  IF (pole_nord) ijb=ij_begin
 
   DO ij = ijb,ije
@@ -66,5 +66,5 @@
   END DO
 
-   if (.not. pole_sud) THEN
+   IF (.NOT. pole_sud) THEN
       hbxu(ije+1:ije+iip1,l) = 0
       hbyv(ije+1:ije+iip1,l) = 0
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dudv1_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dudv1_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dudv1_loc.f90	(revision 5117)
@@ -33,6 +33,6 @@
   ije=ij_end
 
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij = ijb, ije-1
@@ -44,5 +44,5 @@
 
   !
-  if (pole_nord) ijb=ij_begin
+  IF (pole_nord) ijb=ij_begin
 
   DO ij = ijb, ije-1
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dudv2_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dudv2_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dudv2_loc.f90	(revision 5117)
@@ -37,6 +37,6 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ijb+iip1
-  if (pole_sud)  ije=ije-iip1
+  IF (pole_nord) ijb=ijb+iip1
+  IF (pole_sud)  ije=ije-iip1
 
   DO ij  = ijb, ije - 1
@@ -55,5 +55,5 @@
   !
   !
-  if (pole_nord) ijb=ijb-iip1
+  IF (pole_nord) ijb=ijb-iip1
 
   DO ij  = ijb,ije
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynetat0_loc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynetat0_loc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynetat0_loc.F90	(revision 5117)
@@ -8,8 +8,8 @@
   USE parallel_lmdz
   USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName
-  USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str, strIdx
+  USE lmdz_strings, ONLY: maxlen, msg, strStack, real2str, int2str, strIdx
   USE netcdf,      ONLY: nf90_open,  nf90_nowrite, nf90_inquire_dimension, nf90_inq_varid, &
                          nf90_close, nf90_get_var, nf90_inquire_variable,  nf90_noerr
-  USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey
+  USE lmdz_readTracFiles, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey
   USE control_mod, ONLY: planet_type
   USE lmdz_assert_eq, ONLY: assert_eq
@@ -182,5 +182,5 @@
       iqParent = tracers(iq)%iqParent
       IF(tracers(iq)%iso_iZone == 0) THEN
-         if (tnat1) THEN
+         IF (tnat1) THEN
                  tnat=1.0
                  alpha_ideal=1.0
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynredem_loc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynredem_loc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynredem_loc.F90	(revision 5117)
@@ -7,5 +7,5 @@
   USE parallel_lmdz
   USE mod_hallo
-  USE strings_mod, ONLY: maxlen
+  USE lmdz_strings, ONLY: maxlen
   USE infotrac, ONLY: nqtot, tracers
   USE netcdf, ONLY: nf90_create, nf90_def_dim, nf90_inq_varid, nf90_global,    &
@@ -166,5 +166,5 @@
   USE parallel_lmdz
   USE mod_hallo
-  USE strings_mod, ONLY: maxlen
+  USE lmdz_strings, ONLY: maxlen
   USE infotrac, ONLY: nqtot, tracers, type_trac
   USE control_mod
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_hyb_loc_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_hyb_loc_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_hyb_loc_m.F90	(revision 5117)
@@ -63,16 +63,16 @@
 
     ! Sanity check
-    if (firstcall) THEN
+    IF (firstcall) THEN
       ! sanity checks for Shallow Water case (1 vertical layer)
-      if (llm==1) THEN
-        if (kappa/=1) THEN
+      IF (llm==1) THEN
+        IF (kappa/=1) THEN
           CALL abort_gcm(modname, &
                   "kappa!=1 , but running in Shallow Water mode!!", 42)
         endif
-        if (cpp/=r) THEN
+        IF (cpp/=r) THEN
           CALL abort_gcm(modname, &
                   "cpp!=r , but running in Shallow Water mode!!", 42)
         endif
-      endif ! of if (llm.eq.1)
+      endif ! of if (llm.EQ.1)
 
       firstcall = .FALSE.
@@ -82,5 +82,5 @@
 
     ! Specific behaviour for Shallow Water (1 vertical layer) case:
-    if (llm==1) THEN
+    IF (llm==1) THEN
       ! Compute pks(:),pk(:),pkf(:)
       ijb = ij_begin
@@ -90,10 +90,10 @@
         pks(ij) = (cpp / preff) * ps(ij)
         pk(ij, 1) = .5 * pks(ij)
-        if (present(pkf)) pkf(ij, 1) = pk(ij, 1)
+        IF (present(pkf)) pkf(ij, 1) = pk(ij, 1)
       ENDDO
       !$OMP ENDDO
 
       !$OMP BARRIER
-      if (present(pkf)) THEN
+      IF (present(pkf)) THEN
         jjb = jj_begin
         jje = jj_end
@@ -104,5 +104,5 @@
       ! our work is done, exit routine
       RETURN
-    endif ! of if (llm.eq.1)
+    endif ! of if (llm.EQ.1)
 
     ! General case:
@@ -169,5 +169,5 @@
     ENDDO
 
-    if (present(pkf)) THEN
+    IF (present(pkf)) THEN
       !    calcul de pkf
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_milieu_loc_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_milieu_loc_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_milieu_loc_m.F90	(revision 5117)
@@ -56,16 +56,16 @@
 
     ! Sanity check
-    if (firstcall) THEN
+    IF (firstcall) THEN
        ! sanity checks for Shallow Water case (1 vertical layer)
-       if (llm==1) THEN
-          if (kappa/=1) THEN
+       IF (llm==1) THEN
+          IF (kappa/=1) THEN
              CALL abort_gcm(modname, &
                   "kappa!=1 , but running in Shallow Water mode!!",42)
           endif
-          if (cpp/=r) THEN
+          IF (cpp/=r) THEN
              CALL abort_gcm(modname, &
                   "cpp!=r , but running in Shallow Water mode!!",42)
           endif
-       endif ! of if (llm.eq.1)
+       endif ! of if (llm.EQ.1)
 
        firstcall=.FALSE.
@@ -75,5 +75,5 @@
 
     ! Specific behaviour for Shallow Water (1 vertical layer) case:
-    if (llm==1) THEN
+    IF (llm==1) THEN
        ! Compute pks(:),pk(:),pkf(:)
        ijb=ij_begin
@@ -83,10 +83,10 @@
           pks(ij) = (cpp/preff) * ps(ij)
           pk(ij,1) = .5*pks(ij)
-          if (present(pkf)) pkf(ij,1)=pk(ij,1)
+          IF (present(pkf)) pkf(ij,1)=pk(ij,1)
        ENDDO
        !$OMP ENDDO
 
        !$OMP BARRIER
-       if (present(pkf)) THEN
+       IF (present(pkf)) THEN
           jjb=jj_begin
           jje=jj_end
@@ -97,5 +97,5 @@
        ! our work is done, exit routine
        RETURN
-    endif ! of if (llm.eq.1)
+    endif ! of if (llm.EQ.1)
 
     ! General case:
@@ -140,5 +140,5 @@
     !$OMP ENDDO NOWAIT        
 
-    if (present(pkf)) THEN
+    IF (present(pkf)) THEN
        !    calcul de pkf
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/filtreg_p.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/filtreg_p.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/filtreg_p.F90	(revision 5117)
@@ -99,5 +99,5 @@
   !-------------------------------------------------------c
 
-  IF(ifiltre==1.or.ifiltre==-1) &
+  IF(ifiltre==1.OR.ifiltre==-1) &
         CALL abort_gcm("fitreg_p","Pas de transformee simple&
         &dans cette version",1)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/fluxstokenc_p.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/fluxstokenc_p.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/fluxstokenc_p.f90	(revision 5117)
@@ -10,5 +10,5 @@
   USE bands
   USE times
-  USE Vampir
+  USE lmdz_vampir
   USE write_field_loc
 
@@ -50,6 +50,6 @@
   ijbv = ij_begin - iip1
   ijev = ij_end
-  if (pole_nord) ijbv = ij_begin
-  if (pole_sud)  ijev = ij_end - iip1
+  IF (pole_nord) ijbv = ij_begin
+  IF (pole_sud)  ijev = ij_end - iip1
 
   IF(pasflx==0) THEN
@@ -116,5 +116,5 @@
     !$OMP ENDDO NOWAIT
 
-    if (pole_sud) ije = ij_end - iip1
+    IF (pole_sud) ije = ij_end - iip1
 
     !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/friction_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/friction_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/friction_loc.f90	(revision 5117)
@@ -29,7 +29,7 @@
 
   ! arguments:
-  REAL,INTENT(inout) :: ucov( iip1,jjb_u:jje_u,llm )
-  REAL,INTENT(inout) :: vcov( iip1,jjb_v:jje_v,llm )
-  REAL,INTENT(in) :: pdt ! time step
+  REAL,INTENT(INOUT) :: ucov( iip1,jjb_u:jje_u,llm )
+  REAL,INTENT(INOUT) :: vcov( iip1,jjb_v:jje_v,llm )
+  REAL,INTENT(IN) :: pdt ! time step
 
   ! local variables:
@@ -51,5 +51,5 @@
     ! set friction type
     CALL getin("friction_type",friction_type)
-    if ((friction_type<0).or.(friction_type>1)) THEN
+    IF ((friction_type<0).OR.(friction_type>1)) THEN
       abort_message="wrong friction type"
       WRITE(lunout,*)'Friction: wrong friction type',friction_type
@@ -60,10 +60,10 @@
 !$OMP END SINGLE COPYPRIVATE(friction_type,firstcall)
 
-  if (friction_type==0) then ! friction on first layer only
+  IF (friction_type==0) then ! friction on first layer only
 !$OMP SINGLE
   !   calcul des composantes au carre du vent naturel
   jjb=jj_begin
   jje=jj_end+1
-  if (pole_sud) jje=jj_end
+  IF (pole_sud) jje=jj_end
 
   do j=jjb,jje
@@ -75,6 +75,6 @@
   jjb=jj_begin-1
   jje=jj_end+1
-  if (pole_nord) jjb=jj_begin
-  if (pole_sud) jje=jj_end-1
+  IF (pole_nord) jjb=jj_begin
+  IF (pole_sud) jje=jj_end-1
 
   do j=jjb,jje
@@ -87,6 +87,6 @@
   jjb=jj_begin
   jje=jj_end+1
-  if (pole_nord) jjb=jj_begin+1
-  if (pole_sud) jje=jj_end-1
+  IF (pole_nord) jjb=jj_begin+1
+  IF (pole_sud) jje=jj_end-1
 
   do j=jjb,jje
@@ -99,5 +99,5 @@
   !   les deux composantes du vent au pole sont obtenues comme
   !   premiers modes de fourier de v pres du pole
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
     upoln=0.
     vpoln=0.
@@ -116,7 +116,7 @@
     enddo
 
-  endif
+  ENDIF
 
-  if (pole_sud) THEN
+  IF (pole_sud) THEN
     upols=0.
     vpols=0.
@@ -134,5 +134,5 @@
     enddo
 
-  endif
+  ENDIF
 
   !   calcul du frottement au sol.
@@ -140,6 +140,6 @@
   jjb=jj_begin
   jje=jj_end
-  if (pole_nord) jjb=jj_begin+1
-  if (pole_sud) jje=jj_end-1
+  IF (pole_nord) jjb=jj_begin+1
+  IF (pole_sud) jje=jj_end-1
 
   do j=jjb,jje
@@ -153,5 +153,5 @@
   jjb=jj_begin
   jje=jj_end
-  if (pole_sud) jje=jj_end-1
+  IF (pole_sud) jje=jj_end-1
 
   do j=jjb,jje
@@ -163,12 +163,12 @@
   enddo
 !$OMP END SINGLE
-  endif ! of if (friction_type.eq.0)
+  ENDIF ! of if (friction_type.EQ.0)
 
-  if (friction_type==1) THEN
+  IF (friction_type==1) THEN
    ! for ucov()
     jjb=jj_begin
     jje=jj_end
-    if (pole_nord) jjb=jj_begin+1
-    if (pole_sud) jje=jj_end-1
+    IF (pole_nord) jjb=jj_begin+1
+    IF (pole_sud) jje=jj_end-1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -182,5 +182,5 @@
     jjb=jj_begin
     jje=jj_end
-    if (pole_sud) jje=jj_end-1
+    IF (pole_sud) jje=jj_end-1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -190,5 +190,5 @@
     enddo
 !$OMP END DO
-  endif ! of if (friction_type.eq.1)
+  ENDIF ! of if (friction_type.EQ.1)
 
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gcm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gcm.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gcm.F90	(revision 5117)
@@ -87,5 +87,5 @@
   LOGICAL lafin
 
-  real time_step, t_wrt, t_ops
+  REAL time_step, t_wrt, t_ops
 
   !+jld variables test conservation energie
@@ -101,12 +101,12 @@
 
 
-  character (len=80) :: dynhist_file, dynhistave_file
-  character (len=20) :: modname
-  character (len=80) :: abort_message
+  CHARACTER (LEN=80) :: dynhist_file, dynhistave_file
+  CHARACTER (LEN=20) :: modname
+  CHARACTER (LEN=80) :: abort_message
   ! locales pour gestion du temps
   INTEGER :: an, mois, jour
   REAL :: heure
   ! needed for xios interface
-  character (len=10) :: xios_cal_type
+  CHARACTER (LEN=10) :: xios_cal_type
   INTEGER :: anref, moisref, jourref
   REAL :: heureref
@@ -132,5 +132,5 @@
 
   CALL conf_gcm( 99, .TRUE. )
-  if (mod(iphysiq, iperiod) /= 0) CALL abort_gcm("conf_gcm", &
+  IF (mod(iphysiq, iperiod) /= 0) CALL abort_gcm("conf_gcm", &
        "iphysiq must be a multiple of iperiod", 1)
 
@@ -154,5 +154,5 @@
 
   CALL set_bands
-  if (mpi_rank==0) CALL WriteBands
+  IF (mpi_rank==0) CALL WriteBands
   CALL Set_Distrib(distrib_caldyn)
 
@@ -173,13 +173,13 @@
   !      calend = 'earth_365d'
 
-  if (calend == 'earth_360d') THEN
+  IF (calend == 'earth_360d') THEN
      CALL ioconf_calendar('360_day')
      WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
      xios_cal_type='d360'
-  else if (calend == 'earth_365d') THEN
+  ELSE IF (calend == 'earth_365d') THEN
      CALL ioconf_calendar('noleap')
      WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
      xios_cal_type='noleap'
-  else if (calend == 'gregorian') THEN
+  ELSE IF (calend == 'gregorian') THEN
      CALL ioconf_calendar('gregorian')
      WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre bissextile'
@@ -188,5 +188,5 @@
      abort_message = 'Mauvais choix de calendrier'
      CALL abort_gcm(modname,abort_message,1)
-  endif
+  ENDIF
 
 
@@ -212,16 +212,16 @@
 
   !  lecture du fichier start.nc
-  if (read_start) THEN
+  IF (read_start) THEN
      ! we still need to run iniacademic to initialize some
      ! constants & fields, if we run the 'newtonian' or 'SW' cases:
-     if (iflag_phys/=1) THEN
+     IF (iflag_phys/=1) THEN
         CALL iniacademic_loc(vcov,ucov,teta,q,masse,ps,phis,time_0)
      endif
 
-     !        if (planet_type.eq."earth") THEN
+     !        if (planet_type.EQ."earth") THEN
      ! Load an Earth-format start file
      CALL dynetat0_loc("start.nc",vcov,ucov, &
           teta,q,masse,ps,phis, time_0)
-     !        endif ! of if (planet_type.eq."earth")
+     !        endif ! of if (planet_type.EQ."earth")
 
      !       WRITE(73,*) 'ucov',ucov
@@ -231,14 +231,14 @@
      !       WRITE(77,*) 'q',q
 
-  endif ! of if (read_start)
+  ENDIF ! of if (read_start)
 
   ! le cas echeant, creation d un etat initial
   IF (prt_level > 9) WRITE(lunout,*) &
        'GCM: AVANT iniacademic AVANT AVANT AVANT AVANT'
-  if (.not.read_start) THEN
+  IF (.NOT.read_start) THEN
      start_time=0.
      annee_ref=anneeref
      CALL iniacademic_loc(vcov,ucov,teta,q,masse,ps,phis,time_0)
-  endif
+  ENDIF
 
   !-----------------------------------------------------------------------
@@ -287,5 +287,5 @@
      WRITE(lunout,*) &
           'GCM: On reinitialise a la date lue dans gcm.def'
-  ELSE IF (annee_ref /= anneeref .or. day_ref /= dayref) THEN
+  ELSE IF (annee_ref /= anneeref .OR. day_ref /= dayref) THEN
      WRITE(lunout,*) &
           'GCM: Attention les dates initiales lues dans le fichier'
@@ -297,5 +297,5 @@
      WRITE(lunout,*)' Pas de remise a zero'
   ENDIF
-  !      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) THEN
+  !      if (annee_ref .NE. anneeref .OR. day_ref .NE. dayref) THEN
   !        WRITE(lunout,*)
   !     .  'GCM: Attention les dates initiales lues dans le fichier'
@@ -305,5 +305,5 @@
   !        WRITE(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
   !        WRITE(lunout,*)' day_ref=',day_ref," dayref=",dayref
-  !        if (raz_date .ne. 1) THEN
+  !        if (raz_date .NE. 1) THEN
   !          WRITE(lunout,*)
   !     .    'GCM: On garde les dates du fichier restart'
@@ -337,5 +337,5 @@
   WRITE(lunout,*)jD_ref+jH_ref,anref, moisref, jourref, heureref
 
-  if (iflag_phys==1) THEN
+  IF (iflag_phys==1) THEN
      ! these initialisations have already been done (via iniacademic)
      ! if running in SW or Newtonian mode
@@ -355,5 +355,5 @@
      !   --------------------------
      CALL inifilr
-  endif ! of if (iflag_phys.eq.1)
+  ENDIF ! of if (iflag_phys.EQ.1)
 
   !-----------------------------------------------------------------------
@@ -369,9 +369,9 @@
 
 
-  if (nday>=0) THEN
+  IF (nday>=0) THEN
      day_end = day_ini + nday
   else
      day_end = day_ini - nday/day_step
-  endif
+  ENDIF
 
   WRITE(lunout,300)day_ini,day_end
@@ -395,5 +395,5 @@
   istphy=istdyn/iphysiq
 
-  IF ((iflag_phys==1).or.(iflag_phys>=100)) THEN
+  IF ((iflag_phys==1).OR.(iflag_phys>=100)) THEN
      ! Physics:
     IF (CPPKEY_PHYS) THEN
@@ -404,8 +404,8 @@
             iflag_phys)
     END IF
-  ENDIF ! of IF ((iflag_phys==1).or.(iflag_phys>=100))
-
-
-  !      if (planet_type.eq."earth") THEN
+  ENDIF ! of IF ((iflag_phys==1).OR.(iflag_phys>=100))
+
+
+  !      if (planet_type.EQ."earth") THEN
   ! Write an Earth-format restart file
   CALL dynredem0_loc("restart.nc", day_end, phis)
@@ -415,5 +415,5 @@
 
   time_step = zdtvr
-     if (ok_dyn_ins) THEN
+     IF (ok_dyn_ins) THEN
         ! initialize output file for instantaneous outputs
         ! t_ops = iecri * daysec ! do operations every t_ops
@@ -433,8 +433,8 @@
 
 ! setting up DYN3D/XIOS inerface
-  if (ok_dyn_xios) THEN
+  IF (ok_dyn_xios) THEN
       CALL xios_dyn3dmem_init(xios_cal_type, anref, moisref, jourref,heureref, an,   &
           mois, jour, heure, zdtvr)
-  endif
+  ENDIF
 
   !-----------------------------------------------------------------------
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gr_v_scal_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gr_v_scal_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gr_v_scal_loc.f90	(revision 5117)
@@ -49,6 +49,6 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -62,5 +62,5 @@
 !$OMP ENDDO NOWAIT
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l=1,nx
@@ -70,7 +70,7 @@
     ENDDO
 !$OMP ENDDO NOWAIT
-  endif
+  ENDIF
 
-  if (pole_sud) THEN
+  IF (pole_sud) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l=1,nx
@@ -80,5 +80,5 @@
     ENDDO
 !$OMP ENDDO NOWAIT
-  endif
+  ENDIF
 
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/grad_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/grad_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/grad_loc.f90	(revision 5117)
@@ -40,6 +40,6 @@
   ijb=ij_begin-iip1
   ije=ij_end
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij = ijb,ije
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/grad_p.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/grad_p.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/grad_p.f90	(revision 5117)
@@ -40,6 +40,6 @@
   ijb=ij_begin-iip1
   ije=ij_end
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij = ijb,ije
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gradiv2_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gradiv2_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gradiv2_loc.f90	(revision 5117)
@@ -133,10 +133,10 @@
    DO   l = 1, klevel
 
-     if (pole_sud) ije=ij_end
+     IF (pole_sud) ije=ij_end
      DO  ij = ijb, ije
       gdx_out( ij,l ) = gdx( ij,l ) * nugrads
      ENDDO
 
-     if (pole_sud) ije=ij_end-iip1
+     IF (pole_sud) ije=ij_end-iip1
      DO  ij = ijb, ije
       gdy_out( ij,l ) = gdy( ij,l ) * nugrads
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/groupe_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/groupe_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/groupe_loc.f90	(revision 5117)
@@ -35,5 +35,5 @@
   INTEGER :: i, j, l
 
-  logical :: firstcall
+  LOGICAL :: firstcall
   save firstcall
   !$OMP THREADPRIVATE(firstcall)
@@ -62,6 +62,6 @@
   jjb = jj_begin - 1
   jje = jj_end
-  if (pole_nord) jjb = jj_begin
-  if (pole_sud)  jje = jj_end - 1
+  IF (pole_nord) jjb = jj_begin
+  IF (pole_sud)  jje = jj_end - 1
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
   do l = 1, llm
@@ -81,6 +81,6 @@
   jjb = jj_begin
   jje = jj_end
-  if (pole_nord) jjb = jj_begin + 1
-  if (pole_sud)  jje = jj_end - 1
+  IF (pole_nord) jjb = jj_begin + 1
+  IF (pole_sud)  jje = jj_end - 1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -113,8 +113,8 @@
   enddo
 
-  if (.not. pole_sud) THEN
+  IF (.NOT. pole_sud) THEN
     zconvmm(:, jj_end + 1, :) = 0
     !ym	wm(:,jj_end+1,:)=0
-  endif
+  ENDIF
 
   !$OMP END MASTER
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/guide_loc_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/guide_loc_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/guide_loc_mod.F90	(revision 5117)
@@ -1,12 +1,12 @@
 MODULE guide_loc_mod
 
-!=======================================================================
-!   Auteur:  F.Hourdin
-!            F. Codron 01/09
-!=======================================================================
+  !=======================================================================
+  !   Auteur:  F.Hourdin
+  !            F. Codron 01/09
+  !=======================================================================
 
   USE getparam, ONLY: ini_getparam, fin_getparam, getpar
   USE Write_Field_loc
-  use netcdf, ONLY: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &
+  USE netcdf, ONLY: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &
           nf90_inq_dimid, nf90_inquire_dimension, nf90_inq_dimid, &
           nf90_inquire_dimension, nf90_enddef, nf90_def_dim, nf90_put_var, nf90_noerr, nf90_close, nf90_inq_varid, &
@@ -14,61 +14,61 @@
           nf90_create, nf90_def_var, nf90_open
   USE parallel_lmdz
-  USE pres2lev_mod, ONLY: pres2lev
+  USE lmdz_pres2lev, ONLY: pres2lev
 
   IMPLICIT NONE
 
-! ---------------------------------------------
-! Declarations des cles logiques et parametres 
-! ---------------------------------------------
-  INTEGER, PRIVATE, SAVE  :: iguide_read,iguide_int,iguide_sav
-  INTEGER, PRIVATE, SAVE  :: nlevnc, guide_plevs
-  LOGICAL, PRIVATE, SAVE  :: guide_u,guide_v,guide_T,guide_Q,guide_P
-  LOGICAL, PRIVATE, SAVE  :: guide_hr,guide_teta  
-  LOGICAL, PRIVATE, SAVE  :: guide_BL,guide_reg,guide_add,gamma4,guide_zon 
-  LOGICAL, PRIVATE, SAVE  :: invert_p,invert_y,ini_anal
-  LOGICAL, PRIVATE, SAVE  :: guide_2D,guide_sav,guide_modele
-!FC
-  LOGICAL, PRIVATE, SAVE  :: convert_Pa
-  
-  REAL, PRIVATE, SAVE     :: tau_min_u,tau_max_u
-  REAL, PRIVATE, SAVE     :: tau_min_v,tau_max_v
-  REAL, PRIVATE, SAVE     :: tau_min_T,tau_max_T
-  REAL, PRIVATE, SAVE     :: tau_min_Q,tau_max_Q
-  REAL, PRIVATE, SAVE     :: tau_min_P,tau_max_P
-
-  REAL, PRIVATE, SAVE     :: lat_min_g,lat_max_g
-  REAL, PRIVATE, SAVE     :: lon_min_g,lon_max_g
-  REAL, PRIVATE, SAVE     :: tau_lon,tau_lat
-
-  REAL, PRIVATE, SAVE     :: plim_guide_BL
-
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE     :: alpha_u,alpha_v 
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE     :: alpha_T,alpha_Q 
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE     :: alpha_P,alpha_pcor
-  
-! ---------------------------------------------
-! Variables de guidage
-! ---------------------------------------------
-! Variables des fichiers de guidage
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: unat1,unat2
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: vnat1,vnat2
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: tnat1,tnat2
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: qnat1,qnat2
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: pnat1,pnat2
-  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: psnat1,psnat2
-  REAL, ALLOCATABLE, DIMENSION(:),     PRIVATE, SAVE   :: apnc,bpnc
-! Variables aux dimensions du modele
-  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: ugui1,ugui2
-  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: vgui1,vgui2
-  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: tgui1,tgui2
-  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: qgui1,qgui2
-  REAL, ALLOCATABLE, DIMENSION(:),   PRIVATE, SAVE   :: psgui1,psgui2
-  
-  INTEGER,SAVE,PRIVATE :: ijbu,ijbv,ijeu,ijev !,ijnu,ijnv
-  INTEGER,SAVE,PRIVATE :: jjbu,jjbv,jjeu,jjev,jjnu,jjnv
+  ! ---------------------------------------------
+  ! Declarations des cles logiques et parametres
+  ! ---------------------------------------------
+  INTEGER, PRIVATE, SAVE :: iguide_read, iguide_int, iguide_sav
+  INTEGER, PRIVATE, SAVE :: nlevnc, guide_plevs
+  LOGICAL, PRIVATE, SAVE :: guide_u, guide_v, guide_T, guide_Q, guide_P
+  LOGICAL, PRIVATE, SAVE :: guide_hr, guide_teta
+  LOGICAL, PRIVATE, SAVE :: guide_BL, guide_reg, guide_add, gamma4, guide_zon
+  LOGICAL, PRIVATE, SAVE :: invert_p, invert_y, ini_anal
+  LOGICAL, PRIVATE, SAVE :: guide_2D, guide_sav, guide_modele
+  !FC
+  LOGICAL, PRIVATE, SAVE :: convert_Pa
+
+  REAL, PRIVATE, SAVE :: tau_min_u, tau_max_u
+  REAL, PRIVATE, SAVE :: tau_min_v, tau_max_v
+  REAL, PRIVATE, SAVE :: tau_min_T, tau_max_T
+  REAL, PRIVATE, SAVE :: tau_min_Q, tau_max_Q
+  REAL, PRIVATE, SAVE :: tau_min_P, tau_max_P
+
+  REAL, PRIVATE, SAVE :: lat_min_g, lat_max_g
+  REAL, PRIVATE, SAVE :: lon_min_g, lon_max_g
+  REAL, PRIVATE, SAVE :: tau_lon, tau_lat
+
+  REAL, PRIVATE, SAVE :: plim_guide_BL
+
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: alpha_u, alpha_v
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: alpha_T, alpha_Q
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: alpha_P, alpha_pcor
+
+  ! ---------------------------------------------
+  ! Variables de guidage
+  ! ---------------------------------------------
+  ! Variables des fichiers de guidage
+  REAL, ALLOCATABLE, DIMENSION(:, :, :), PRIVATE, SAVE :: unat1, unat2
+  REAL, ALLOCATABLE, DIMENSION(:, :, :), PRIVATE, SAVE :: vnat1, vnat2
+  REAL, ALLOCATABLE, DIMENSION(:, :, :), PRIVATE, SAVE :: tnat1, tnat2
+  REAL, ALLOCATABLE, DIMENSION(:, :, :), PRIVATE, SAVE :: qnat1, qnat2
+  REAL, ALLOCATABLE, DIMENSION(:, :, :), PRIVATE, SAVE :: pnat1, pnat2
+  REAL, ALLOCATABLE, DIMENSION(:, :), PRIVATE, SAVE :: psnat1, psnat2
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: apnc, bpnc
+  ! Variables aux dimensions du modele
+  REAL, ALLOCATABLE, DIMENSION(:, :), PRIVATE, SAVE :: ugui1, ugui2
+  REAL, ALLOCATABLE, DIMENSION(:, :), PRIVATE, SAVE :: vgui1, vgui2
+  REAL, ALLOCATABLE, DIMENSION(:, :), PRIVATE, SAVE :: tgui1, tgui2
+  REAL, ALLOCATABLE, DIMENSION(:, :), PRIVATE, SAVE :: qgui1, qgui2
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: psgui1, psgui2
+
+  INTEGER, SAVE, PRIVATE :: ijbu, ijbv, ijeu, ijev !,ijnu,ijnv
+  INTEGER, SAVE, PRIVATE :: jjbu, jjbv, jjeu, jjev, jjnu, jjnv
 
 
 CONTAINS
-!=======================================================================
+  !=======================================================================
 
   SUBROUTINE guide_init
@@ -78,286 +78,281 @@
 
     IMPLICIT NONE
-  
+
     INCLUDE "dimensions.h"
     INCLUDE "paramet.h"
 
-    INTEGER                :: error,ncidpl,rid,rcod
-    CHARACTER (len = 80)   :: abort_message
-    CHARACTER (len = 20)   :: modname = 'guide_init'
-    CHARACTER (len = 20)   :: namedim
-
-! ---------------------------------------------
-! Lecture des parametres:  
-! ---------------------------------------------
+    INTEGER :: error, ncidpl, rid, rcod
+    CHARACTER (len = 80) :: abort_message
+    CHARACTER (len = 20) :: modname = 'guide_init'
+    CHARACTER (len = 20) :: namedim
+
+    ! ---------------------------------------------
+    ! Lecture des parametres:
+    ! ---------------------------------------------
     CALL ini_getparam("nudging_parameters_out.txt")
-! Variables guidees
-    CALL getpar('guide_u',.TRUE.,guide_u,'guidage de u')
-    CALL getpar('guide_v',.TRUE.,guide_v,'guidage de v')
-    CALL getpar('guide_T',.TRUE.,guide_T,'guidage de T')
-    CALL getpar('guide_P',.TRUE.,guide_P,'guidage de P')
-    CALL getpar('guide_Q',.TRUE.,guide_Q,'guidage de Q')
-    CALL getpar('guide_hr',.TRUE.,guide_hr,'guidage de Q par H.R')
-    CALL getpar('guide_teta',.FALSE.,guide_teta,'guidage de T par Teta')
-
-    CALL getpar('guide_add',.FALSE.,guide_add,'foréage constant?')
-    CALL getpar('guide_zon',.FALSE.,guide_zon,'guidage moy zonale')
-    if (guide_zon .and. abs(grossismx - 1.) > 0.01) &
-         CALL abort_gcm("guide_init", &
-         "zonal nudging requires grid regular in longitude", 1)
-
-!   Constantes de rappel. Unite : fraction de jour
-    CALL getpar('tau_min_u',0.02,tau_min_u,'Cste de rappel min, u')
-    CALL getpar('tau_max_u', 10.,tau_max_u,'Cste de rappel max, u')
-    CALL getpar('tau_min_v',0.02,tau_min_v,'Cste de rappel min, v')
-    CALL getpar('tau_max_v', 10.,tau_max_v,'Cste de rappel max, v')
-    CALL getpar('tau_min_T',0.02,tau_min_T,'Cste de rappel min, T')
-    CALL getpar('tau_max_T', 10.,tau_max_T,'Cste de rappel max, T')
-    CALL getpar('tau_min_Q',0.02,tau_min_Q,'Cste de rappel min, Q')
-    CALL getpar('tau_max_Q', 10.,tau_max_Q,'Cste de rappel max, Q')
-    CALL getpar('tau_min_P',0.02,tau_min_P,'Cste de rappel min, P')
-    CALL getpar('tau_max_P', 10.,tau_max_P,'Cste de rappel max, P')
-    CALL getpar('gamma4',.FALSE.,gamma4,'Zone sans rappel elargie')
-    CALL getpar('guide_BL',.TRUE.,guide_BL,'guidage dans C.Lim')
-    CALL getpar('plim_guide_BL',85000.,plim_guide_BL,'BL top presnivs value')
-
-! Sauvegarde du forçage
-    CALL getpar('guide_sav',.FALSE.,guide_sav,'sauvegarde guidage')
-    CALL getpar('iguide_sav',4,iguide_sav,'freq. sauvegarde guidage')
+    ! Variables guidees
+    CALL getpar('guide_u', .TRUE., guide_u, 'guidage de u')
+    CALL getpar('guide_v', .TRUE., guide_v, 'guidage de v')
+    CALL getpar('guide_T', .TRUE., guide_T, 'guidage de T')
+    CALL getpar('guide_P', .TRUE., guide_P, 'guidage de P')
+    CALL getpar('guide_Q', .TRUE., guide_Q, 'guidage de Q')
+    CALL getpar('guide_hr', .TRUE., guide_hr, 'guidage de Q par H.R')
+    CALL getpar('guide_teta', .FALSE., guide_teta, 'guidage de T par Teta')
+
+    CALL getpar('guide_add', .FALSE., guide_add, 'foréage constant?')
+    CALL getpar('guide_zon', .FALSE., guide_zon, 'guidage moy zonale')
+    IF (guide_zon .AND. abs(grossismx - 1.) > 0.01) &
+            CALL abort_gcm("guide_init", &
+                    "zonal nudging requires grid regular in longitude", 1)
+
+    !   Constantes de rappel. Unite : fraction de jour
+    CALL getpar('tau_min_u', 0.02, tau_min_u, 'Cste de rappel min, u')
+    CALL getpar('tau_max_u', 10., tau_max_u, 'Cste de rappel max, u')
+    CALL getpar('tau_min_v', 0.02, tau_min_v, 'Cste de rappel min, v')
+    CALL getpar('tau_max_v', 10., tau_max_v, 'Cste de rappel max, v')
+    CALL getpar('tau_min_T', 0.02, tau_min_T, 'Cste de rappel min, T')
+    CALL getpar('tau_max_T', 10., tau_max_T, 'Cste de rappel max, T')
+    CALL getpar('tau_min_Q', 0.02, tau_min_Q, 'Cste de rappel min, Q')
+    CALL getpar('tau_max_Q', 10., tau_max_Q, 'Cste de rappel max, Q')
+    CALL getpar('tau_min_P', 0.02, tau_min_P, 'Cste de rappel min, P')
+    CALL getpar('tau_max_P', 10., tau_max_P, 'Cste de rappel max, P')
+    CALL getpar('gamma4', .FALSE., gamma4, 'Zone sans rappel elargie')
+    CALL getpar('guide_BL', .TRUE., guide_BL, 'guidage dans C.Lim')
+    CALL getpar('plim_guide_BL', 85000., plim_guide_BL, 'BL top presnivs value')
+
+    ! Sauvegarde du forçage
+    CALL getpar('guide_sav', .FALSE., guide_sav, 'sauvegarde guidage')
+    CALL getpar('iguide_sav', 4, iguide_sav, 'freq. sauvegarde guidage')
     ! frequences f>0: fx/jour; f<0: tous les f jours; f=0: 1 seule fois.
     IF (iguide_sav>0) THEN
-       iguide_sav=day_step/iguide_sav
+      iguide_sav = day_step / iguide_sav
     ELSE if (iguide_sav == 0) THEN
-       iguide_sav = huge(0)
+      iguide_sav = huge(0)
     ELSE
-       iguide_sav=day_step*iguide_sav
-    ENDIF
-
-! Guidage regional seulement (sinon constant ou suivant le zoom)
-    CALL getpar('guide_reg',.FALSE.,guide_reg,'guidage regional')
-    CALL getpar('lat_min_g',-90.,lat_min_g,'Latitude mini guidage ')
-    CALL getpar('lat_max_g', 90.,lat_max_g,'Latitude maxi guidage ')
-    CALL getpar('lon_min_g',-180.,lon_min_g,'longitude mini guidage ')
-    CALL getpar('lon_max_g', 180.,lon_max_g,'longitude maxi guidage ')
-    CALL getpar('tau_lat', 5.,tau_lat,'raideur lat guide regional ')
-    CALL getpar('tau_lon', 5.,tau_lon,'raideur lon guide regional ')
-
-! Parametres pour lecture des fichiers
-    CALL getpar('iguide_read',4,iguide_read,'freq. lecture guidage')
-    CALL getpar('iguide_int',4,iguide_int,'freq. interpolation vert')
+      iguide_sav = day_step * iguide_sav
+    ENDIF
+
+    ! Guidage regional seulement (sinon constant ou suivant le zoom)
+    CALL getpar('guide_reg', .FALSE., guide_reg, 'guidage regional')
+    CALL getpar('lat_min_g', -90., lat_min_g, 'Latitude mini guidage ')
+    CALL getpar('lat_max_g', 90., lat_max_g, 'Latitude maxi guidage ')
+    CALL getpar('lon_min_g', -180., lon_min_g, 'longitude mini guidage ')
+    CALL getpar('lon_max_g', 180., lon_max_g, 'longitude maxi guidage ')
+    CALL getpar('tau_lat', 5., tau_lat, 'raideur lat guide regional ')
+    CALL getpar('tau_lon', 5., tau_lon, 'raideur lon guide regional ')
+
+    ! Parametres pour lecture des fichiers
+    CALL getpar('iguide_read', 4, iguide_read, 'freq. lecture guidage')
+    CALL getpar('iguide_int', 4, iguide_int, 'freq. interpolation vert')
     IF (iguide_int==0) THEN
-        iguide_int=1
+      iguide_int = 1
     ELSEIF (iguide_int>0) THEN
-        iguide_int=day_step/iguide_int
+      iguide_int = day_step / iguide_int
     ELSE
-        iguide_int=day_step*iguide_int
-    ENDIF
-    CALL getpar('guide_plevs',0,guide_plevs,'niveaux pression fichiers guidage')
+      iguide_int = day_step * iguide_int
+    ENDIF
+    CALL getpar('guide_plevs', 0, guide_plevs, 'niveaux pression fichiers guidage')
     ! Pour compatibilite avec ancienne version avec guide_modele
-    CALL getpar('guide_modele',.FALSE.,guide_modele,'niveaux pression ap+bp*psol')
+    CALL getpar('guide_modele', .FALSE., guide_modele, 'niveaux pression ap+bp*psol')
     IF (guide_modele) THEN
-        guide_plevs=1
-    ENDIF
-!FC
-    CALL getpar('convert_Pa',.TRUE.,convert_Pa,'Convert Pressure levels in Pa')
+      guide_plevs = 1
+    ENDIF
+    !FC
+    CALL getpar('convert_Pa', .TRUE., convert_Pa, 'Convert Pressure levels in Pa')
     ! Fin raccord
-    CALL getpar('ini_anal',.FALSE.,ini_anal,'Etat initial = analyse')
-    CALL getpar('guide_invertp',.TRUE.,invert_p,'niveaux p inverses')
-    CALL getpar('guide_inverty',.TRUE.,invert_y,'inversion N-S')
-    CALL getpar('guide_2D',.FALSE.,guide_2D,'fichier guidage lat-P')
+    CALL getpar('ini_anal', .FALSE., ini_anal, 'Etat initial = analyse')
+    CALL getpar('guide_invertp', .TRUE., invert_p, 'niveaux p inverses')
+    CALL getpar('guide_inverty', .TRUE., invert_y, 'inversion N-S')
+    CALL getpar('guide_2D', .FALSE., guide_2D, 'fichier guidage lat-P')
 
     CALL fin_getparam
-    
-! ---------------------------------------------
-! Determination du nombre de niveaux verticaux
-! des fichiers guidage
-! ---------------------------------------------
-    ncidpl=-99
-    if (guide_plevs==1) THEN
-       if (ncidpl==-99) THEN
-          rcod=nf90_open('apbp.nc',nf90_nowrite, ncidpl)
-          if (rcod/=nf90_noerr) THEN
-             abort_message=' Nudging error -> no file apbp.nc'
-             CALL abort_gcm(modname,abort_message,1)
-          endif
-       endif
+
+    ! ---------------------------------------------
+    ! Determination du nombre de niveaux verticaux
+    ! des fichiers guidage
+    ! ---------------------------------------------
+    ncidpl = -99
+    IF (guide_plevs==1) THEN
+      IF (ncidpl==-99) THEN
+        rcod = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
+        IF (rcod/=nf90_noerr) THEN
+          abort_message = ' Nudging error -> no file apbp.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        endif
+      endif
     elseif (guide_plevs==2) THEN
-       if (ncidpl==-99) THEN
-          rcod=nf90_open('P.nc',nf90_nowrite,ncidpl)
-          if (rcod/=nf90_noerr) THEN
-             abort_message=' Nudging error -> no file P.nc'
-             CALL abort_gcm(modname,abort_message,1)
-          endif
-       endif
+      IF (ncidpl==-99) THEN
+        rcod = nf90_open('P.nc', nf90_nowrite, ncidpl)
+        IF (rcod/=nf90_noerr) THEN
+          abort_message = ' Nudging error -> no file P.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        endif
+      endif
 
     elseif (guide_u) THEN
-       if (ncidpl==-99) THEN
-          rcod=nf90_open('u.nc',nf90_nowrite,ncidpl)
-          if (rcod/=nf90_noerr) THEN
-             abort_message=' Nudging error -> no file u.nc'
-             CALL abort_gcm(modname,abort_message,1)
-          endif
-          
-       endif
-
+      IF (ncidpl==-99) THEN
+        rcod = nf90_open('u.nc', nf90_nowrite, ncidpl)
+        IF (rcod/=nf90_noerr) THEN
+          abort_message = ' Nudging error -> no file u.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        endif
+
+      endif
 
     elseif (guide_v) THEN
-       if (ncidpl==-99) THEN
-          rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
-          if (rcod/=nf90_noerr) THEN
-             abort_message=' Nudging error -> no file v.nc'
-             CALL abort_gcm(modname,abort_message,1)
-          endif
-       endif
-
-    
+      IF (ncidpl==-99) THEN
+        rcod = nf90_open('v.nc', nf90_nowrite, ncidpl)
+        IF (rcod/=nf90_noerr) THEN
+          abort_message = ' Nudging error -> no file v.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        endif
+      endif
+
     elseif (guide_T) THEN
-       if (ncidpl==-99) THEN
-          rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
-          if (rcod/=nf90_noerr) THEN
-             abort_message=' Nudging error -> no file T.nc'
-             CALL abort_gcm(modname,abort_message,1)
-          endif
-       endif
-
-
+      IF (ncidpl==-99) THEN
+        rcod = nf90_open('T.nc', nf90_nowrite, ncidpl)
+        IF (rcod/=nf90_noerr) THEN
+          abort_message = ' Nudging error -> no file T.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        endif
+      endif
 
     elseif (guide_Q) THEN
-       if (ncidpl==-99) THEN
-          rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
-          if (rcod/=nf90_noerr) THEN
-             abort_message=' Nudging error -> no file hur.nc'
-             CALL abort_gcm(modname,abort_message,1)
-          endif
-       endif
-
-
-    endif 
-    error=nf90_inq_dimid(ncidpl,'LEVEL',rid)
-    IF (error/=nf90_noerr) error=nf90_inq_dimid(ncidpl,'PRESSURE',rid)
+      IF (ncidpl==-99) THEN
+        rcod = nf90_open('hur.nc', nf90_nowrite, ncidpl)
+        IF (rcod/=nf90_noerr) THEN
+          abort_message = ' Nudging error -> no file hur.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        endif
+      endif
+
+    endif
+    error = nf90_inq_dimid(ncidpl, 'LEVEL', rid)
+    IF (error/=nf90_noerr) error = nf90_inq_dimid(ncidpl, 'PRESSURE', rid)
     IF (error/=nf90_noerr) THEN
-        abort_message='Nudging: error reading pressure levels'
-        CALL abort_gcm(modname,abort_message,1)
-    ENDIF
-    error=nf90_inquire_dimension(ncidpl,rid,len=nlevnc)
-    WRITE(*,*)trim(modname)//' : number of vertical levels nlevnc', nlevnc
+      abort_message = 'Nudging: error reading pressure levels'
+      CALL abort_gcm(modname, abort_message, 1)
+    ENDIF
+    error = nf90_inquire_dimension(ncidpl, rid, len = nlevnc)
+    WRITE(*, *)trim(modname) // ' : number of vertical levels nlevnc', nlevnc
     rcod = nf90_close(ncidpl)
 
-! ---------------------------------------------
-! Allocation des variables
-! ---------------------------------------------
-    abort_message='nudging allocation error'
+    ! ---------------------------------------------
+    ! Allocation des variables
+    ! ---------------------------------------------
+    abort_message = 'nudging allocation error'
 
     ALLOCATE(apnc(nlevnc), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
+    IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
     ALLOCATE(bpnc(nlevnc), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-    apnc=0.;bpnc=0.
+    IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+    apnc = 0.;bpnc = 0.
 
     ALLOCATE(alpha_pcor(llm), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
+    IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
     ALLOCATE(alpha_u(ijb_u:ije_u), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
+    IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
     ALLOCATE(alpha_v(ijb_v:ije_v), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
+    IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
     ALLOCATE(alpha_T(ijb_u:ije_u), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
+    IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
     ALLOCATE(alpha_Q(ijb_u:ije_u), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
+    IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
     ALLOCATE(alpha_P(ijb_u:ije_u), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-    alpha_u=0.;alpha_v=0;alpha_T=0;alpha_Q=0;alpha_P=0
-    
+    IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+    alpha_u = 0.;alpha_v = 0;alpha_T = 0;alpha_Q = 0;alpha_P = 0
+
     IF (guide_u) THEN
-        ALLOCATE(unat1(iip1,jjb_u:jje_u,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(ugui1(ijb_u:ije_u,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(unat2(iip1,jjb_u:jje_u,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(ugui2(ijb_u:ije_u,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        unat1=0.;unat2=0.;ugui1=0.;ugui2=0.
+      ALLOCATE(unat1(iip1, jjb_u:jje_u, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(ugui1(ijb_u:ije_u, llm), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(unat2(iip1, jjb_u:jje_u, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(ugui2(ijb_u:ije_u, llm), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      unat1 = 0.;unat2 = 0.;ugui1 = 0.;ugui2 = 0.
     ENDIF
 
     IF (guide_T) THEN
-        ALLOCATE(tnat1(iip1,jjb_u:jje_u,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(tgui1(ijb_u:ije_u,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(tnat2(iip1,jjb_u:jje_u,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(tgui2(ijb_u:ije_u,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        tnat1=0.;tnat2=0.;tgui1=0.;tgui2=0.
-    ENDIF
-     
+      ALLOCATE(tnat1(iip1, jjb_u:jje_u, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(tgui1(ijb_u:ije_u, llm), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(tnat2(iip1, jjb_u:jje_u, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(tgui2(ijb_u:ije_u, llm), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      tnat1 = 0.;tnat2 = 0.;tgui1 = 0.;tgui2 = 0.
+    ENDIF
+
     IF (guide_Q) THEN
-        ALLOCATE(qnat1(iip1,jjb_u:jje_u,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(qgui1(ijb_u:ije_u,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(qnat2(iip1,jjb_u:jje_u,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(qgui2(ijb_u:ije_u,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        qnat1=0.;qnat2=0.;qgui1=0.;qgui2=0.
+      ALLOCATE(qnat1(iip1, jjb_u:jje_u, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(qgui1(ijb_u:ije_u, llm), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(qnat2(iip1, jjb_u:jje_u, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(qgui2(ijb_u:ije_u, llm), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      qnat1 = 0.;qnat2 = 0.;qgui1 = 0.;qgui2 = 0.
     ENDIF
 
     IF (guide_v) THEN
-        ALLOCATE(vnat1(iip1,jjb_v:jje_v,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(vgui1(ijb_v:ije_v,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(vnat2(iip1,jjb_v:jje_v,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(vgui2(ijb_v:ije_v,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        vnat1=0.;vnat2=0.;vgui1=0.;vgui2=0.
+      ALLOCATE(vnat1(iip1, jjb_v:jje_v, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(vgui1(ijb_v:ije_v, llm), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(vnat2(iip1, jjb_v:jje_v, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(vgui2(ijb_v:ije_v, llm), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      vnat1 = 0.;vnat2 = 0.;vgui1 = 0.;vgui2 = 0.
     ENDIF
 
     IF (guide_plevs==2) THEN
-        ALLOCATE(pnat1(iip1,jjb_u:jje_u,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(pnat2(iip1,jjb_u:jje_u,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        pnat1=0.;pnat2=0.;
+      ALLOCATE(pnat1(iip1, jjb_u:jje_u, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(pnat2(iip1, jjb_u:jje_u, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      pnat1 = 0.;pnat2 = 0.;
     ENDIF
 
     IF (guide_P.OR.guide_plevs==1) THEN
-        ALLOCATE(psnat1(iip1,jjb_u:jje_u), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(psnat2(iip1,jjb_u:jje_u), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        psnat1=0.;psnat2=0.;
+      ALLOCATE(psnat1(iip1, jjb_u:jje_u), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(psnat2(iip1, jjb_u:jje_u), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      psnat1 = 0.;psnat2 = 0.;
     ENDIF
     IF (guide_P) THEN
-        ALLOCATE(psgui2(ijb_u:ije_u), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(psgui1(ijb_u:ije_u), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        psgui1=0.;psgui2=0.
-    ENDIF
-
-! ---------------------------------------------
-!   Lecture du premier etat de guidage.
-! ---------------------------------------------
+      ALLOCATE(psgui2(ijb_u:ije_u), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(psgui1(ijb_u:ije_u), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      psgui1 = 0.;psgui2 = 0.
+    ENDIF
+
+    ! ---------------------------------------------
+    !   Lecture du premier etat de guidage.
+    ! ---------------------------------------------
     IF (guide_2D) THEN
-        CALL guide_read2D(1)
+      CALL guide_read2D(1)
     ELSE
-        CALL guide_read(1)
-    ENDIF
-    IF (guide_v) vnat1=vnat2
-    IF (guide_u) unat1=unat2
-    IF (guide_T) tnat1=tnat2
-    IF (guide_Q) qnat1=qnat2
-    IF (guide_plevs==2) pnat1=pnat2
-    IF (guide_P.OR.guide_plevs==1) psnat1=psnat2
+      CALL guide_read(1)
+    ENDIF
+    IF (guide_v) vnat1 = vnat2
+    IF (guide_u) unat1 = unat2
+    IF (guide_T) tnat1 = tnat2
+    IF (guide_Q) qnat1 = qnat2
+    IF (guide_plevs==2) pnat1 = pnat2
+    IF (guide_P.OR.guide_plevs==1) psnat1 = psnat2
 
   END SUBROUTINE guide_init
 
-!=======================================================================
-  SUBROUTINE guide_main(itau,ucov,vcov,teta,q,masse,ps)
-    use exner_hyb_loc_m, ONLY: exner_hyb_loc
-    use exner_milieu_loc_m, ONLY: exner_milieu_loc
+  !=======================================================================
+  SUBROUTINE guide_main(itau, ucov, vcov, teta, q, masse, ps)
+    USE exner_hyb_loc_m, ONLY: exner_hyb_loc
+    USE exner_milieu_loc_m, ONLY: exner_milieu_loc
     USE parallel_lmdz
     USE control_mod
@@ -365,357 +360,357 @@
     USE comconst_mod, ONLY: cpp, daysec, dtvr, kappa
     USE comvert_mod, ONLY: ap, bp, preff, presnivs, pressure_exner
-    
+
     IMPLICIT NONE
-  
+
     INCLUDE "dimensions.h"
     INCLUDE "paramet.h"
 
     ! Variables entree
-    INTEGER,                           INTENT(IN)    :: itau !pas de temps
-    REAL, DIMENSION (ijb_u:ije_u,llm), INTENT(INOUT) :: ucov,teta,q,masse
-    REAL, DIMENSION (ijb_v:ije_v,llm), INTENT(INOUT) :: vcov
-    REAL, DIMENSION (ijb_u:ije_u),     INTENT(INOUT) :: ps
+    INTEGER, INTENT(IN) :: itau !pas de temps
+    REAL, DIMENSION (ijb_u:ije_u, llm), INTENT(INOUT) :: ucov, teta, q, masse
+    REAL, DIMENSION (ijb_v:ije_v, llm), INTENT(INOUT) :: vcov
+    REAL, DIMENSION (ijb_u:ije_u), INTENT(INOUT) :: ps
 
     ! Variables locales
-    LOGICAL, SAVE :: first=.TRUE.
-!$OMP THREADPRIVATE(first)
-    LOGICAL       :: f_out ! sortie guidage
-    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: f_addu ! var aux: champ de guidage
-    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: f_addv ! var aux: champ de guidage
+    LOGICAL, SAVE :: first = .TRUE.
+    !$OMP THREADPRIVATE(first)
+    LOGICAL :: f_out ! sortie guidage
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :) :: f_addu ! var aux: champ de guidage
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :) :: f_addv ! var aux: champ de guidage
     ! Variables pour fonction Exner (P milieu couche)
-    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:)    :: pk
-    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:)        :: pks    
-    REAL                               :: unskap
-    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:)    :: p ! besoin si guide_P
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: pk
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :) :: pks
+    REAL :: unskap
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :) :: p ! besoin si guide_P
     ! Compteurs temps:
-    INTEGER, SAVE :: step_rea,count_no_rea,itau_test ! lecture guidage
-!$OMP THREADPRIVATE(step_rea,count_no_rea,itau_test)
-    REAL          :: ditau, dday_step
-    REAL          :: tau,reste ! position entre 2 etats de guidage
-    REAL, SAVE    :: factt ! pas de temps en fraction de jour
-!$OMP THREADPRIVATE(factt)
-    
-    INTEGER       :: i,j,l
-    CHARACTER(LEN=20) :: modname="guide_main"
-       
-!$OMP MASTER    
-    ijbu=ij_begin ; ijeu=ij_end
-    jjbu=jj_begin ; jjeu=jj_end ; jjnu=jjeu-jjbu+1 
-    ijbv=ij_begin ; ijev=ij_end
-    jjbv=jj_begin ; jjev=jj_end ; jjnv=jjev-jjbv+1 
+    INTEGER, SAVE :: step_rea, count_no_rea, itau_test ! lecture guidage
+    !$OMP THREADPRIVATE(step_rea,count_no_rea,itau_test)
+    REAL :: ditau, dday_step
+    REAL :: tau, reste ! position entre 2 etats de guidage
+    REAL, SAVE :: factt ! pas de temps en fraction de jour
+    !$OMP THREADPRIVATE(factt)
+
+    INTEGER :: i, j, l
+    CHARACTER(LEN = 20) :: modname = "guide_main"
+
+    !$OMP MASTER
+    ijbu = ij_begin ; ijeu = ij_end
+    jjbu = jj_begin ; jjeu = jj_end ; jjnu = jjeu - jjbu + 1
+    ijbv = ij_begin ; ijev = ij_end
+    jjbv = jj_begin ; jjev = jj_end ; jjnv = jjev - jjbv + 1
     IF (pole_sud) THEN
-      ijeu=ij_end-iip1
-      ijev=ij_end-iip1
-      jjev=jj_end-1
-      jjnv=jjev-jjbv+1 
+      ijeu = ij_end - iip1
+      ijev = ij_end - iip1
+      jjev = jj_end - 1
+      jjnv = jjev - jjbv + 1
     ENDIF
     IF (pole_nord) THEN
-      ijbu=ij_begin+iip1
-      ijbv=ij_begin
-    ENDIF
-!$OMP END MASTER
-!$OMP BARRIER
-      
-!    PRINT *,'---> on rentre dans guide_main'
-!    CALL AllGather_Field(ucov,ip1jmp1,llm)
-!    CALL AllGather_Field(vcov,ip1jm,llm)
-!    CALL AllGather_Field(teta,ip1jmp1,llm)
-!    CALL AllGather_Field(ps,ip1jmp1,1)
-!    CALL AllGather_Field(q,ip1jmp1,llm)
-    
-!-----------------------------------------------------------------------
-! Initialisations au premier passage
-!-----------------------------------------------------------------------
+      ijbu = ij_begin + iip1
+      ijbv = ij_begin
+    ENDIF
+    !$OMP END MASTER
+    !$OMP BARRIER
+
+    !    PRINT *,'---> on rentre dans guide_main'
+    !    CALL AllGather_Field(ucov,ip1jmp1,llm)
+    !    CALL AllGather_Field(vcov,ip1jm,llm)
+    !    CALL AllGather_Field(teta,ip1jmp1,llm)
+    !    CALL AllGather_Field(ps,ip1jmp1,1)
+    !    CALL AllGather_Field(q,ip1jmp1,llm)
+
+    !-----------------------------------------------------------------------
+    ! Initialisations au premier passage
+    !-----------------------------------------------------------------------
 
     IF (first) THEN
-        first=.FALSE.
-!$OMP MASTER
-        ALLOCATE(f_addu(ijb_u:ije_u,llm) ) 
-        ALLOCATE(f_addv(ijb_v:ije_v,llm) ) 
-        ALLOCATE(pk(iip1,jjb_u:jje_u,llm)  ) 
-        ALLOCATE(pks(iip1,jjb_u:jje_u)  ) 
-        ALLOCATE(p(ijb_u:ije_u,llmp1) ) 
-        CALL guide_init 
-!$OMP END MASTER
-!$OMP BARRIER
-        itau_test=1001
-        step_rea=1
-        count_no_rea=0
-! Calcul des constantes de rappel
-        factt=dtvr*iperiod/daysec 
-!$OMP MASTER
-        CALL tau2alpha(3, iip1, jjb_v, jje_v, factt, tau_min_v, tau_max_v, alpha_v)
-        CALL tau2alpha(2, iip1, jjb_u, jje_u, factt, tau_min_u, tau_max_u, alpha_u)
-        CALL tau2alpha(1, iip1, jjb_u, jje_u, factt, tau_min_T, tau_max_T, alpha_T)
-        CALL tau2alpha(1, iip1, jjb_u, jje_u, factt, tau_min_P, tau_max_P, alpha_P)
-        CALL tau2alpha(1, iip1, jjb_u, jje_u, factt, tau_min_Q, tau_max_Q, alpha_Q)
-! correction de rappel dans couche limite
-        if (guide_BL) THEN
-             alpha_pcor(:)=1.
-        else
-            do l=1,llm
-                alpha_pcor(l)=(1.+tanh(((plim_guide_BL-presnivs(l))/preff)/0.05))/2.
-            enddo
-        endif
-!$OMP END MASTER
-!$OMP BARRIER
-! ini_anal: etat initial egal au guidage        
-        IF (ini_anal) THEN
-            CALL guide_interp(ps,teta)
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)            
-            DO l=1,llm
-              IF (guide_u) ucov(ijbu:ijeu,l)=ugui2(ijbu:ijeu,l)
-              IF (guide_v) vcov(ijbv:ijev,l)=ugui2(ijbv:ijev,l)
-              IF (guide_T) teta(ijbu:ijeu,l)=tgui2(ijbu:ijeu,l)
-              IF (guide_Q) q(ijbu:ijeu,l)=qgui2(ijbu:ijeu,l)
-            ENDDO
-            
-            IF (guide_P) THEN
-!$OMP MASTER
-                ps(ijbu:ijeu)=psgui2(ijbu:ijeu)
-!$OMP END MASTER
-!$OMP BARRIER
-                CALL pression_loc(ijnb_u,ap,bp,ps,p)
-                CALL massdair_loc(p,masse)
-!$OMP BARRIER
-            ENDIF
-            RETURN
-        ENDIF
+      first = .FALSE.
+      !$OMP MASTER
+      ALLOCATE(f_addu(ijb_u:ije_u, llm))
+      ALLOCATE(f_addv(ijb_v:ije_v, llm))
+      ALLOCATE(pk(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(pks(iip1, jjb_u:jje_u))
+      ALLOCATE(p(ijb_u:ije_u, llmp1))
+      CALL guide_init
+      !$OMP END MASTER
+      !$OMP BARRIER
+      itau_test = 1001
+      step_rea = 1
+      count_no_rea = 0
+      ! Calcul des constantes de rappel
+      factt = dtvr * iperiod / daysec
+      !$OMP MASTER
+      CALL tau2alpha(3, iip1, jjb_v, jje_v, factt, tau_min_v, tau_max_v, alpha_v)
+      CALL tau2alpha(2, iip1, jjb_u, jje_u, factt, tau_min_u, tau_max_u, alpha_u)
+      CALL tau2alpha(1, iip1, jjb_u, jje_u, factt, tau_min_T, tau_max_T, alpha_T)
+      CALL tau2alpha(1, iip1, jjb_u, jje_u, factt, tau_min_P, tau_max_P, alpha_P)
+      CALL tau2alpha(1, iip1, jjb_u, jje_u, factt, tau_min_Q, tau_max_Q, alpha_Q)
+      ! correction de rappel dans couche limite
+      IF (guide_BL) THEN
+        alpha_pcor(:) = 1.
+      else
+        do l = 1, llm
+          alpha_pcor(l) = (1. + tanh(((plim_guide_BL - presnivs(l)) / preff) / 0.05)) / 2.
+        enddo
+      endif
+      !$OMP END MASTER
+      !$OMP BARRIER
+      ! ini_anal: etat initial egal au guidage
+      IF (ini_anal) THEN
+        CALL guide_interp(ps, teta)
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l = 1, llm
+          IF (guide_u) ucov(ijbu:ijeu, l) = ugui2(ijbu:ijeu, l)
+          IF (guide_v) vcov(ijbv:ijev, l) = ugui2(ijbv:ijev, l)
+          IF (guide_T) teta(ijbu:ijeu, l) = tgui2(ijbu:ijeu, l)
+          IF (guide_Q) q(ijbu:ijeu, l) = qgui2(ijbu:ijeu, l)
+        ENDDO
+
+        IF (guide_P) THEN
+          !$OMP MASTER
+          ps(ijbu:ijeu) = psgui2(ijbu:ijeu)
+          !$OMP END MASTER
+          !$OMP BARRIER
+          CALL pression_loc(ijnb_u, ap, bp, ps, p)
+          CALL massdair_loc(p, masse)
+          !$OMP BARRIER
+        ENDIF
+        RETURN
+      ENDIF
 
     ENDIF !first
 
-!-----------------------------------------------------------------------
-! Lecture des fichiers de guidage ?
-!-----------------------------------------------------------------------
+    !-----------------------------------------------------------------------
+    ! Lecture des fichiers de guidage ?
+    !-----------------------------------------------------------------------
     IF (iguide_read/=0) THEN
-      ditau=real(itau)
-      dday_step=real(day_step)
+      ditau = real(itau)
+      dday_step = real(day_step)
       IF (iguide_read<0) THEN
-          tau=ditau/dday_step/REAL(iguide_read)
+        tau = ditau / dday_step / REAL(iguide_read)
       ELSE
-          tau=REAL(iguide_read)*ditau/dday_step
-      ENDIF
-      reste=tau-AINT(tau)
+        tau = REAL(iguide_read) * ditau / dday_step
+      ENDIF
+      reste = tau - AINT(tau)
       IF (reste==0.) THEN
-          IF (itau_test==itau) THEN
-            WRITE(*,*)trim(modname)//' second pass in advreel at itau=',&
-            itau
-            CALL abort_gcm("guide_loc_lod","stopped",1)
+        IF (itau_test==itau) THEN
+          WRITE(*, *)trim(modname) // ' second pass in advreel at itau=', &
+                  itau
+          CALL abort_gcm("guide_loc_lod", "stopped", 1)
+        ELSE
+          !$OMP MASTER
+          IF (guide_v) vnat1(:, jjbv:jjev, :) = vnat2(:, jjbv:jjev, :)
+          IF (guide_u) unat1(:, jjbu:jjeu, :) = unat2(:, jjbu:jjeu, :)
+          IF (guide_T) tnat1(:, jjbu:jjeu, :) = tnat2(:, jjbu:jjeu, :)
+          IF (guide_Q) qnat1(:, jjbu:jjeu, :) = qnat2(:, jjbu:jjeu, :)
+          IF (guide_plevs==2) pnat1(:, jjbu:jjeu, :) = pnat2(:, jjbu:jjeu, :)
+          IF (guide_P.OR.guide_plevs==1) psnat1(:, jjbu:jjeu) = psnat2(:, jjbu:jjeu)
+          !$OMP END MASTER
+          !$OMP BARRIER
+          step_rea = step_rea + 1
+          itau_test = itau
+          IF (is_master) THEN
+            WRITE(*, *)trim(modname) // ' Reading nudging files, step ', &
+                    step_rea, 'after ', count_no_rea, ' skips'
+          endif
+          IF (guide_2D) THEN
+            !$OMP MASTER
+            CALL guide_read2D(step_rea)
+            !$OMP END MASTER
+            !$OMP BARRIER
           ELSE
-!$OMP MASTER
-              IF (guide_v) vnat1(:,jjbv:jjev,:)=vnat2(:,jjbv:jjev,:)
-              IF (guide_u) unat1(:,jjbu:jjeu,:)=unat2(:,jjbu:jjeu,:)
-              IF (guide_T) tnat1(:,jjbu:jjeu,:)=tnat2(:,jjbu:jjeu,:)
-              IF (guide_Q) qnat1(:,jjbu:jjeu,:)=qnat2(:,jjbu:jjeu,:)
-              IF (guide_plevs==2) pnat1(:,jjbu:jjeu,:)=pnat2(:,jjbu:jjeu,:)
-              IF (guide_P.OR.guide_plevs==1) psnat1(:,jjbu:jjeu)=psnat2(:,jjbu:jjeu)
-!$OMP END MASTER
-!$OMP BARRIER
-              step_rea=step_rea+1
-              itau_test=itau
-              if (is_master) THEN
-                WRITE(*,*)trim(modname)//' Reading nudging files, step ',&
-                    step_rea,'after ',count_no_rea,' skips'
-              endif
-              IF (guide_2D) THEN
-!$OMP MASTER
-                  CALL guide_read2D(step_rea)
-!$OMP END MASTER
-!$OMP BARRIER
-              ELSE
-!$OMP MASTER
-                  CALL guide_read(step_rea)
-!$OMP END MASTER
-!$OMP BARRIER
-              ENDIF
-              count_no_rea=0
+            !$OMP MASTER
+            CALL guide_read(step_rea)
+            !$OMP END MASTER
+            !$OMP BARRIER
           ENDIF
+          count_no_rea = 0
+        ENDIF
       ELSE
-        count_no_rea=count_no_rea+1
+        count_no_rea = count_no_rea + 1
 
       ENDIF
     ENDIF !iguide_read=0
 
-!-----------------------------------------------------------------------
-! Interpolation et conversion des champs de guidage
-!-----------------------------------------------------------------------
-    IF (MOD(itau,iguide_int)==0) THEN
-        CALL guide_interp(ps,teta)
-    ENDIF
-! Repartition entre 2 etats de guidage
+    !-----------------------------------------------------------------------
+    ! Interpolation et conversion des champs de guidage
+    !-----------------------------------------------------------------------
+    IF (MOD(itau, iguide_int)==0) THEN
+      CALL guide_interp(ps, teta)
+    ENDIF
+    ! Repartition entre 2 etats de guidage
     IF (iguide_read/=0) THEN
-        tau=reste
+      tau = reste
     ELSE
-        tau=1.
-    ENDIF
-
-!    CALL WriteField_u('ucov_guide',ucov)
-!    CALL WriteField_v('vcov_guide',vcov)
-!    CALL WriteField_u('teta_guide',teta)
-!    CALL WriteField_u('masse_guide',masse)
-    
-    
-!-----------------------------------------------------------------------
-!   Ajout des champs de guidage 
-!-----------------------------------------------------------------------
-! Sauvegarde du guidage?
-    f_out=((MOD(itau,iguide_sav)==0).AND.guide_sav)
+      tau = 1.
+    ENDIF
+
+    !    CALL WriteField_u('ucov_guide',ucov)
+    !    CALL WriteField_v('vcov_guide',vcov)
+    !    CALL WriteField_u('teta_guide',teta)
+    !    CALL WriteField_u('masse_guide',masse)
+
+
+    !-----------------------------------------------------------------------
+    !   Ajout des champs de guidage
+    !-----------------------------------------------------------------------
+    ! Sauvegarde du guidage?
+    f_out = ((MOD(itau, iguide_sav)==0).AND.guide_sav)
     IF (f_out) THEN
 
-!$OMP BARRIER
-      CALL pression_loc(ijnb_u,ap,bp,ps,p)
-
-!$OMP BARRIER
-      if (pressure_exner) THEN
-      CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk)
+      !$OMP BARRIER
+      CALL pression_loc(ijnb_u, ap, bp, ps, p)
+
+      !$OMP BARRIER
+      IF (pressure_exner) THEN
+        CALL exner_hyb_loc(ijnb_u, ps, p, pks, pk)
       else
-        CALL exner_milieu_loc( ijnb_u, ps, p, pks, pk )
-      endif
-
-!$OMP BARRIER
-
-        unskap=1./kappa
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        CALL exner_milieu_loc(ijnb_u, ps, p, pks, pk)
+      endif
+
+      !$OMP BARRIER
+
+      unskap = 1. / kappa
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        DO j = jjbu, jjeu
+          DO i = 1, iip1
+            p(i + (j - 1) * iip1, l) = preff * (pk(i, j, l) / cpp) ** unskap
+          ENDDO
+        ENDDO
+      ENDDO
+
+      CALL guide_out("SP", jjp1, llm, p(ijb_u:ije_u, 1:llm), 1.)
+    ENDIF
+
+    IF (guide_u) THEN
+      IF (guide_add) THEN
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
         DO l = 1, llm
-            DO j=jjbu,jjeu
-                DO i =1, iip1
-                    p(i+(j-1)*iip1,l) = preff * ( pk(i,j,l)/cpp) ** unskap
-                ENDDO
-            ENDDO
-        ENDDO
-
-        CALL guide_out("SP",jjp1,llm,p(ijb_u:ije_u,1:llm),1.)
-    ENDIF
-    
-    if (guide_u) THEN
-        if (guide_add) THEN
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO l=1,llm
-           f_addu(ijbu:ijeu,l)=(1.-tau)*ugui1(ijbu:ijeu,l)+tau*ugui2(ijbu:ijeu,l)
-          ENDDO
-        else
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO l=1,llm
-           f_addu(ijbu:ijeu,l)=(1.-tau)*ugui1(ijbu:ijeu,l)+tau*ugui2(ijbu:ijeu,l)-ucov(ijbu:ijeu,l)
-          ENDDO
-        endif 
-    
-!        CALL WriteField_u('f_addu',f_addu)
-
-        if (guide_zon) CALL guide_zonave_u(1,llm,f_addu)
-        CALL guide_addfield_u(llm,f_addu,alpha_u)
-        IF (f_out) CALL guide_out("ua",jjp1,llm,(1.-tau)*ugui1(ijb_u:ije_u,:)+tau*ugui2(ijb_u:ije_u,:),factt)
-        IF (f_out) CALL guide_out("u",jjp1,llm,ucov(ijb_u:ije_u,:),factt)
-        IF (f_out) THEN
-         ! Ehouarn: fill the gaps adequately...
-         IF (ijbu>ijb_u) f_addu(ijb_u:ijbu-1,:)=0
-         IF (ijeu<ije_u) f_addu(ijeu+1:ije_u,:)=0
-         CALL guide_out("ucov",jjp1,llm,f_addu(ijb_u:ije_u,:)/factt,factt)
-        ENDIF
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        DO l=1,llm
-          ucov(ijbu:ijeu,l)=ucov(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
-        ENDDO
+          f_addu(ijbu:ijeu, l) = (1. - tau) * ugui1(ijbu:ijeu, l) + tau * ugui2(ijbu:ijeu, l)
+        ENDDO
+      else
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l = 1, llm
+          f_addu(ijbu:ijeu, l) = (1. - tau) * ugui1(ijbu:ijeu, l) + tau * ugui2(ijbu:ijeu, l) - ucov(ijbu:ijeu, l)
+        ENDDO
+      endif
+
+      !        CALL WriteField_u('f_addu',f_addu)
+
+      IF (guide_zon) CALL guide_zonave_u(1, llm, f_addu)
+      CALL guide_addfield_u(llm, f_addu, alpha_u)
+      IF (f_out) CALL guide_out("ua", jjp1, llm, (1. - tau) * ugui1(ijb_u:ije_u, :) + tau * ugui2(ijb_u:ije_u, :), factt)
+      IF (f_out) CALL guide_out("u", jjp1, llm, ucov(ijb_u:ije_u, :), factt)
+      IF (f_out) THEN
+        ! Ehouarn: fill the gaps adequately...
+        IF (ijbu>ijb_u) f_addu(ijb_u:ijbu - 1, :) = 0
+        IF (ijeu<ije_u) f_addu(ijeu + 1:ije_u, :) = 0
+        CALL guide_out("ucov", jjp1, llm, f_addu(ijb_u:ije_u, :) / factt, factt)
+      ENDIF
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        ucov(ijbu:ijeu, l) = ucov(ijbu:ijeu, l) + f_addu(ijbu:ijeu, l)
+      ENDDO
 
     endif
 
-    if (guide_T) THEN
-        if (guide_add) THEN
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO l=1,llm
-            f_addu(ijbu:ijeu,l)=(1.-tau)*tgui1(ijbu:ijeu,l)+tau*tgui2(ijbu:ijeu,l)
-          ENDDO
-        else
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO l=1,llm
-           f_addu(ijbu:ijeu,l)=(1.-tau)*tgui1(ijbu:ijeu,l)+tau*tgui2(ijbu:ijeu,l)-teta(ijbu:ijeu,l)
-          ENDDO
-        endif 
-        if (guide_zon) CALL guide_zonave_u(2,llm,f_addu)
-        CALL guide_addfield_u(llm,f_addu,alpha_T)
-        IF (f_out) CALL guide_out("teta",jjp1,llm,f_addu(:,:)/factt,factt)
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        DO l=1,llm
-          teta(ijbu:ijeu,l)=teta(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
-        ENDDO
+    IF (guide_T) THEN
+      IF (guide_add) THEN
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l = 1, llm
+          f_addu(ijbu:ijeu, l) = (1. - tau) * tgui1(ijbu:ijeu, l) + tau * tgui2(ijbu:ijeu, l)
+        ENDDO
+      else
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l = 1, llm
+          f_addu(ijbu:ijeu, l) = (1. - tau) * tgui1(ijbu:ijeu, l) + tau * tgui2(ijbu:ijeu, l) - teta(ijbu:ijeu, l)
+        ENDDO
+      endif
+      IF (guide_zon) CALL guide_zonave_u(2, llm, f_addu)
+      CALL guide_addfield_u(llm, f_addu, alpha_T)
+      IF (f_out) CALL guide_out("teta", jjp1, llm, f_addu(:, :) / factt, factt)
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        teta(ijbu:ijeu, l) = teta(ijbu:ijeu, l) + f_addu(ijbu:ijeu, l)
+      ENDDO
     endif
 
-    if (guide_P) THEN
-        if (guide_add) THEN
-!$OMP MASTER
-            f_addu(ijbu:ijeu,1)=(1.-tau)*psgui1(ijbu:ijeu)+tau*psgui2(ijbu:ijeu)
-!$OMP END MASTER
-!$OMP BARRIER
-        else
-!$OMP MASTER
-            f_addu(ijbu:ijeu,1)=(1.-tau)*psgui1(ijbu:ijeu)+tau*psgui2(ijbu:ijeu)-ps(ijbu:ijeu)
-!$OMP END MASTER
-!$OMP BARRIER
-        endif 
-        if (guide_zon) CALL guide_zonave_u(2,1,f_addu(ijb_u:ije_u,1))
-        CALL guide_addfield_u(1,f_addu(ijb_u:ije_u,1),alpha_P)
-!       IF (f_out) CALL guide_out("ps",jjp1,1,f_addu(ijb_u:ije_u,1)/factt,factt)
-!$OMP MASTER
-        ps(ijbu:ijeu)=ps(ijbu:ijeu)+f_addu(ijbu:ijeu,1)
-!$OMP END MASTER
-!$OMP BARRIER
-        CALL pression_loc(ijnb_u,ap,bp,ps,p)
-        CALL massdair_loc(p,masse)
-!$OMP BARRIER
+    IF (guide_P) THEN
+      IF (guide_add) THEN
+        !$OMP MASTER
+        f_addu(ijbu:ijeu, 1) = (1. - tau) * psgui1(ijbu:ijeu) + tau * psgui2(ijbu:ijeu)
+        !$OMP END MASTER
+        !$OMP BARRIER
+      else
+        !$OMP MASTER
+        f_addu(ijbu:ijeu, 1) = (1. - tau) * psgui1(ijbu:ijeu) + tau * psgui2(ijbu:ijeu) - ps(ijbu:ijeu)
+        !$OMP END MASTER
+        !$OMP BARRIER
+      endif
+      IF (guide_zon) CALL guide_zonave_u(2, 1, f_addu(ijb_u:ije_u, 1))
+      CALL guide_addfield_u(1, f_addu(ijb_u:ije_u, 1), alpha_P)
+      !       IF (f_out) CALL guide_out("ps",jjp1,1,f_addu(ijb_u:ije_u,1)/factt,factt)
+      !$OMP MASTER
+      ps(ijbu:ijeu) = ps(ijbu:ijeu) + f_addu(ijbu:ijeu, 1)
+      !$OMP END MASTER
+      !$OMP BARRIER
+      CALL pression_loc(ijnb_u, ap, bp, ps, p)
+      CALL massdair_loc(p, masse)
+      !$OMP BARRIER
     endif
 
-    if (guide_Q) THEN
-        if (guide_add) THEN
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO l=1,llm
-            f_addu(ijbu:ijeu,l)=(1.-tau)*qgui1(ijbu:ijeu,l)+tau*qgui2(ijbu:ijeu,l)
-          ENDDO
-        else
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO l=1,llm
-            f_addu(ijbu:ijeu,l)=(1.-tau)*qgui1(ijbu:ijeu,l)+tau*qgui2(ijbu:ijeu,l)-q(ijbu:ijeu,l)
-          ENDDO
-        endif 
-        if (guide_zon) CALL guide_zonave_u(2,llm,f_addu)
-        CALL guide_addfield_u(llm,f_addu,alpha_Q)
-        IF (f_out) CALL guide_out("q",jjp1,llm,f_addu(:,:)/factt,factt)
-
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        DO l=1,llm
-          q(ijbu:ijeu,l)=q(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
-        ENDDO
+    IF (guide_Q) THEN
+      IF (guide_add) THEN
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l = 1, llm
+          f_addu(ijbu:ijeu, l) = (1. - tau) * qgui1(ijbu:ijeu, l) + tau * qgui2(ijbu:ijeu, l)
+        ENDDO
+      else
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l = 1, llm
+          f_addu(ijbu:ijeu, l) = (1. - tau) * qgui1(ijbu:ijeu, l) + tau * qgui2(ijbu:ijeu, l) - q(ijbu:ijeu, l)
+        ENDDO
+      endif
+      IF (guide_zon) CALL guide_zonave_u(2, llm, f_addu)
+      CALL guide_addfield_u(llm, f_addu, alpha_Q)
+      IF (f_out) CALL guide_out("q", jjp1, llm, f_addu(:, :) / factt, factt)
+
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        q(ijbu:ijeu, l) = q(ijbu:ijeu, l) + f_addu(ijbu:ijeu, l)
+      ENDDO
     endif
 
-    if (guide_v) THEN
-        if (guide_add) THEN
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO l=1,llm
-             f_addv(ijbv:ijev,l)=(1.-tau)*vgui1(ijbv:ijev,l)+tau*vgui2(ijbv:ijev,l)
-          ENDDO
-
-        else
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO l=1,llm
-            f_addv(ijbv:ijev,l)=(1.-tau)*vgui1(ijbv:ijev,l)+tau*vgui2(ijbv:ijev,l)-vcov(ijbv:ijev,l)
-          ENDDO
-
-        endif 
-    
-        if (guide_zon) CALL guide_zonave_v(2,jjm,llm,f_addv(ijb_v:ije_v,:))
-        
-        CALL guide_addfield_v(llm,f_addv(ijb_v:ije_v,:),alpha_v)
-        IF (f_out) CALL guide_out("v",jjm,llm,vcov(ijb_v:ije_v,:),factt)
-        IF (f_out) CALL guide_out("va",jjm,llm,(1.-tau)*vgui1(ijb_v:ije_v,:)+tau*vgui2(ijb_v:ije_v,:),factt)
-        IF (f_out) THEN
-          ! Ehouarn: Fill in the gaps adequately
-          IF (ijbv>ijb_v) f_addv(ijb_v:ijbv-1,:)=0 
-          IF (ijev<ije_v) f_addv(ijev+1:ije_v,:)=0
-          CALL guide_out("vcov",jjm,llm,f_addv(ijb_v:ije_v,:)/factt,factt)
-        ENDIF
-
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        DO l=1,llm
-          vcov(ijbv:ijev,l)=vcov(ijbv:ijev,l)+f_addv(ijbv:ijev,l)
-        ENDDO
+    IF (guide_v) THEN
+      IF (guide_add) THEN
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l = 1, llm
+          f_addv(ijbv:ijev, l) = (1. - tau) * vgui1(ijbv:ijev, l) + tau * vgui2(ijbv:ijev, l)
+        ENDDO
+
+      else
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l = 1, llm
+          f_addv(ijbv:ijev, l) = (1. - tau) * vgui1(ijbv:ijev, l) + tau * vgui2(ijbv:ijev, l) - vcov(ijbv:ijev, l)
+        ENDDO
+
+      endif
+
+      IF (guide_zon) CALL guide_zonave_v(2, jjm, llm, f_addv(ijb_v:ije_v, :))
+
+      CALL guide_addfield_v(llm, f_addv(ijb_v:ije_v, :), alpha_v)
+      IF (f_out) CALL guide_out("v", jjm, llm, vcov(ijb_v:ije_v, :), factt)
+      IF (f_out) CALL guide_out("va", jjm, llm, (1. - tau) * vgui1(ijb_v:ije_v, :) + tau * vgui2(ijb_v:ije_v, :), factt)
+      IF (f_out) THEN
+        ! Ehouarn: Fill in the gaps adequately
+        IF (ijbv>ijb_v) f_addv(ijb_v:ijbv - 1, :) = 0
+        IF (ijev<ije_v) f_addv(ijev + 1:ije_v, :) = 0
+        CALL guide_out("vcov", jjm, llm, f_addv(ijb_v:ije_v, :) / factt, factt)
+      ENDIF
+
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        vcov(ijbv:ijev, l) = vcov(ijbv:ijev, l) + f_addv(ijbv:ijev, l)
+      ENDDO
     endif
 
@@ -723,6 +718,6 @@
 
 
-  SUBROUTINE guide_addfield_u(vsize,field,alpha)
-! field1=a*field1+alpha*field2
+  SUBROUTINE guide_addfield_u(vsize, field, alpha)
+    ! field1=a*field1+alpha*field2
 
     IMPLICIT NONE
@@ -731,14 +726,14 @@
 
     ! input variables
-    INTEGER,                      INTENT(IN)    :: vsize
-    REAL, DIMENSION(ijb_u:ije_u),       INTENT(IN)    :: alpha 
-    REAL, DIMENSION(ijb_u:ije_u,vsize), INTENT(INOUT) :: field
+    INTEGER, INTENT(IN) :: vsize
+    REAL, DIMENSION(ijb_u:ije_u), INTENT(IN) :: alpha
+    REAL, DIMENSION(ijb_u:ije_u, vsize), INTENT(INOUT) :: field
 
     ! Local variables
     INTEGER :: l
 
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-    DO l=1,vsize
-      field(ijbu:ijeu,l)=alpha(ijbu:ijeu)*field(ijbu:ijeu,l)*alpha_pcor(l)
+    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+    DO l = 1, vsize
+      field(ijbu:ijeu, l) = alpha(ijbu:ijeu) * field(ijbu:ijeu, l) * alpha_pcor(l)
     ENDDO
 
@@ -746,6 +741,6 @@
 
 
-  SUBROUTINE guide_addfield_v(vsize,field,alpha)
-! field1=a*field1+alpha*field2
+  SUBROUTINE guide_addfield_v(vsize, field, alpha)
+    ! field1=a*field1+alpha*field2
 
     IMPLICIT NONE
@@ -754,24 +749,24 @@
 
     ! input variables
-    INTEGER,                      INTENT(IN)    :: vsize
-    REAL, DIMENSION(ijb_v:ije_v),       INTENT(IN)    :: alpha 
-    REAL, DIMENSION(ijb_v:ije_v,vsize), INTENT(INOUT) :: field
+    INTEGER, INTENT(IN) :: vsize
+    REAL, DIMENSION(ijb_v:ije_v), INTENT(IN) :: alpha
+    REAL, DIMENSION(ijb_v:ije_v, vsize), INTENT(INOUT) :: field
 
     ! Local variables
     INTEGER :: l
 
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-    DO l=1,vsize
-      field(ijbv:ijev,l)=alpha(ijbv:ijev)*field(ijbv:ijev,l)*alpha_pcor(l)
+    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+    DO l = 1, vsize
+      field(ijbv:ijev, l) = alpha(ijbv:ijev) * field(ijbv:ijev, l) * alpha_pcor(l)
     ENDDO
 
   END SUBROUTINE guide_addfield_v
-  
-!=======================================================================
-
-  SUBROUTINE guide_zonave_u(typ,vsize,field)
+
+  !=======================================================================
+
+  SUBROUTINE guide_zonave_u(typ, vsize, field)
 
     USE comconst_mod, ONLY: pi
-    
+
     IMPLICIT NONE
 
@@ -779,71 +774,71 @@
     INCLUDE "paramet.h"
     INCLUDE "comgeom.h"
-    
+
     ! input/output variables
-    INTEGER,                           INTENT(IN)    :: typ
-    INTEGER,                           INTENT(IN)    :: vsize
-    REAL, DIMENSION(ijb_u:ije_u,vsize), INTENT(INOUT) :: field
+    INTEGER, INTENT(IN) :: typ
+    INTEGER, INTENT(IN) :: vsize
+    REAL, DIMENSION(ijb_u:ije_u, vsize), INTENT(INOUT) :: field
 
     ! Local variables
-    LOGICAL, SAVE                :: first=.TRUE.
-!$OMP THREADPRIVATE(first)
+    LOGICAL, SAVE :: first = .TRUE.
+    !$OMP THREADPRIVATE(first)
 
     INTEGER, DIMENSION (2), SAVE :: imin, imax ! averaging domain
-!$OMP THREADPRIVATE(imin,imax)    
-    INTEGER                      :: i,j,l,ij
-    REAL, DIMENSION (iip1)       :: lond       ! longitude in Deg.
-    REAL, DIMENSION (jjb_u:jje_u,vsize):: fieldm     ! zon-averaged field
+    !$OMP THREADPRIVATE(imin,imax)
+    INTEGER :: i, j, l, ij
+    REAL, DIMENSION (iip1) :: lond       ! longitude in Deg.
+    REAL, DIMENSION (jjb_u:jje_u, vsize) :: fieldm     ! zon-averaged field
 
     IF (first) THEN
-        first=.FALSE.
-!Compute domain for averaging
-        lond=rlonu*180./pi
-        imin(1)=1;imax(1)=iip1;
-        imin(2)=1;imax(2)=iip1;
-        IF (guide_reg) THEN
-            DO i=1,iim
-                IF (lond(i)<lon_min_g) imin(1)=i
-                IF (lond(i)<=lon_max_g) imax(1)=i
-            ENDDO
-            lond=rlonv*180./pi
-            DO i=1,iim
-                IF (lond(i)<lon_min_g) imin(2)=i
-                IF (lond(i)<=lon_max_g) imax(2)=i
-            ENDDO
-        ENDIF
-    ENDIF
-
-    
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l=1,vsize
-        fieldm(:,l)=0.
+      first = .FALSE.
+      !Compute domain for averaging
+      lond = rlonu * 180. / pi
+      imin(1) = 1;imax(1) = iip1;
+      imin(2) = 1;imax(2) = iip1;
+      IF (guide_reg) THEN
+        DO i = 1, iim
+          IF (lond(i)<lon_min_g) imin(1) = i
+          IF (lond(i)<=lon_max_g) imax(1) = i
+        ENDDO
+        lond = rlonv * 180. / pi
+        DO i = 1, iim
+          IF (lond(i)<lon_min_g) imin(2) = i
+          IF (lond(i)<=lon_max_g) imax(2) = i
+        ENDDO
+      ENDIF
+    ENDIF
+
+
+    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+    DO l = 1, vsize
+      fieldm(:, l) = 0.
       ! Compute zonal average
 
-!correction bug ici
-! ---> a verifier
-! ym         DO j=jjbv,jjev
-         DO j=jjbu,jjeu
-              DO i=imin(typ),imax(typ)
-                  ij=(j-1)*iip1+i
-                  fieldm(j,l)=fieldm(j,l)+field(ij,l)
-              ENDDO
-          ENDDO 
-          fieldm(:,l)=fieldm(:,l)/REAL(imax(typ)-imin(typ)+1)
-    ! Compute forcing
-          DO j=jjbu,jjeu
-              DO i=1,iip1
-                  ij=(j-1)*iip1+i
-                  field(ij,l)=fieldm(j,l)
-              ENDDO
-          ENDDO
+      !correction bug ici
+      ! ---> a verifier
+      ! ym         DO j=jjbv,jjev
+      DO j = jjbu, jjeu
+        DO i = imin(typ), imax(typ)
+          ij = (j - 1) * iip1 + i
+          fieldm(j, l) = fieldm(j, l) + field(ij, l)
+        ENDDO
       ENDDO
+      fieldm(:, l) = fieldm(:, l) / REAL(imax(typ) - imin(typ) + 1)
+      ! Compute forcing
+      DO j = jjbu, jjeu
+        DO i = 1, iip1
+          ij = (j - 1) * iip1 + i
+          field(ij, l) = fieldm(j, l)
+        ENDDO
+      ENDDO
+    ENDDO
 
   END SUBROUTINE guide_zonave_u
 
 
-  SUBROUTINE guide_zonave_v(typ,hsize,vsize,field)
+  SUBROUTINE guide_zonave_v(typ, hsize, vsize, field)
 
     USE comconst_mod, ONLY: pi
-    
+
     IMPLICIT NONE
 
@@ -851,559 +846,71 @@
     INCLUDE "paramet.h"
     INCLUDE "comgeom.h"
-    
+
     ! input/output variables
-    INTEGER,                           INTENT(IN)    :: typ
-    INTEGER,                           INTENT(IN)    :: vsize
-    INTEGER,                           INTENT(IN)    :: hsize
-    REAL, DIMENSION(ijb_v:ije_v,vsize), INTENT(INOUT) :: field
+    INTEGER, INTENT(IN) :: typ
+    INTEGER, INTENT(IN) :: vsize
+    INTEGER, INTENT(IN) :: hsize
+    REAL, DIMENSION(ijb_v:ije_v, vsize), INTENT(INOUT) :: field
 
     ! Local variables
-    LOGICAL, SAVE                :: first=.TRUE.
-!$OMP THREADPRIVATE(first)
+    LOGICAL, SAVE :: first = .TRUE.
+    !$OMP THREADPRIVATE(first)
     INTEGER, DIMENSION (2), SAVE :: imin, imax ! averaging domain
-!$OMP THREADPRIVATE(imin, imax)
-    INTEGER                      :: i,j,l,ij
-    REAL, DIMENSION (iip1)       :: lond       ! longitude in Deg.
-    REAL, DIMENSION (jjb_v:jjev,vsize):: fieldm     ! zon-averaged field
+    !$OMP THREADPRIVATE(imin, imax)
+    INTEGER :: i, j, l, ij
+    REAL, DIMENSION (iip1) :: lond       ! longitude in Deg.
+    REAL, DIMENSION (jjb_v:jjev, vsize) :: fieldm     ! zon-averaged field
 
     IF (first) THEN
-        first=.FALSE.
-!Compute domain for averaging
-        lond=rlonu*180./pi
-        imin(1)=1;imax(1)=iip1;
-        imin(2)=1;imax(2)=iip1;
-        IF (guide_reg) THEN
-            DO i=1,iim
-                IF (lond(i)<lon_min_g) imin(1)=i
-                IF (lond(i)<=lon_max_g) imax(1)=i
-            ENDDO
-            lond=rlonv*180./pi
-            DO i=1,iim
-                IF (lond(i)<lon_min_g) imin(2)=i
-                IF (lond(i)<=lon_max_g) imax(2)=i
-            ENDDO
-        ENDIF
-    ENDIF
-
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l=1,vsize
+      first = .FALSE.
+      !Compute domain for averaging
+      lond = rlonu * 180. / pi
+      imin(1) = 1;imax(1) = iip1;
+      imin(2) = 1;imax(2) = iip1;
+      IF (guide_reg) THEN
+        DO i = 1, iim
+          IF (lond(i)<lon_min_g) imin(1) = i
+          IF (lond(i)<=lon_max_g) imax(1) = i
+        ENDDO
+        lond = rlonv * 180. / pi
+        DO i = 1, iim
+          IF (lond(i)<lon_min_g) imin(2) = i
+          IF (lond(i)<=lon_max_g) imax(2) = i
+        ENDDO
+      ENDIF
+    ENDIF
+
+    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+    DO l = 1, vsize
       ! Compute zonal average
-          fieldm(:,l)=0.
-          DO j=jjbv,jjev
-              DO i=imin(typ),imax(typ)
-                  ij=(j-1)*iip1+i
-                  fieldm(j,l)=fieldm(j,l)+field(ij,l)
-              ENDDO
-          ENDDO 
-          fieldm(:,l)=fieldm(:,l)/REAL(imax(typ)-imin(typ)+1)
-    ! Compute forcing
-          DO j=jjbv,jjev
-              DO i=1,iip1
-                  ij=(j-1)*iip1+i
-                  field(ij,l)=fieldm(j,l)
-              ENDDO
-          ENDDO
+      fieldm(:, l) = 0.
+      DO j = jjbv, jjev
+        DO i = imin(typ), imax(typ)
+          ij = (j - 1) * iip1 + i
+          fieldm(j, l) = fieldm(j, l) + field(ij, l)
+        ENDDO
       ENDDO
-
+      fieldm(:, l) = fieldm(:, l) / REAL(imax(typ) - imin(typ) + 1)
+      ! Compute forcing
+      DO j = jjbv, jjev
+        DO i = 1, iip1
+          ij = (j - 1) * iip1 + i
+          field(ij, l) = fieldm(j, l)
+        ENDDO
+      ENDDO
+    ENDDO
 
   END SUBROUTINE guide_zonave_v
-  
-!=======================================================================
-  SUBROUTINE guide_interp(psi,teta)
-    use exner_hyb_loc_m, ONLY: exner_hyb_loc
-    use exner_milieu_loc_m, ONLY: exner_milieu_loc
-  USE parallel_lmdz
-  USE mod_hallo
-  USE Bands
-  USE comconst_mod, ONLY: cpp, kappa
-  USE comvert_mod, ONLY: preff, pressure_exner, bp, ap, disvert_type
-  IMPLICIT NONE
-
-  include "dimensions.h"
-  include "paramet.h"
-  include "comgeom2.h"
-
-  REAL, DIMENSION (iip1,jjb_u:jje_u),     INTENT(IN) :: psi ! Psol gcm
-  REAL, DIMENSION (iip1,jjb_u:jje_u,llm), INTENT(IN) :: teta ! Temp. Pot. gcm
-
-  LOGICAL, SAVE                      :: first=.TRUE.
-!$OMP THREADPRIVATE(first)
-  ! Variables pour niveaux pression:
-  REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: plnc1,plnc2 !niveaux pression guidage
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: plunc,plsnc !niveaux pression modele
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)     :: plvnc       !niveaux pression modele
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)  :: p           ! pression intercouches 
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: pls, pext   ! var intermediaire
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: pbarx 
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)     :: pbary 
-  ! Variables pour fonction Exner (P milieu couche)
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: pk
-  REAL ,ALLOCATABLE, SAVE, DIMENSION (:,:)        :: pks    
-  REAL                               :: unskap
-  ! Pression de vapeur saturante
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:)      :: qsat
-  !Variables intermediaires interpolation
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: zu1,zu2 
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)     :: zv1,zv2
-  
-  INTEGER                            :: i,j,l,ij
-  CHARACTER(LEN=20),PARAMETER :: modname="guide_interp"
-  TYPE(Request),SAVE :: Req  
-!$OMP THREADPRIVATE(Req)
-    
-    if (is_master) WRITE(*,*)trim(modname)//': interpolate nudging variables'
-! -----------------------------------------------------------------
-! Calcul des niveaux de pression champs guidage (pour T et Q)
-! -----------------------------------------------------------------
-    IF (first) THEN
-!$OMP MASTER
-      ALLOCATE(plnc1(iip1,jjb_u:jje_u,nlevnc) )    
-      ALLOCATE(plnc2(iip1,jjb_u:jje_u,nlevnc) )    
-      ALLOCATE(plunc(iip1,jjb_u:jje_u,llm) )    
-      ALLOCATE(plsnc(iip1,jjb_u:jje_u,llm) )    
-      ALLOCATE(plvnc(iip1,jjb_v:jje_v,llm) )    
-      ALLOCATE(p(iip1,jjb_u:jje_u,llmp1) )    
-      ALLOCATE(pls(iip1,jjb_u:jje_u,llm) )    
-      ALLOCATE(pext(iip1,jjb_u:jje_u,llm) )    
-      ALLOCATE(pbarx(iip1,jjb_u:jje_u,llm) )    
-      ALLOCATE(pbary(iip1,jjb_v:jje_v,llm) )    
-      ALLOCATE(pk(iip1,jjb_u:jje_u,llm) )    
-      ALLOCATE(pks (iip1,jjb_u:jje_u) )    
-      ALLOCATE(qsat(ijb_u:ije_u,llm) )    
-      ALLOCATE(zu1(iip1,jjb_u:jje_u,llm) )    
-      ALLOCATE(zu2(iip1,jjb_u:jje_u,llm) )    
-      ALLOCATE(zv1(iip1,jjb_v:jje_v,llm) )    
-      ALLOCATE(zv2(iip1,jjb_v:jje_v,llm) )
-!$OMP END MASTER
-!$OMP BARRIER
-    ENDIF        
-
-    
-    
-    
-    IF (guide_plevs==0) THEN
-!$OMP DO
-        DO l=1,nlevnc
-            DO j=jjbu,jjeu
-                DO i=1,iip1
-                    plnc2(i,j,l)=apnc(l)
-                    plnc1(i,j,l)=apnc(l)
-               ENDDO
-            ENDDO
-        ENDDO
-    ENDIF   
-
-    if (first) THEN
-        first=.FALSE.
-!$OMP MASTER
-        WRITE(*,*)trim(modname)//' : check vertical level order'
-        WRITE(*,*)trim(modname)//' LMDZ :'
-        do l=1,llm
-          WRITE(*,*)trim(modname)//' PL(',l,')=',(ap(l)+ap(l+1))/2. &
-                  +psi(1,jjeu)*(bp(l)+bp(l+1))/2.
-        enddo
-        WRITE(*,*)trim(modname)//' nudging file :'
-        SELECT CASE (guide_plevs)
-        CASE (0) 
-            do l=1,nlevnc
-              WRITE(*,*)trim(modname)//' PL(',l,')=',plnc2(1,jjbu,l)
-            enddo
-        CASE (1)
-            DO l=1,nlevnc
-              WRITE(*,*)trim(modname)//' PL(',l,')=',&
-                        apnc(l)+bpnc(l)*psnat2(1,jjbu)
-            ENDDO
-        CASE (2)
-            do l=1,nlevnc
-              WRITE(*,*)trim(modname)//' PL(',l,')=',pnat2(1,jjbu,l)
-            enddo
-        END SELECT
-        WRITE(*,*)trim(modname)//' invert ordering: invert_p=',invert_p
-        if (guide_u) THEN
-            do l=1,nlevnc
-              WRITE(*,*)trim(modname)//' U(',l,')=',unat2(1,jjbu,l)
-            enddo
-        endif
-        if (guide_T) THEN
-            do l=1,nlevnc
-              WRITE(*,*)trim(modname)//' T(',l,')=',tnat2(1,jjbu,l)
-            enddo
-        endif
-!$OMP END MASTER
-    endif ! of if (first)
-
-    if (guide_plevs /= 1 .or. guide_t .and. .not. guide_teta &
-         .or. guide_q .and. guide_hr) THEN
-       CALL pression_loc( ijnb_u, ap, bp, psi, p )
-       if (disvert_type==1) THEN
-          CALL exner_hyb_loc(ijnb_u,psi,p,pks,pk)
-       else ! we assume that we are in the disvert_type==2 case
-          CALL exner_milieu_loc(ijnb_u,psi,p,pks,pk)
-       endif
-    end if
-
-! -----------------------------------------------------------------
-! Calcul niveaux pression modele 
-! -----------------------------------------------------------------
-
-!    ....  Calcul de pls , pression au milieu des couches ,en Pascals
-    IF (guide_plevs==1) THEN
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        DO l=1,llm
-            DO j=jjbu,jjeu
-                DO i =1, iip1
-                    pls(i,j,l)=(ap(l)+ap(l+1))/2.+psi(i,j)*(bp(l)+bp(l+1))/2.
-                ENDDO
-            ENDDO
-        ENDDO
-    ELSE
-        unskap=1./kappa
-!$OMP BARRIER
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-   DO l = 1, llm
-       DO j=jjbu,jjeu
-           DO i =1, iip1
-               pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
-           ENDDO
-       ENDDO
-   ENDDO
-    ENDIF
-
-!   calcul des pressions pour les grilles u et v
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-    do l=1,llm
-        do j=jjbu,jjeu
-            do i=1,iip1
-                pext(i,j,l)=pls(i,j,l)*aire(i,j)
-            enddo
-        enddo
-    enddo
-
-     CALL Register_Hallo_u(pext,llm,1,2,2,1,Req)
-     CALL SendRequest(Req)
-!$OMP BARRIER
-     CALL WaitRequest(Req)
-!$OMP BARRIER
-
-    CALL massbar_loc(pext, pbarx, pbary )
-!$OMP BARRIER
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-    do l=1,llm
-        do j=jjbu,jjeu
-            do i=1,iip1
-                plunc(i,j,l)=pbarx(i,j,l)/aireu(i,j)
-                plsnc(i,j,l)=pls(i,j,l)
-            enddo
-        enddo
-    enddo
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-    do l=1,llm
-        do j=jjbv,jjev
-            do i=1,iip1
-                plvnc(i,j,l)=pbary(i,j,l)/airev(i,j)
-            enddo
-        enddo
-    enddo
-
-! -----------------------------------------------------------------
-! Interpolation verticale champs guidage sur niveaux modele
-! Conversion en variables gcm (ucov, vcov...)
-! -----------------------------------------------------------------
-    if (guide_P) THEN
-!$OMP MASTER
-        do j=jjbu,jjeu
-            do i=1,iim
-                ij=(j-1)*iip1+i
-                psgui1(ij)=psnat1(i,j)
-                psgui2(ij)=psnat2(i,j)
-            enddo
-            psgui1(iip1*j)=psnat1(1,j)
-            psgui2(iip1*j)=psnat2(1,j)
-        enddo
-!$OMP END MASTER
-!$OMP BARRIER
-    endif
-
-    IF (guide_T) THEN
-        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
-        IF (guide_plevs==1) THEN
-!$OMP DO
-            DO l=1,nlevnc
-                DO j=jjbu,jjeu
-                    DO i=1,iip1
-                        plnc2(i,j,l)=apnc(l)+bpnc(l)*psnat2(i,j)
-                        plnc1(i,j,l)=apnc(l)+bpnc(l)*psnat1(i,j)
-                    ENDDO
-                ENDDO
-            ENDDO
-        ELSE IF (guide_plevs==2) THEN
-!$OMP DO
-            DO l=1,nlevnc
-                DO j=jjbu,jjeu
-                    DO i=1,iip1
-                        plnc2(i,j,l)=pnat2(i,j,l)
-                        plnc1(i,j,l)=pnat1(i,j,l)
-                    ENDDO
-                ENDDO
-            ENDDO
-        ENDIF
-
-        ! Interpolation verticale
-!$OMP MASTER
-        CALL pres2lev(tnat1(:,jjbu:jjeu,:),zu1(:,jjbu:jjeu,:),nlevnc,llm,           &
-                    plnc1(:,jjbu:jjeu,:),plsnc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
-        CALL pres2lev(tnat2(:,jjbu:jjeu,:),zu2(:,jjbu:jjeu,:),nlevnc,llm,           &
-                    plnc2(:,jjbu:jjeu,:),plsnc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
-!$OMP END MASTER
-!$OMP BARRIER
-        ! Conversion en variables GCM
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        do l=1,llm
-            do j=jjbu,jjeu
-                IF (guide_teta) THEN
-                    do i=1,iim
-                        ij=(j-1)*iip1+i
-                        tgui1(ij,l)=zu1(i,j,l)
-                        tgui2(ij,l)=zu2(i,j,l)
-                    enddo
-                ELSE
-                    do i=1,iim
-                        ij=(j-1)*iip1+i
-                        tgui1(ij,l)=zu1(i,j,l)*cpp/pk(i,j,l)
-                        tgui2(ij,l)=zu2(i,j,l)*cpp/pk(i,j,l)
-                    enddo
-                ENDIF
-                tgui1(j*iip1,l)=tgui1((j-1)*iip1+1,l)    
-                tgui2(j*iip1,l)=tgui2((j-1)*iip1+1,l)    
-            enddo
-            if (pole_nord) THEN
-              do i=1,iip1
-                tgui1(i,l)=tgui1(1,l)
-                tgui2(i,l)=tgui2(1,l)
-              enddo
-            endif
-            if (pole_sud) THEN
-              do i=1,iip1
-                tgui1(ip1jm+i,l)=tgui1(ip1jm+1,l) 
-                tgui2(ip1jm+i,l)=tgui2(ip1jm+1,l) 
-              enddo
-           endif
-        enddo
-    ENDIF
-
-    IF (guide_Q) THEN
-        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
-        IF (guide_plevs==1) THEN
-!$OMP DO
-            DO l=1,nlevnc
-                DO j=jjbu,jjeu
-                    DO i=1,iip1
-                        plnc2(i,j,l)=apnc(l)+bpnc(l)*psnat2(i,j)
-                        plnc1(i,j,l)=apnc(l)+bpnc(l)*psnat1(i,j)
-                    ENDDO
-                ENDDO
-            ENDDO
-        ELSE IF (guide_plevs==2) THEN
-!$OMP DO
-            DO l=1,nlevnc
-                DO j=jjbu,jjeu
-                    DO i=1,iip1
-                        plnc2(i,j,l)=pnat2(i,j,l)
-                        plnc1(i,j,l)=pnat1(i,j,l)
-                    ENDDO
-                ENDDO
-            ENDDO
-        ENDIF
-
-        ! Interpolation verticale
-!$OMP MASTER
-        CALL pres2lev(qnat1(:,jjbu:jjeu,:),zu1(:,jjbu:jjeu,:),nlevnc,llm,             &
-                      plnc1(:,jjbu:jjeu,:),plsnc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
-        CALL pres2lev(qnat2(:,jjbu:jjeu,:),zu2(:,jjbu:jjeu,:),nlevnc,llm,             &
-                      plnc2(:,jjbu:jjeu,:),plsnc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
-!$OMP END MASTER
-!$OMP BARRIER
-
-        ! Conversion en variables GCM
-        ! On suppose qu'on a la bonne variable dans le fichier de guidage:
-        ! Hum.Rel si guide_hr, Hum.Spec. sinon.
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        do l=1,llm
-            do j=jjbu,jjeu
-                do i=1,iim
-                    ij=(j-1)*iip1+i
-                    qgui1(ij,l)=zu1(i,j,l)
-                    qgui2(ij,l)=zu2(i,j,l)
-                enddo
-                qgui1(j*iip1,l)=qgui1((j-1)*iip1+1,l)    
-                qgui2(j*iip1,l)=qgui2((j-1)*iip1+1,l)    
-            enddo
-            if (pole_nord) THEN
-              do i=1,iip1
-                qgui1(i,l)=qgui1(1,l)
-                qgui2(i,l)=qgui2(1,l)
-              enddo
-            endif
-            if (pole_sud) THEN
-              do i=1,iip1
-                qgui1(ip1jm+i,l)=qgui1(ip1jm+1,l) 
-                qgui2(ip1jm+i,l)=qgui2(ip1jm+1,l) 
-              enddo
-            endif
-        enddo
-        IF (guide_hr) THEN
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          do l=1,llm
-            CALL q_sat(iip1*jjnu,teta(:,jjbu:jjeu,l)*pk(:,jjbu:jjeu,l)/cpp,       &
-                       plsnc(:,jjbu:jjeu,l),qsat(ijbu:ijeu,l))
-            qgui1(ijbu:ijeu,l)=qgui1(ijbu:ijeu,l)*qsat(ijbu:ijeu,l)*0.01 !hum. rel. en %
-            qgui2(ijbu:ijeu,l)=qgui2(ijbu:ijeu,l)*qsat(ijbu:ijeu,l)*0.01 
-          enddo
-
-        ENDIF
-    ENDIF
-
-    IF (guide_u) THEN
-        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
-        IF (guide_plevs==1) THEN
-!$OMP DO
-            DO l=1,nlevnc
-                DO j=jjbu,jjeu
-                    DO i=1,iim
-                        plnc2(i,j,l)=apnc(l)+bpnc(l)*(psnat2(i,j)*aire(i,j)*alpha1p2(i,j) &
-             +psnat2(i+1,j)*aire(i+1,j)*alpha3p4(i+1,j))/aireu(i,j)
-                        plnc1(i,j,l)=apnc(l)+bpnc(l)*(psnat1(i,j)*aire(i,j)*alpha1p2(i,j) &
-             +psnat1(i+1,j)*aire(i+1,j)*alpha3p4(i+1,j))/aireu(i,j)
-                    ENDDO
-                    plnc2(iip1,j,l)=plnc2(1,j,l)
-                    plnc1(iip1,j,l)=plnc1(1,j,l)
-                ENDDO
-            ENDDO
-        ELSE IF (guide_plevs==2) THEN
-!$OMP DO
-            DO l=1,nlevnc
-                DO j=jjbu,jjeu
-                    DO i=1,iim
-                        plnc2(i,j,l)=(pnat2(i,j,l)*aire(i,j)*alpha1p2(i,j) &
-   +pnat2(i+1,j,l)*aire(i,j)*alpha3p4(i+1,j))/aireu(i,j)
-                        plnc1(i,j,l)=(pnat1(i,j,l)*aire(i,j)*alpha1p2(i,j) &
-   +pnat1(i+1,j,l)*aire(i,j)*alpha3p4(i+1,j))/aireu(i,j)
-                    ENDDO
-                    plnc2(iip1,j,l)=plnc2(1,j,l)
-                    plnc1(iip1,j,l)=plnc1(1,j,l)
-                ENDDO
-            ENDDO
-        ENDIF
-        
-        ! Interpolation verticale
-!$OMP MASTER
-        CALL pres2lev(unat1(:,jjbu:jjeu,:),zu1(:,jjbu:jjeu,:),nlevnc,llm,            &
-                      plnc1(:,jjbu:jjeu,:),plunc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
-        CALL pres2lev(unat2(:,jjbu:jjeu,:),zu2(:,jjbu:jjeu,:),nlevnc,llm,            &
-                      plnc2(:,jjbu:jjeu,:),plunc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
-!$OMP END MASTER
-!$OMP BARRIER
-
-        ! Conversion en variables GCM
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        do l=1,llm
-            do j=jjbu,jjeu
-                do i=1,iim
-                    ij=(j-1)*iip1+i
-                    ugui1(ij,l)=zu1(i,j,l)*cu(i,j)
-                    ugui2(ij,l)=zu2(i,j,l)*cu(i,j)
-                enddo
-                ugui1(j*iip1,l)=ugui1((j-1)*iip1+1,l)    
-                ugui2(j*iip1,l)=ugui2((j-1)*iip1+1,l)    
-            enddo
-            if (pole_nord) THEN
-              do i=1,iip1
-                ugui1(i,l)=0.
-                ugui2(i,l)=0.
-              enddo
-            endif
-            if (pole_sud) THEN
-              do i=1,iip1
-                ugui1(ip1jm+i,l)=0.
-                ugui2(ip1jm+i,l)=0.
-              enddo
-            endif
-        enddo
-    ENDIF
-    
-    IF (guide_v) THEN
-        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
-        IF (guide_plevs==1) THEN
-         CALL Register_Hallo_u(psnat1,1,1,2,2,1,Req)
-         CALL Register_Hallo_u(psnat2,1,1,2,2,1,Req)
-         CALL SendRequest(Req)
-!$OMP BARRIER
-         CALL WaitRequest(Req)
-!$OMP BARRIER
-!$OMP DO
-            DO l=1,nlevnc
-                DO j=jjbv,jjev
-                    DO i=1,iip1
-                        plnc2(i,j,l)=apnc(l)+bpnc(l)*(psnat2(i,j)*aire(i,j)*alpha2p3(i,j) &
-             +psnat2(i,j+1)*aire(i,j+1)*alpha1p4(i,j+1))/airev(i,j)
-                        plnc1(i,j,l)=apnc(l)+bpnc(l)*(psnat1(i,j)*aire(i,j)*alpha2p3(i,j) &
-             +psnat1(i,j+1)*aire(i,j+1)*alpha1p4(i,j+1))/airev(i,j)
-                    ENDDO
-                ENDDO
-            ENDDO
-        ELSE IF (guide_plevs==2) THEN
-         CALL Register_Hallo_u(pnat1,llm,1,2,2,1,Req)
-         CALL Register_Hallo_u(pnat2,llm,1,2,2,1,Req)
-         CALL SendRequest(Req)
-!$OMP BARRIER
-         CALL WaitRequest(Req)
-!$OMP BARRIER
-!$OMP DO
-            DO l=1,nlevnc
-                DO j=jjbv,jjev
-                    DO i=1,iip1
-                        plnc2(i,j,l)=(pnat2(i,j,l)*aire(i,j)*alpha2p3(i,j) &
-   +pnat2(i,j+1,l)*aire(i,j)*alpha1p4(i,j+1))/airev(i,j)
-                        plnc1(i,j,l)=(pnat1(i,j,l)*aire(i,j)*alpha2p3(i,j) &
-   +pnat1(i,j+1,l)*aire(i,j)*alpha1p4(i,j+1))/airev(i,j)
-                    ENDDO
-                ENDDO
-            ENDDO
-        ENDIF
-        ! Interpolation verticale
-
-!$OMP MASTER
-        CALL pres2lev(vnat1(:,jjbv:jjev,:),zv1(:,jjbv:jjev,:),nlevnc,llm,             &
-                      plnc1(:,jjbv:jjev,:),plvnc(:,jjbv:jjev,:),iip1,jjnv,invert_p)
-        CALL pres2lev(vnat2(:,jjbv:jjev,:),zv2(:,jjbv:jjev,:),nlevnc,llm,             &
-                      plnc2(:,jjbv:jjev,:),plvnc(:,jjbv:jjev,:),iip1,jjnv,invert_p)
-!$OMP END MASTER
-!$OMP BARRIER
-        ! Conversion en variables GCM
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        do l=1,llm
-            do j=jjbv,jjev
-                do i=1,iim
-                    ij=(j-1)*iip1+i
-                    vgui1(ij,l)=zv1(i,j,l)*cv(i,j)
-                    vgui2(ij,l)=zv2(i,j,l)*cv(i,j)
-                enddo
-                vgui1(j*iip1,l)=vgui1((j-1)*iip1+1,l)    
-                vgui2(j*iip1,l)=vgui2((j-1)*iip1+1,l)    
-            enddo
-        enddo
-    ENDIF
-    
-
-  END SUBROUTINE guide_interp
-
-!=======================================================================
-  SUBROUTINE tau2alpha(typ,pim,jjb,jje,factt,taumin,taumax,alpha)
-
-! Calcul des constantes de rappel alpha (=1/tau)
-
-    use comconst_mod, ONLY: pi
-    use serre_mod, ONLY: clat, clon, grossismx, grossismy
-    
+
+  !=======================================================================
+  SUBROUTINE guide_interp(psi, teta)
+    USE exner_hyb_loc_m, ONLY: exner_hyb_loc
+    USE exner_milieu_loc_m, ONLY: exner_milieu_loc
+    USE parallel_lmdz
+    USE mod_hallo
+    USE Bands
+    USE comconst_mod, ONLY: cpp, kappa
+    USE comvert_mod, ONLY: preff, pressure_exner, bp, ap, disvert_type
+    USE lmdz_q_sat, ONLY: q_sat
     IMPLICIT NONE
 
@@ -1412,163 +919,646 @@
     include "comgeom2.h"
 
-! input arguments :
+    REAL, DIMENSION (iip1, jjb_u:jje_u), INTENT(IN) :: psi ! Psol gcm
+    REAL, DIMENSION (iip1, jjb_u:jje_u, llm), INTENT(IN) :: teta ! Temp. Pot. gcm
+
+    LOGICAL, SAVE :: first = .TRUE.
+    !$OMP THREADPRIVATE(first)
+    ! Variables pour niveaux pression:
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: plnc1, plnc2 !niveaux pression guidage
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: plunc, plsnc !niveaux pression modele
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: plvnc       !niveaux pression modele
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: p           ! pression intercouches
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: pls, pext   ! var intermediaire
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: pbarx
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: pbary
+    ! Variables pour fonction Exner (P milieu couche)
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: pk
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :) :: pks
+    REAL :: unskap
+    ! Pression de vapeur saturante
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :) :: qsat
+    !Variables intermediaires interpolation
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: zu1, zu2
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: zv1, zv2
+
+    INTEGER :: i, j, l, ij
+    CHARACTER(LEN = 20), PARAMETER :: modname = "guide_interp"
+    TYPE(Request), SAVE :: Req
+    !$OMP THREADPRIVATE(Req)
+
+    IF (is_master) WRITE(*, *)trim(modname) // ': interpolate nudging variables'
+    ! -----------------------------------------------------------------
+    ! Calcul des niveaux de pression champs guidage (pour T et Q)
+    ! -----------------------------------------------------------------
+    IF (first) THEN
+      !$OMP MASTER
+      ALLOCATE(plnc1(iip1, jjb_u:jje_u, nlevnc))
+      ALLOCATE(plnc2(iip1, jjb_u:jje_u, nlevnc))
+      ALLOCATE(plunc(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(plsnc(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(plvnc(iip1, jjb_v:jje_v, llm))
+      ALLOCATE(p(iip1, jjb_u:jje_u, llmp1))
+      ALLOCATE(pls(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(pext(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(pbarx(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(pbary(iip1, jjb_v:jje_v, llm))
+      ALLOCATE(pk(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(pks (iip1, jjb_u:jje_u))
+      ALLOCATE(qsat(ijb_u:ije_u, llm))
+      ALLOCATE(zu1(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(zu2(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(zv1(iip1, jjb_v:jje_v, llm))
+      ALLOCATE(zv2(iip1, jjb_v:jje_v, llm))
+      !$OMP END MASTER
+      !$OMP BARRIER
+    ENDIF
+
+    IF (guide_plevs==0) THEN
+      !$OMP DO
+      DO l = 1, nlevnc
+        DO j = jjbu, jjeu
+          DO i = 1, iip1
+            plnc2(i, j, l) = apnc(l)
+            plnc1(i, j, l) = apnc(l)
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDIF
+
+    IF (first) THEN
+      first = .FALSE.
+      !$OMP MASTER
+      WRITE(*, *)trim(modname) // ' : check vertical level order'
+      WRITE(*, *)trim(modname) // ' LMDZ :'
+      do l = 1, llm
+        WRITE(*, *)trim(modname) // ' PL(', l, ')=', (ap(l) + ap(l + 1)) / 2. &
+                + psi(1, jjeu) * (bp(l) + bp(l + 1)) / 2.
+      enddo
+      WRITE(*, *)trim(modname) // ' nudging file :'
+      SELECT CASE (guide_plevs)
+      CASE (0)
+        do l = 1, nlevnc
+          WRITE(*, *)trim(modname) // ' PL(', l, ')=', plnc2(1, jjbu, l)
+        enddo
+      CASE (1)
+        DO l = 1, nlevnc
+          WRITE(*, *)trim(modname) // ' PL(', l, ')=', &
+                  apnc(l) + bpnc(l) * psnat2(1, jjbu)
+        ENDDO
+      CASE (2)
+        do l = 1, nlevnc
+          WRITE(*, *)trim(modname) // ' PL(', l, ')=', pnat2(1, jjbu, l)
+        enddo
+      END SELECT
+      WRITE(*, *)trim(modname) // ' invert ordering: invert_p=', invert_p
+      IF (guide_u) THEN
+        do l = 1, nlevnc
+          WRITE(*, *)trim(modname) // ' U(', l, ')=', unat2(1, jjbu, l)
+        enddo
+      endif
+      IF (guide_T) THEN
+        do l = 1, nlevnc
+          WRITE(*, *)trim(modname) // ' T(', l, ')=', tnat2(1, jjbu, l)
+        enddo
+      endif
+      !$OMP END MASTER
+    endif ! of if (first)
+
+    IF (guide_plevs /= 1 .OR. guide_t .AND. .NOT. guide_teta &
+            .OR. guide_q .AND. guide_hr) THEN
+      CALL pression_loc(ijnb_u, ap, bp, psi, p)
+      IF (disvert_type==1) THEN
+        CALL exner_hyb_loc(ijnb_u, psi, p, pks, pk)
+      else ! we assume that we are in the disvert_type==2 case
+        CALL exner_milieu_loc(ijnb_u, psi, p, pks, pk)
+      endif
+    end if
+
+    ! -----------------------------------------------------------------
+    ! Calcul niveaux pression modele
+    ! -----------------------------------------------------------------
+
+    !    ....  Calcul de pls , pression au milieu des couches ,en Pascals
+    IF (guide_plevs==1) THEN
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        DO j = jjbu, jjeu
+          DO i = 1, iip1
+            pls(i, j, l) = (ap(l) + ap(l + 1)) / 2. + psi(i, j) * (bp(l) + bp(l + 1)) / 2.
+          ENDDO
+        ENDDO
+      ENDDO
+    ELSE
+      unskap = 1. / kappa
+      !$OMP BARRIER
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        DO j = jjbu, jjeu
+          DO i = 1, iip1
+            pls(i, j, l) = preff * (pk(i, j, l) / cpp) ** unskap
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDIF
+
+    !   calcul des pressions pour les grilles u et v
+    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+    do l = 1, llm
+      do j = jjbu, jjeu
+        do i = 1, iip1
+          pext(i, j, l) = pls(i, j, l) * aire(i, j)
+        enddo
+      enddo
+    enddo
+
+    CALL Register_Hallo_u(pext, llm, 1, 2, 2, 1, Req)
+    CALL SendRequest(Req)
+    !$OMP BARRIER
+    CALL WaitRequest(Req)
+    !$OMP BARRIER
+
+    CALL massbar_loc(pext, pbarx, pbary)
+    !$OMP BARRIER
+    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+    do l = 1, llm
+      do j = jjbu, jjeu
+        do i = 1, iip1
+          plunc(i, j, l) = pbarx(i, j, l) / aireu(i, j)
+          plsnc(i, j, l) = pls(i, j, l)
+        enddo
+      enddo
+    enddo
+    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+    do l = 1, llm
+      do j = jjbv, jjev
+        do i = 1, iip1
+          plvnc(i, j, l) = pbary(i, j, l) / airev(i, j)
+        enddo
+      enddo
+    enddo
+
+    ! -----------------------------------------------------------------
+    ! Interpolation verticale champs guidage sur niveaux modele
+    ! Conversion en variables gcm (ucov, vcov...)
+    ! -----------------------------------------------------------------
+    IF (guide_P) THEN
+      !$OMP MASTER
+      do j = jjbu, jjeu
+        do i = 1, iim
+          ij = (j - 1) * iip1 + i
+          psgui1(ij) = psnat1(i, j)
+          psgui2(ij) = psnat2(i, j)
+        enddo
+        psgui1(iip1 * j) = psnat1(1, j)
+        psgui2(iip1 * j) = psnat2(1, j)
+      enddo
+      !$OMP END MASTER
+      !$OMP BARRIER
+    endif
+
+    IF (guide_T) THEN
+      ! Calcul des nouvelles valeurs des niveaux de pression du guidage
+      IF (guide_plevs==1) THEN
+        !$OMP DO
+        DO l = 1, nlevnc
+          DO j = jjbu, jjeu
+            DO i = 1, iip1
+              plnc2(i, j, l) = apnc(l) + bpnc(l) * psnat2(i, j)
+              plnc1(i, j, l) = apnc(l) + bpnc(l) * psnat1(i, j)
+            ENDDO
+          ENDDO
+        ENDDO
+      ELSE IF (guide_plevs==2) THEN
+        !$OMP DO
+        DO l = 1, nlevnc
+          DO j = jjbu, jjeu
+            DO i = 1, iip1
+              plnc2(i, j, l) = pnat2(i, j, l)
+              plnc1(i, j, l) = pnat1(i, j, l)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+
+      ! Interpolation verticale
+      !$OMP MASTER
+      CALL pres2lev(tnat1(:, jjbu:jjeu, :), zu1(:, jjbu:jjeu, :), nlevnc, llm, &
+              plnc1(:, jjbu:jjeu, :), plsnc(:, jjbu:jjeu, :), iip1, jjnu, invert_p)
+      CALL pres2lev(tnat2(:, jjbu:jjeu, :), zu2(:, jjbu:jjeu, :), nlevnc, llm, &
+              plnc2(:, jjbu:jjeu, :), plsnc(:, jjbu:jjeu, :), iip1, jjnu, invert_p)
+      !$OMP END MASTER
+      !$OMP BARRIER
+      ! Conversion en variables GCM
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      do l = 1, llm
+        do j = jjbu, jjeu
+          IF (guide_teta) THEN
+            do i = 1, iim
+              ij = (j - 1) * iip1 + i
+              tgui1(ij, l) = zu1(i, j, l)
+              tgui2(ij, l) = zu2(i, j, l)
+            enddo
+          ELSE
+            do i = 1, iim
+              ij = (j - 1) * iip1 + i
+              tgui1(ij, l) = zu1(i, j, l) * cpp / pk(i, j, l)
+              tgui2(ij, l) = zu2(i, j, l) * cpp / pk(i, j, l)
+            enddo
+          ENDIF
+          tgui1(j * iip1, l) = tgui1((j - 1) * iip1 + 1, l)
+          tgui2(j * iip1, l) = tgui2((j - 1) * iip1 + 1, l)
+        enddo
+        IF (pole_nord) THEN
+          do i = 1, iip1
+            tgui1(i, l) = tgui1(1, l)
+            tgui2(i, l) = tgui2(1, l)
+          enddo
+        endif
+        IF (pole_sud) THEN
+          do i = 1, iip1
+            tgui1(ip1jm + i, l) = tgui1(ip1jm + 1, l)
+            tgui2(ip1jm + i, l) = tgui2(ip1jm + 1, l)
+          enddo
+        endif
+      enddo
+    ENDIF
+
+    IF (guide_Q) THEN
+      ! Calcul des nouvelles valeurs des niveaux de pression du guidage
+      IF (guide_plevs==1) THEN
+        !$OMP DO
+        DO l = 1, nlevnc
+          DO j = jjbu, jjeu
+            DO i = 1, iip1
+              plnc2(i, j, l) = apnc(l) + bpnc(l) * psnat2(i, j)
+              plnc1(i, j, l) = apnc(l) + bpnc(l) * psnat1(i, j)
+            ENDDO
+          ENDDO
+        ENDDO
+      ELSE IF (guide_plevs==2) THEN
+        !$OMP DO
+        DO l = 1, nlevnc
+          DO j = jjbu, jjeu
+            DO i = 1, iip1
+              plnc2(i, j, l) = pnat2(i, j, l)
+              plnc1(i, j, l) = pnat1(i, j, l)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+
+      ! Interpolation verticale
+      !$OMP MASTER
+      CALL pres2lev(qnat1(:, jjbu:jjeu, :), zu1(:, jjbu:jjeu, :), nlevnc, llm, &
+              plnc1(:, jjbu:jjeu, :), plsnc(:, jjbu:jjeu, :), iip1, jjnu, invert_p)
+      CALL pres2lev(qnat2(:, jjbu:jjeu, :), zu2(:, jjbu:jjeu, :), nlevnc, llm, &
+              plnc2(:, jjbu:jjeu, :), plsnc(:, jjbu:jjeu, :), iip1, jjnu, invert_p)
+      !$OMP END MASTER
+      !$OMP BARRIER
+
+      ! Conversion en variables GCM
+      ! On suppose qu'on a la bonne variable dans le fichier de guidage:
+      ! Hum.Rel si guide_hr, Hum.Spec. sinon.
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      do l = 1, llm
+        do j = jjbu, jjeu
+          do i = 1, iim
+            ij = (j - 1) * iip1 + i
+            qgui1(ij, l) = zu1(i, j, l)
+            qgui2(ij, l) = zu2(i, j, l)
+          enddo
+          qgui1(j * iip1, l) = qgui1((j - 1) * iip1 + 1, l)
+          qgui2(j * iip1, l) = qgui2((j - 1) * iip1 + 1, l)
+        enddo
+        IF (pole_nord) THEN
+          do i = 1, iip1
+            qgui1(i, l) = qgui1(1, l)
+            qgui2(i, l) = qgui2(1, l)
+          enddo
+        endif
+        IF (pole_sud) THEN
+          do i = 1, iip1
+            qgui1(ip1jm + i, l) = qgui1(ip1jm + 1, l)
+            qgui2(ip1jm + i, l) = qgui2(ip1jm + 1, l)
+          enddo
+        endif
+      enddo
+      IF (guide_hr) THEN
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        do l = 1, llm
+          CALL q_sat(iip1 * jjnu, teta(:, jjbu:jjeu, l) * pk(:, jjbu:jjeu, l) / cpp, &
+                  plsnc(:, jjbu:jjeu, l), qsat(ijbu:ijeu, l))
+          qgui1(ijbu:ijeu, l) = qgui1(ijbu:ijeu, l) * qsat(ijbu:ijeu, l) * 0.01 !hum. rel. en %
+          qgui2(ijbu:ijeu, l) = qgui2(ijbu:ijeu, l) * qsat(ijbu:ijeu, l) * 0.01
+        enddo
+
+      ENDIF
+    ENDIF
+
+    IF (guide_u) THEN
+      ! Calcul des nouvelles valeurs des niveaux de pression du guidage
+      IF (guide_plevs==1) THEN
+        !$OMP DO
+        DO l = 1, nlevnc
+          DO j = jjbu, jjeu
+            DO i = 1, iim
+              plnc2(i, j, l) = apnc(l) + bpnc(l) * (psnat2(i, j) * aire(i, j) * alpha1p2(i, j) &
+                      + psnat2(i + 1, j) * aire(i + 1, j) * alpha3p4(i + 1, j)) / aireu(i, j)
+              plnc1(i, j, l) = apnc(l) + bpnc(l) * (psnat1(i, j) * aire(i, j) * alpha1p2(i, j) &
+                      + psnat1(i + 1, j) * aire(i + 1, j) * alpha3p4(i + 1, j)) / aireu(i, j)
+            ENDDO
+            plnc2(iip1, j, l) = plnc2(1, j, l)
+            plnc1(iip1, j, l) = plnc1(1, j, l)
+          ENDDO
+        ENDDO
+      ELSE IF (guide_plevs==2) THEN
+        !$OMP DO
+        DO l = 1, nlevnc
+          DO j = jjbu, jjeu
+            DO i = 1, iim
+              plnc2(i, j, l) = (pnat2(i, j, l) * aire(i, j) * alpha1p2(i, j) &
+                      + pnat2(i + 1, j, l) * aire(i, j) * alpha3p4(i + 1, j)) / aireu(i, j)
+              plnc1(i, j, l) = (pnat1(i, j, l) * aire(i, j) * alpha1p2(i, j) &
+                      + pnat1(i + 1, j, l) * aire(i, j) * alpha3p4(i + 1, j)) / aireu(i, j)
+            ENDDO
+            plnc2(iip1, j, l) = plnc2(1, j, l)
+            plnc1(iip1, j, l) = plnc1(1, j, l)
+          ENDDO
+        ENDDO
+      ENDIF
+
+      ! Interpolation verticale
+      !$OMP MASTER
+      CALL pres2lev(unat1(:, jjbu:jjeu, :), zu1(:, jjbu:jjeu, :), nlevnc, llm, &
+              plnc1(:, jjbu:jjeu, :), plunc(:, jjbu:jjeu, :), iip1, jjnu, invert_p)
+      CALL pres2lev(unat2(:, jjbu:jjeu, :), zu2(:, jjbu:jjeu, :), nlevnc, llm, &
+              plnc2(:, jjbu:jjeu, :), plunc(:, jjbu:jjeu, :), iip1, jjnu, invert_p)
+      !$OMP END MASTER
+      !$OMP BARRIER
+
+      ! Conversion en variables GCM
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      do l = 1, llm
+        do j = jjbu, jjeu
+          do i = 1, iim
+            ij = (j - 1) * iip1 + i
+            ugui1(ij, l) = zu1(i, j, l) * cu(i, j)
+            ugui2(ij, l) = zu2(i, j, l) * cu(i, j)
+          enddo
+          ugui1(j * iip1, l) = ugui1((j - 1) * iip1 + 1, l)
+          ugui2(j * iip1, l) = ugui2((j - 1) * iip1 + 1, l)
+        enddo
+        IF (pole_nord) THEN
+          do i = 1, iip1
+            ugui1(i, l) = 0.
+            ugui2(i, l) = 0.
+          enddo
+        endif
+        IF (pole_sud) THEN
+          do i = 1, iip1
+            ugui1(ip1jm + i, l) = 0.
+            ugui2(ip1jm + i, l) = 0.
+          enddo
+        endif
+      enddo
+    ENDIF
+
+    IF (guide_v) THEN
+      ! Calcul des nouvelles valeurs des niveaux de pression du guidage
+      IF (guide_plevs==1) THEN
+        CALL Register_Hallo_u(psnat1, 1, 1, 2, 2, 1, Req)
+        CALL Register_Hallo_u(psnat2, 1, 1, 2, 2, 1, Req)
+        CALL SendRequest(Req)
+        !$OMP BARRIER
+        CALL WaitRequest(Req)
+        !$OMP BARRIER
+        !$OMP DO
+        DO l = 1, nlevnc
+          DO j = jjbv, jjev
+            DO i = 1, iip1
+              plnc2(i, j, l) = apnc(l) + bpnc(l) * (psnat2(i, j) * aire(i, j) * alpha2p3(i, j) &
+                      + psnat2(i, j + 1) * aire(i, j + 1) * alpha1p4(i, j + 1)) / airev(i, j)
+              plnc1(i, j, l) = apnc(l) + bpnc(l) * (psnat1(i, j) * aire(i, j) * alpha2p3(i, j) &
+                      + psnat1(i, j + 1) * aire(i, j + 1) * alpha1p4(i, j + 1)) / airev(i, j)
+            ENDDO
+          ENDDO
+        ENDDO
+      ELSE IF (guide_plevs==2) THEN
+        CALL Register_Hallo_u(pnat1, llm, 1, 2, 2, 1, Req)
+        CALL Register_Hallo_u(pnat2, llm, 1, 2, 2, 1, Req)
+        CALL SendRequest(Req)
+        !$OMP BARRIER
+        CALL WaitRequest(Req)
+        !$OMP BARRIER
+        !$OMP DO
+        DO l = 1, nlevnc
+          DO j = jjbv, jjev
+            DO i = 1, iip1
+              plnc2(i, j, l) = (pnat2(i, j, l) * aire(i, j) * alpha2p3(i, j) &
+                      + pnat2(i, j + 1, l) * aire(i, j) * alpha1p4(i, j + 1)) / airev(i, j)
+              plnc1(i, j, l) = (pnat1(i, j, l) * aire(i, j) * alpha2p3(i, j) &
+                      + pnat1(i, j + 1, l) * aire(i, j) * alpha1p4(i, j + 1)) / airev(i, j)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+      ! Interpolation verticale
+
+      !$OMP MASTER
+      CALL pres2lev(vnat1(:, jjbv:jjev, :), zv1(:, jjbv:jjev, :), nlevnc, llm, &
+              plnc1(:, jjbv:jjev, :), plvnc(:, jjbv:jjev, :), iip1, jjnv, invert_p)
+      CALL pres2lev(vnat2(:, jjbv:jjev, :), zv2(:, jjbv:jjev, :), nlevnc, llm, &
+              plnc2(:, jjbv:jjev, :), plvnc(:, jjbv:jjev, :), iip1, jjnv, invert_p)
+      !$OMP END MASTER
+      !$OMP BARRIER
+      ! Conversion en variables GCM
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      do l = 1, llm
+        do j = jjbv, jjev
+          do i = 1, iim
+            ij = (j - 1) * iip1 + i
+            vgui1(ij, l) = zv1(i, j, l) * cv(i, j)
+            vgui2(ij, l) = zv2(i, j, l) * cv(i, j)
+          enddo
+          vgui1(j * iip1, l) = vgui1((j - 1) * iip1 + 1, l)
+          vgui2(j * iip1, l) = vgui2((j - 1) * iip1 + 1, l)
+        enddo
+      enddo
+    ENDIF
+
+  END SUBROUTINE guide_interp
+
+  !=======================================================================
+  SUBROUTINE tau2alpha(typ, pim, jjb, jje, factt, taumin, taumax, alpha)
+
+    ! Calcul des constantes de rappel alpha (=1/tau)
+
+    USE comconst_mod, ONLY: pi
+    USE serre_mod, ONLY: clat, clon, grossismx, grossismy
+
+    IMPLICIT NONE
+
+    include "dimensions.h"
+    include "paramet.h"
+    include "comgeom2.h"
+
+    ! input arguments :
     INTEGER, INTENT(IN) :: typ    ! u(2),v(3), ou scalaire(1)
     INTEGER, INTENT(IN) :: pim ! dimensions en lon
-    INTEGER, INTENT(IN) :: jjb,jje ! dimensions en lat
-    REAL, INTENT(IN)    :: factt   ! pas de temps en fraction de jour
-    REAL, INTENT(IN)    :: taumin,taumax
-! output arguments:
-    REAL, DIMENSION(pim,jjb:jje), INTENT(OUT) :: alpha 
-  
-!  local variables:
-    LOGICAL, SAVE               :: first=.TRUE.
-    REAL, SAVE                  :: gamma,dxdy_min,dxdy_max
-    REAL, DIMENSION (iip1,jjp1) :: zdx,zdy
-    REAL, DIMENSION (iip1,jjp1) :: dxdys,dxdyu
-    REAL, DIMENSION (iip1,jjm)  :: dxdyv
-    real dxdy_
-    real zlat,zlon
-    real alphamin,alphamax,xi
-    integer i,j,ilon,ilat
-    CHARACTER(LEN=20),parameter :: modname="tau2alpha"
-
-
-    alphamin=factt/taumax
-    alphamax=factt/taumin
+    INTEGER, INTENT(IN) :: jjb, jje ! dimensions en lat
+    REAL, INTENT(IN) :: factt   ! pas de temps en fraction de jour
+    REAL, INTENT(IN) :: taumin, taumax
+    ! output arguments:
+    REAL, DIMENSION(pim, jjb:jje), INTENT(OUT) :: alpha
+
+    !  local variables:
+    LOGICAL, SAVE :: first = .TRUE.
+    REAL, SAVE :: gamma, dxdy_min, dxdy_max
+    REAL, DIMENSION (iip1, jjp1) :: zdx, zdy
+    REAL, DIMENSION (iip1, jjp1) :: dxdys, dxdyu
+    REAL, DIMENSION (iip1, jjm) :: dxdyv
+    REAL dxdy_
+    REAL zlat, zlon
+    REAL alphamin, alphamax, xi
+    INTEGER i, j, ilon, ilat
+    CHARACTER(LEN = 20), parameter :: modname = "tau2alpha"
+
+    alphamin = factt / taumax
+    alphamax = factt / taumin
     IF (guide_reg.OR.guide_add) THEN
-        alpha=alphamax
-!-----------------------------------------------------------------------
-! guide_reg: alpha=alpha_min dans region, 0. sinon.
-!-----------------------------------------------------------------------
-        IF (guide_reg) THEN
-            do j=jjb,jje
-                do i=1,pim
-                    if (typ==2) THEN
-                       zlat=rlatu(j)*180./pi
-                       zlon=rlonu(i)*180./pi
-                    elseif (typ==1) THEN
-                       zlat=rlatu(j)*180./pi
-                       zlon=rlonv(i)*180./pi
-                    elseif (typ==3) THEN
-                       zlat=rlatv(j)*180./pi
-                       zlon=rlonv(i)*180./pi
-                    endif
-                    alpha(i,j)=alphamax/16.* &
-                              (1.+tanh((zlat-lat_min_g)/tau_lat))* &
-                              (1.+tanh((lat_max_g-zlat)/tau_lat))* &
-                              (1.+tanh((zlon-lon_min_g)/tau_lon))* &
-                              (1.+tanh((lon_max_g-zlon)/tau_lon))
-                enddo
-            enddo
-        ENDIF
+      alpha = alphamax
+      !-----------------------------------------------------------------------
+      ! guide_reg: alpha=alpha_min dans region, 0. sinon.
+      !-----------------------------------------------------------------------
+      IF (guide_reg) THEN
+        do j = jjb, jje
+          do i = 1, pim
+            IF (typ==2) THEN
+              zlat = rlatu(j) * 180. / pi
+              zlon = rlonu(i) * 180. / pi
+            elseif (typ==1) THEN
+              zlat = rlatu(j) * 180. / pi
+              zlon = rlonv(i) * 180. / pi
+            elseif (typ==3) THEN
+              zlat = rlatv(j) * 180. / pi
+              zlon = rlonv(i) * 180. / pi
+            endif
+            alpha(i, j) = alphamax / 16. * &
+                    (1. + tanh((zlat - lat_min_g) / tau_lat)) * &
+                    (1. + tanh((lat_max_g - zlat) / tau_lat)) * &
+                    (1. + tanh((zlon - lon_min_g) / tau_lon)) * &
+                    (1. + tanh((lon_max_g - zlon) / tau_lon))
+          enddo
+        enddo
+      ENDIF
     ELSE
-!-----------------------------------------------------------------------
-! Sinon, alpha varie entre alpha_min et alpha_max suivant le zoom.
-!-----------------------------------------------------------------------
-!Calcul de l'aire des mailles
-        do j=2,jjm
-            do i=2,iip1
-               zdx(i,j)=0.5*(cu(i-1,j)+cu(i,j))/cos(rlatu(j))
-            enddo
-            zdx(1,j)=zdx(iip1,j)
+      !-----------------------------------------------------------------------
+      ! Sinon, alpha varie entre alpha_min et alpha_max suivant le zoom.
+      !-----------------------------------------------------------------------
+      !Calcul de l'aire des mailles
+      do j = 2, jjm
+        do i = 2, iip1
+          zdx(i, j) = 0.5 * (cu(i - 1, j) + cu(i, j)) / cos(rlatu(j))
         enddo
-        do j=2,jjm
-            do i=1,iip1
-               zdy(i,j)=0.5*(cv(i,j-1)+cv(i,j))
-            enddo
+        zdx(1, j) = zdx(iip1, j)
+      enddo
+      do j = 2, jjm
+        do i = 1, iip1
+          zdy(i, j) = 0.5 * (cv(i, j - 1) + cv(i, j))
         enddo
-        do i=1,iip1
-            zdx(i,1)=zdx(i,2)
-            zdx(i,jjp1)=zdx(i,jjm)
-            zdy(i,1)=zdy(i,2)
-            zdy(i,jjp1)=zdy(i,jjm)
+      enddo
+      do i = 1, iip1
+        zdx(i, 1) = zdx(i, 2)
+        zdx(i, jjp1) = zdx(i, jjm)
+        zdy(i, 1) = zdy(i, 2)
+        zdy(i, jjp1) = zdy(i, jjm)
+      enddo
+      do j = 1, jjp1
+        do i = 1, iip1
+          dxdys(i, j) = sqrt(zdx(i, j) * zdx(i, j) + zdy(i, j) * zdy(i, j))
         enddo
-        do j=1,jjp1
-            do i=1,iip1
-               dxdys(i,j)=sqrt(zdx(i,j)*zdx(i,j)+zdy(i,j)*zdy(i,j))
-            enddo
+      enddo
+      IF (typ==2) THEN
+        do j = 1, jjp1
+          do i = 1, iim
+            dxdyu(i, j) = 0.5 * (dxdys(i, j) + dxdys(i + 1, j))
+          enddo
+          dxdyu(iip1, j) = dxdyu(1, j)
         enddo
-        IF (typ==2) THEN
-            do j=1,jjp1
-                do i=1,iim
-                   dxdyu(i,j)=0.5*(dxdys(i,j)+dxdys(i+1,j))
-                enddo
-                dxdyu(iip1,j)=dxdyu(1,j)
-            enddo
-        ENDIF
-        IF (typ==3) THEN
-            do j=1,jjm
-                do i=1,iip1
-                   dxdyv(i,j)=0.5*(dxdys(i,j)+dxdys(i,j+1))
-                enddo
-            enddo
-        ENDIF
-! Premier appel: calcul des aires min et max et de gamma.
-        IF (first) THEN 
-            first=.FALSE.
-            ! coordonnees du centre du zoom
-            CALL coordij(clon,clat,ilon,ilat) 
-            ! aire de la maille au centre du zoom
-            dxdy_min=dxdys(ilon,ilat)
-            ! dxdy maximale de la maille
-            dxdy_max=0.
-            do j=1,jjp1
-                do i=1,iip1
-                     dxdy_max=max(dxdy_max,dxdys(i,j))
-                enddo
-            enddo
-            ! Calcul de gamma
-            if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) THEN
-              WRITE(*,*)trim(modname)//' ATTENTION modele peu zoome'
-              WRITE(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste'
-              gamma=0.
+      ENDIF
+      IF (typ==3) THEN
+        do j = 1, jjm
+          do i = 1, iip1
+            dxdyv(i, j) = 0.5 * (dxdys(i, j) + dxdys(i, j + 1))
+          enddo
+        enddo
+      ENDIF
+      ! Premier appel: calcul des aires min et max et de gamma.
+      IF (first) THEN
+        first = .FALSE.
+        ! coordonnees du centre du zoom
+        CALL coordij(clon, clat, ilon, ilat)
+        ! aire de la maille au centre du zoom
+        dxdy_min = dxdys(ilon, ilat)
+        ! dxdy maximale de la maille
+        dxdy_max = 0.
+        do j = 1, jjp1
+          do i = 1, iip1
+            dxdy_max = max(dxdy_max, dxdys(i, j))
+          enddo
+        enddo
+        ! Calcul de gamma
+        IF (abs(grossismx - 1.)<0.1.OR.abs(grossismy - 1.)<0.1) THEN
+          WRITE(*, *)trim(modname) // ' ATTENTION modele peu zoome'
+          WRITE(*, *)trim(modname) // ' ATTENTION on prend une constante de guidage cste'
+          gamma = 0.
+        else
+          gamma = (dxdy_max - 2. * dxdy_min) / (dxdy_max - dxdy_min)
+          WRITE(*, *)trim(modname) // ' gamma=', gamma
+          IF (gamma<1.e-5) THEN
+            WRITE(*, *)trim(modname) // ' gamma =', gamma, '<1e-5'
+            CALL abort_gcm("guide_loc_mod", "stopped", 1)
+          endif
+          gamma = log(0.5) / log(gamma)
+          IF (gamma4) THEN
+            gamma = min(gamma, 4.)
+          endif
+          WRITE(*, *)trim(modname) // ' gamma=', gamma
+        endif
+      ENDIF !first
+
+      do j = jjb, jje
+        do i = 1, pim
+          IF (typ==1) THEN
+            dxdy_ = dxdys(i, j)
+            zlat = rlatu(j) * 180. / pi
+          elseif (typ==2) THEN
+            dxdy_ = dxdyu(i, j)
+            zlat = rlatu(j) * 180. / pi
+          elseif (typ==3) THEN
+            dxdy_ = dxdyv(i, j)
+            zlat = rlatv(j) * 180. / pi
+          endif
+          IF (abs(grossismx - 1.)<0.1.OR.abs(grossismy - 1.)<0.1) THEN
+            ! pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin
+            alpha(i, j) = alphamin
+          else
+            xi = ((dxdy_max - dxdy_) / (dxdy_max - dxdy_min))**gamma
+            xi = min(xi, 1.)
+            IF(lat_min_g<=zlat .AND. zlat<=lat_max_g) THEN
+              alpha(i, j) = xi * alphamin + (1. - xi) * alphamax
             else
-              gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
-              WRITE(*,*)trim(modname)//' gamma=',gamma
-              if (gamma<1.e-5) THEN
-                WRITE(*,*)trim(modname)//' gamma =',gamma,'<1e-5'
-                CALL abort_gcm("guide_loc_mod","stopped",1)
-              endif
-              gamma=log(0.5)/log(gamma)
-              if (gamma4) THEN
-                gamma=min(gamma,4.)
-              endif
-              WRITE(*,*)trim(modname)//' gamma=',gamma
+              alpha(i, j) = 0.
             endif
-        ENDIF !first
-
-        do j=jjb,jje
-            do i=1,pim
-                if (typ==1) THEN
-                   dxdy_=dxdys(i,j)
-                   zlat=rlatu(j)*180./pi
-                elseif (typ==2) THEN
-                   dxdy_=dxdyu(i,j)
-                   zlat=rlatu(j)*180./pi
-                elseif (typ==3) THEN
-                   dxdy_=dxdyv(i,j)
-                   zlat=rlatv(j)*180./pi
-                endif
-                if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) THEN
-                ! pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin
-                    alpha(i,j)=alphamin
-                else
-                    xi=((dxdy_max-dxdy_)/(dxdy_max-dxdy_min))**gamma
-                    xi=min(xi,1.)
-                    IF(lat_min_g<=zlat .and. zlat<=lat_max_g) THEN
-                        alpha(i,j)=xi*alphamin+(1.-xi)*alphamax
-                    else
-                        alpha(i,j)=0.
-                    endif
-                endif
-            enddo
+          endif
         enddo
+      enddo
     ENDIF ! guide_reg
 
-    if (.not. guide_add) alpha = 1. - exp(- alpha)
+    IF (.NOT. guide_add) alpha = 1. - exp(- alpha)
 
   END SUBROUTINE tau2alpha
 
-!=======================================================================
+  !=======================================================================
   SUBROUTINE guide_read(timestep)
 
@@ -1578,316 +1568,312 @@
     include "paramet.h"
 
-    INTEGER, INTENT(IN)   :: timestep
-
-    LOGICAL, SAVE         :: first=.TRUE.
-! Identification fichiers et variables NetCDF:
-    INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidp,varidp
-    INTEGER, SAVE         :: ncidQ,varidQ,ncidt,varidt,ncidps,varidps
-    INTEGER               :: ncidpl,varidpl,varidap,varidbp,dimid,lendim
-! Variables auxiliaires NetCDF:
-    INTEGER, DIMENSION(4) :: start,count
-    INTEGER               :: status,rcode
-    CHARACTER (len = 80)   :: abort_message
-    CHARACTER (len = 20)   :: modname = 'guide_read'
-    CHARACTER (len = 20)   :: namedim
-    abort_message='pb in guide_read'
-
-! -----------------------------------------------------------------
-! Premier appel: initialisation de la lecture des fichiers
-! -----------------------------------------------------------------
-    if (first) THEN
-         ncidpl=-99
-         WRITE(*,*) trim(modname)//': opening nudging files '
-! Ap et Bp si Niveaux de pression hybrides
-         if (guide_plevs==1) THEN
-             WRITE(*,*) trim(modname)//' Reading nudging on model levels'
-             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no file apbp.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no AP variable in file apbp.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no BP variable in file apbp.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             WRITE(*,*) trim(modname)//' ncidpl,varidap',ncidpl,varidap
-         endif
-         
-! Pression si guidage sur niveaux P variables
-         if (guide_plevs==2) THEN
-             rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no file P.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no PRES variable in file P.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             WRITE(*,*) trim(modname)//' ncidp,varidp',ncidp,varidp
-             if (ncidpl==-99) ncidpl=ncidp
-         endif
-
-! Vent zonal
-         if (guide_u) THEN
-             rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no file u.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no UWND variable in file u.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             WRITE(*,*) trim(modname)//' ncidu,varidu',ncidu,varidu
-             if (ncidpl==-99) ncidpl=ncidu
-
-    
-             status=nf90_inq_dimid(ncidu, "LONU", dimid)
-             status=nf90_inquire_dimension(ncidu,dimid,namedim,lendim)
-             IF (lendim /= iip1) THEN
-                abort_message='dimension LONU different from iip1 in u.nc'
-                CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-
-             status=nf90_inq_dimid(ncidu, "LATU", dimid)
-             status=nf90_inquire_dimension(ncidu,dimid,namedim,lendim)
-             IF (lendim /= jjp1) THEN
-                abort_message='dimension LATU different from jjp1 in u.nc'
-                CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-  
-         endif
-
-! Vent meridien
-         if (guide_v) THEN
-             rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no file v.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no VWND variable in file v.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             WRITE(*,*) trim(modname)//' ncidv,varidv',ncidv,varidv
-             if (ncidpl==-99) ncidpl=ncidv
-             
-             status=nf90_inq_dimid(ncidv, "LONV", dimid)
-             status=nf90_inquire_dimension(ncidv,dimid,namedim,lendim)
-             
-                IF (lendim /= iip1) THEN
-                abort_message='dimension LONV different from iip1 in v.nc'
-                CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-
-
-             status=nf90_inq_dimid(ncidv, "LATV", dimid)
-             status=nf90_inquire_dimension(ncidv,dimid,namedim,lendim)
-             IF (lendim /= jjm) THEN
-                abort_message='dimension LATV different from jjm in v.nc'
-                CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-        
-        endif
-
-! Temperature
-         if (guide_T) THEN
-             rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no file T.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no AIR variable in file T.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             WRITE(*,*) trim(modname)//' ncidT,varidT',ncidt,varidt
-             if (ncidpl==-99) ncidpl=ncidt
-
-             status=nf90_inq_dimid(ncidt, "LONV", dimid)
-             status=nf90_inquire_dimension(ncidt,dimid,namedim,lendim)
-             IF (lendim /= iip1) THEN
-                abort_message='dimension LONV different from iip1 in T.nc'
-                CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-
-             status=nf90_inq_dimid(ncidt, "LATU", dimid)
-             status=nf90_inquire_dimension(ncidt,dimid,namedim,lendim)
-             IF (lendim /= jjp1) THEN
-                abort_message='dimension LATU different from jjp1 in T.nc'
-                CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-
-         endif
-
-! Humidite
-         if (guide_Q) THEN
-             rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no file hur.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no RH variable in file hur.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             WRITE(*,*) trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
-             if (ncidpl==-99) ncidpl=ncidQ
-
-
-             status=nf90_inq_dimid(ncidQ, "LONV", dimid)
-             status=nf90_inquire_dimension(ncidQ,dimid,namedim,lendim)
-             IF (lendim /= iip1) THEN
-                abort_message='dimension LONV different from iip1 in hur.nc'
-                CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-
-             status=nf90_inq_dimid(ncidQ, "LATU", dimid)
-             status=nf90_inquire_dimension(ncidQ,dimid,namedim,lendim)
-             IF (lendim /= jjp1) THEN
-                abort_message='dimension LATU different from jjp1 in hur.nc'
-                CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-
-
-         endif
-! Pression de surface
-         if ((guide_P).OR.(guide_plevs==1)) THEN
-             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no file ps.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             rcode = nf90_inq_varid(ncidps, 'SP', varidps)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no SP variable in file ps.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             WRITE(*,*) trim(modname)//' ncidps,varidps',ncidps,varidps
-         endif
-! Coordonnee verticale
-         if (guide_plevs==0) THEN
-              rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
-              IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
-              WRITE(*,*) trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
-         endif
-! Coefs ap, bp pour calcul de la pression aux differents niveaux
-         IF (guide_plevs==1) THEN
-             status=nf90_put_var(ncidpl,varidap,apnc,[1],[nlevnc])
-             status=nf90_put_var(ncidpl,varidbp,bpnc,[1],[nlevnc])
-         ELSEIF (guide_plevs==0) THEN
-             status=nf90_put_var(ncidpl,varidpl,apnc,[1],[nlevnc])
-!FC Pour les corrections la pression est deja en Pascals on commente la ligne ci-dessous
-             IF(convert_Pa) apnc=apnc*100.! conversion en Pascals
-             bpnc(:)=0.
-         ENDIF
-         first=.FALSE.
-     ENDIF ! (first)
-
-! -----------------------------------------------------------------
-!   lecture des champs u, v, T, Q, ps
-! -----------------------------------------------------------------
-
-!  dimensions pour les champs scalaires et le vent zonal
-     start(1)=1
-     start(2)=jjb_u
-     start(3)=1
-     start(4)=timestep
-
-     count(1)=iip1
-     count(2)=jjnb_u
-     count(3)=nlevnc
-     count(4)=1
-
-     IF (invert_y) start(2)=jjp1-jje_u+1
-! Pression 
-     if (guide_plevs==2) THEN
-         status=nf90_put_var(ncidp,varidp,pnat2,start,count)
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,nlevnc,pnat2)
-         ENDIF
-     endif
-
-!  Vent zonal
-     if (guide_u) THEN
-         status=nf90_put_var(ncidu,varidu,unat2,start,count)
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,nlevnc,unat2)
-         ENDIF
-
-     endif
-
-
-!  Temperature
-     if (guide_T) THEN
-         status=nf90_put_var(ncidt,varidt,tnat2,start,count)
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,nlevnc,tnat2)
-         ENDIF
-     endif
-
-!  Humidite
-     if (guide_Q) THEN
-         status=nf90_put_var(ncidQ,varidQ,qnat2,start,count)
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,nlevnc,qnat2)
-         ENDIF
-
-     endif
-
-!  Vent meridien
-     if (guide_v) THEN
-         start(2)=jjb_v
-         count(2)=jjnb_v
-         IF (invert_y) start(2)=jjm-jje_v+1
-
-         status=nf90_put_var(ncidv,varidv,vnat2,start,count)
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_v,nlevnc,vnat2)
-         ENDIF
-     endif
-
-!  Pression de surface
-     if ((guide_P).OR.(guide_plevs==1))  THEN
-         start(2)=jjb_u
-         start(3)=timestep
-         start(4)=0
-         count(2)=jjnb_u
-         count(3)=1
-         count(4)=0
-         IF (invert_y) start(2)=jjp1-jje_u+1
-         status=nf90_put_var(ncidps,varidps,psnat2,start,count)
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,1,psnat2)
-         ENDIF
-     endif
+    INTEGER, INTENT(IN) :: timestep
+
+    LOGICAL, SAVE :: first = .TRUE.
+    ! Identification fichiers et variables NetCDF:
+    INTEGER, SAVE :: ncidu, varidu, ncidv, varidv, ncidp, varidp
+    INTEGER, SAVE :: ncidQ, varidQ, ncidt, varidt, ncidps, varidps
+    INTEGER :: ncidpl, varidpl, varidap, varidbp, dimid, lendim
+    ! Variables auxiliaires NetCDF:
+    INTEGER, DIMENSION(4) :: start, count
+    INTEGER :: status, rcode
+    CHARACTER (len = 80) :: abort_message
+    CHARACTER (len = 20) :: modname = 'guide_read'
+    CHARACTER (len = 20) :: namedim
+    abort_message = 'pb in guide_read'
+
+    ! -----------------------------------------------------------------
+    ! Premier appel: initialisation de la lecture des fichiers
+    ! -----------------------------------------------------------------
+    IF (first) THEN
+      ncidpl = -99
+      WRITE(*, *) trim(modname) // ': opening nudging files '
+      ! Ap et Bp si Niveaux de pression hybrides
+      IF (guide_plevs==1) THEN
+        WRITE(*, *) trim(modname) // ' Reading nudging on model levels'
+        rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file apbp.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no AP variable in file apbp.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no BP variable in file apbp.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *) trim(modname) // ' ncidpl,varidap', ncidpl, varidap
+      endif
+
+      ! Pression si guidage sur niveaux P variables
+      IF (guide_plevs==2) THEN
+        rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file P.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no PRES variable in file P.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *) trim(modname) // ' ncidp,varidp', ncidp, varidp
+        IF (ncidpl==-99) ncidpl = ncidp
+      endif
+
+      ! Vent zonal
+      IF (guide_u) THEN
+        rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file u.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no UWND variable in file u.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *) trim(modname) // ' ncidu,varidu', ncidu, varidu
+        IF (ncidpl==-99) ncidpl = ncidu
+
+        status = nf90_inq_dimid(ncidu, "LONU", dimid)
+        status = nf90_inquire_dimension(ncidu, dimid, namedim, lendim)
+        IF (lendim /= iip1) THEN
+          abort_message = 'dimension LONU different from iip1 in u.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+
+        status = nf90_inq_dimid(ncidu, "LATU", dimid)
+        status = nf90_inquire_dimension(ncidu, dimid, namedim, lendim)
+        IF (lendim /= jjp1) THEN
+          abort_message = 'dimension LATU different from jjp1 in u.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+
+      endif
+
+      ! Vent meridien
+      IF (guide_v) THEN
+        rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file v.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no VWND variable in file v.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *) trim(modname) // ' ncidv,varidv', ncidv, varidv
+        IF (ncidpl==-99) ncidpl = ncidv
+
+        status = nf90_inq_dimid(ncidv, "LONV", dimid)
+        status = nf90_inquire_dimension(ncidv, dimid, namedim, lendim)
+
+        IF (lendim /= iip1) THEN
+          abort_message = 'dimension LONV different from iip1 in v.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+
+        status = nf90_inq_dimid(ncidv, "LATV", dimid)
+        status = nf90_inquire_dimension(ncidv, dimid, namedim, lendim)
+        IF (lendim /= jjm) THEN
+          abort_message = 'dimension LATV different from jjm in v.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+
+      endif
+
+      ! Temperature
+      IF (guide_T) THEN
+        rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file T.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no AIR variable in file T.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *) trim(modname) // ' ncidT,varidT', ncidt, varidt
+        IF (ncidpl==-99) ncidpl = ncidt
+
+        status = nf90_inq_dimid(ncidt, "LONV", dimid)
+        status = nf90_inquire_dimension(ncidt, dimid, namedim, lendim)
+        IF (lendim /= iip1) THEN
+          abort_message = 'dimension LONV different from iip1 in T.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+
+        status = nf90_inq_dimid(ncidt, "LATU", dimid)
+        status = nf90_inquire_dimension(ncidt, dimid, namedim, lendim)
+        IF (lendim /= jjp1) THEN
+          abort_message = 'dimension LATU different from jjp1 in T.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+
+      endif
+
+      ! Humidite
+      IF (guide_Q) THEN
+        rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file hur.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no RH variable in file hur.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *) trim(modname) // ' ncidQ,varidQ', ncidQ, varidQ
+        IF (ncidpl==-99) ncidpl = ncidQ
+
+        status = nf90_inq_dimid(ncidQ, "LONV", dimid)
+        status = nf90_inquire_dimension(ncidQ, dimid, namedim, lendim)
+        IF (lendim /= iip1) THEN
+          abort_message = 'dimension LONV different from iip1 in hur.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+
+        status = nf90_inq_dimid(ncidQ, "LATU", dimid)
+        status = nf90_inquire_dimension(ncidQ, dimid, namedim, lendim)
+        IF (lendim /= jjp1) THEN
+          abort_message = 'dimension LATU different from jjp1 in hur.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+
+      endif
+      ! Pression de surface
+      IF ((guide_P).OR.(guide_plevs==1)) THEN
+        rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file ps.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidps, 'SP', varidps)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no SP variable in file ps.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *) trim(modname) // ' ncidps,varidps', ncidps, varidps
+      endif
+      ! Coordonnee verticale
+      IF (guide_plevs==0) THEN
+        rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
+        IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
+        WRITE(*, *) trim(modname) // ' ncidpl,varidpl', ncidpl, varidpl
+      endif
+      ! Coefs ap, bp pour calcul de la pression aux differents niveaux
+      IF (guide_plevs==1) THEN
+        status = nf90_put_var(ncidpl, varidap, apnc, [1], [nlevnc])
+        status = nf90_put_var(ncidpl, varidbp, bpnc, [1], [nlevnc])
+      ELSEIF (guide_plevs==0) THEN
+        status = nf90_put_var(ncidpl, varidpl, apnc, [1], [nlevnc])
+        !FC Pour les corrections la pression est deja en Pascals on commente la ligne ci-dessous
+        IF(convert_Pa) apnc = apnc * 100.! conversion en Pascals
+        bpnc(:) = 0.
+      ENDIF
+      first = .FALSE.
+    ENDIF ! (first)
+
+    ! -----------------------------------------------------------------
+    !   lecture des champs u, v, T, Q, ps
+    ! -----------------------------------------------------------------
+
+    !  dimensions pour les champs scalaires et le vent zonal
+    start(1) = 1
+    start(2) = jjb_u
+    start(3) = 1
+    start(4) = timestep
+
+    count(1) = iip1
+    count(2) = jjnb_u
+    count(3) = nlevnc
+    count(4) = 1
+
+    IF (invert_y) start(2) = jjp1 - jje_u + 1
+    ! Pression
+    IF (guide_plevs==2) THEN
+      status = nf90_put_var(ncidp, varidp, pnat2, start, count)
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, nlevnc, pnat2)
+      ENDIF
+    endif
+
+    !  Vent zonal
+    IF (guide_u) THEN
+      status = nf90_put_var(ncidu, varidu, unat2, start, count)
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, nlevnc, unat2)
+      ENDIF
+
+    endif
+
+
+    !  Temperature
+    IF (guide_T) THEN
+      status = nf90_put_var(ncidt, varidt, tnat2, start, count)
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, nlevnc, tnat2)
+      ENDIF
+    endif
+
+    !  Humidite
+    IF (guide_Q) THEN
+      status = nf90_put_var(ncidQ, varidQ, qnat2, start, count)
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, nlevnc, qnat2)
+      ENDIF
+
+    endif
+
+    !  Vent meridien
+    IF (guide_v) THEN
+      start(2) = jjb_v
+      count(2) = jjnb_v
+      IF (invert_y) start(2) = jjm - jje_v + 1
+
+      status = nf90_put_var(ncidv, varidv, vnat2, start, count)
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_v, nlevnc, vnat2)
+      ENDIF
+    endif
+
+    !  Pression de surface
+    IF ((guide_P).OR.(guide_plevs==1))  THEN
+      start(2) = jjb_u
+      start(3) = timestep
+      start(4) = 0
+      count(2) = jjnb_u
+      count(3) = 1
+      count(4) = 0
+      IF (invert_y) start(2) = jjp1 - jje_u + 1
+      status = nf90_put_var(ncidps, varidps, psnat2, start, count)
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, 1, psnat2)
+      ENDIF
+    endif
 
   END SUBROUTINE guide_read
 
-!=======================================================================
+  !=======================================================================
   SUBROUTINE guide_read2D(timestep)
 
@@ -1897,276 +1883,276 @@
     include "paramet.h"
 
-    INTEGER, INTENT(IN)   :: timestep
-
-    LOGICAL, SAVE         :: first=.TRUE.
-! Identification fichiers et variables NetCDF:
-    INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidp,varidp
-    INTEGER, SAVE         :: ncidQ,varidQ,ncidt,varidt,ncidps,varidps
-    INTEGER               :: ncidpl,varidpl,varidap,varidbp
-! Variables auxiliaires NetCDF:
-    INTEGER, DIMENSION(4) :: start,count
-    INTEGER               :: status,rcode
-! Variables for 3D extension:
-    REAL, DIMENSION (jjb_u:jje_u,llm)  :: zu
-    REAL, DIMENSION (jjb_v:jje_v,llm)  :: zv
-    INTEGER               :: i
-    CHARACTER (len = 80)   :: abort_message
-    CHARACTER (len = 20)   :: modname = 'guide_read2D'
-    abort_message='pb in guide_read2D'
-
-! -----------------------------------------------------------------
-! Premier appel: initialisation de la lecture des fichiers
-! -----------------------------------------------------------------
-    if (first) THEN
-         ncidpl=-99
-         WRITE(*,*)trim(modname)//' : opening nudging files '
-! Ap et Bp si niveaux de pression hybrides
-         if (guide_plevs==1) THEN
-           WRITE(*,*)trim(modname)//' Reading nudging on model levels'
-           rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no file apbp.nc'
-           CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no AP variable in file apbp.nc'
-           CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no BP variable in file apbp.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           WRITE(*,*)trim(modname)//'ncidpl,varidap',ncidpl,varidap
-         endif
-! Pression
-         if (guide_plevs==2) THEN
-           rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no file P.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no PRES variable in file P.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           WRITE(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp
-           if (ncidpl==-99) ncidpl=ncidp
-         endif
-! Vent zonal
-         if (guide_u) THEN
-           rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no file u.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no UWND variable in file u.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           WRITE(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu
-           if (ncidpl==-99) ncidpl=ncidu
-         endif
-
-! Vent meridien
-         if (guide_v) THEN
-           rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no file v.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no VWND variable in file v.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           WRITE(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv
-           if (ncidpl==-99) ncidpl=ncidv
-        endif
-! Temperature
-         if (guide_T) THEN
-           rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no file T.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no AIR variable in file T.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           WRITE(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt
-           if (ncidpl==-99) ncidpl=ncidt
-         endif
-! Humidite
-         if (guide_Q) THEN
-           rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no file hur.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no RH,variable in file hur.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           WRITE(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
-           if (ncidpl==-99) ncidpl=ncidQ
-         endif
-! Pression de surface
-         if ((guide_P).OR.(guide_plevs==1)) THEN
-           rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no file ps.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           rcode = nf90_inq_varid(ncidps, 'SP', varidps)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no SP variable in file ps.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           WRITE(*,*)trim(modname)//' ncidps,varidps',ncidps,varidps
-         endif
-! Coordonnee verticale
-         if (guide_plevs==0) THEN
-           rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
-           IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
-           WRITE(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
-         endif
-! Coefs ap, bp pour calcul de la pression aux differents niveaux
-         if (guide_plevs==1) THEN
-             status=nf90_put_var(ncidpl,varidap,apnc,[1],[nlevnc])
-             status=nf90_put_var(ncidpl,varidbp,bpnc,[1],[nlevnc])
-         elseif (guide_plevs==0) THEN
-             status=nf90_put_var(ncidpl,varidpl,apnc,[1],[nlevnc])
-             apnc=apnc*100.! conversion en Pascals
-             bpnc(:)=0.
-         endif
-         first=.FALSE.
-     endif ! (first)
-
-! -----------------------------------------------------------------
-!   lecture des champs u, v, T, Q, ps
-! -----------------------------------------------------------------
-
-!  dimensions pour les champs scalaires et le vent zonal
-     start(1)=1
-     start(2)=jjb_u
-     start(3)=1
-     start(4)=timestep
-
-     count(1)=1
-     count(2)=jjnb_u
-     count(3)=nlevnc
-     count(4)=1
-
-     IF (invert_y) start(2)=jjp1-jje_u+1
-!  Pression
-     if (guide_plevs==2) THEN
-         status=nf90_put_var(ncidp,varidp,zu,start,count)
-         DO i=1,iip1
-             pnat2(i,:,:)=zu(:,:)
-         ENDDO
-
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,nlevnc,pnat2)
-         ENDIF
-     endif
-!  Vent zonal
-     if (guide_u) THEN
-         status=nf90_put_var(ncidu,varidu,zu,start,count)
-         DO i=1,iip1
-             unat2(i,:,:)=zu(:,:)
-         ENDDO
-
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,nlevnc,unat2)
-         ENDIF
-     endif
-
-
-!  Temperature
-     if (guide_T) THEN
-         status=nf90_put_var(ncidt,varidt,zu,start,count)
-         DO i=1,iip1
-             tnat2(i,:,:)=zu(:,:)
-         ENDDO
-
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,nlevnc,tnat2)
-         ENDIF
-     endif
-
-!  Humidite
-     if (guide_Q) THEN
-         status=nf90_put_var(ncidQ,varidQ,zu,start,count)
-         DO i=1,iip1
-             qnat2(i,:,:)=zu(:,:)
-         ENDDO
-         
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,nlevnc,qnat2)
-         ENDIF
-     endif
-
-!  Vent meridien
-     if (guide_v) THEN
-         start(2)=jjb_v
-         count(2)=jjnb_v
-         IF (invert_y) start(2)=jjm-jje_v+1
-         status=nf90_put_var(ncidv,varidv,zv,start,count)
-         DO i=1,iip1
-             vnat2(i,:,:)=zv(:,:)
-         ENDDO
-
-         IF (invert_y) THEN
- 
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_v,nlevnc,vnat2)
-         ENDIF
-     endif
-
-!  Pression de surface
-     if ((guide_P).OR.(guide_plevs==1))  THEN
-         start(2)=jjb_u
-         start(3)=timestep
-         start(4)=0
-         count(2)=jjnb_u
-         count(3)=1
-         count(4)=0
-         IF (invert_y) start(2)=jjp1-jje_u+1
-         status=nf90_put_var(ncidps,varidps,zu(:,1),start,count)
-         DO i=1,iip1
-             psnat2(i,:)=zu(:,1)
-         ENDDO
-
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,1,psnat2)
-         ENDIF
-     endif
+    INTEGER, INTENT(IN) :: timestep
+
+    LOGICAL, SAVE :: first = .TRUE.
+    ! Identification fichiers et variables NetCDF:
+    INTEGER, SAVE :: ncidu, varidu, ncidv, varidv, ncidp, varidp
+    INTEGER, SAVE :: ncidQ, varidQ, ncidt, varidt, ncidps, varidps
+    INTEGER :: ncidpl, varidpl, varidap, varidbp
+    ! Variables auxiliaires NetCDF:
+    INTEGER, DIMENSION(4) :: start, count
+    INTEGER :: status, rcode
+    ! Variables for 3D extension:
+    REAL, DIMENSION (jjb_u:jje_u, llm) :: zu
+    REAL, DIMENSION (jjb_v:jje_v, llm) :: zv
+    INTEGER :: i
+    CHARACTER (len = 80) :: abort_message
+    CHARACTER (len = 20) :: modname = 'guide_read2D'
+    abort_message = 'pb in guide_read2D'
+
+    ! -----------------------------------------------------------------
+    ! Premier appel: initialisation de la lecture des fichiers
+    ! -----------------------------------------------------------------
+    IF (first) THEN
+      ncidpl = -99
+      WRITE(*, *)trim(modname) // ' : opening nudging files '
+      ! Ap et Bp si niveaux de pression hybrides
+      IF (guide_plevs==1) THEN
+        WRITE(*, *)trim(modname) // ' Reading nudging on model levels'
+        rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file apbp.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no AP variable in file apbp.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no BP variable in file apbp.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *)trim(modname) // 'ncidpl,varidap', ncidpl, varidap
+      endif
+      ! Pression
+      IF (guide_plevs==2) THEN
+        rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file P.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no PRES variable in file P.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *)trim(modname) // ' ncidp,varidp', ncidp, varidp
+        IF (ncidpl==-99) ncidpl = ncidp
+      endif
+      ! Vent zonal
+      IF (guide_u) THEN
+        rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file u.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no UWND variable in file u.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *)trim(modname) // ' ncidu,varidu', ncidu, varidu
+        IF (ncidpl==-99) ncidpl = ncidu
+      endif
+
+      ! Vent meridien
+      IF (guide_v) THEN
+        rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file v.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no VWND variable in file v.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *)trim(modname) // ' ncidv,varidv', ncidv, varidv
+        IF (ncidpl==-99) ncidpl = ncidv
+      endif
+      ! Temperature
+      IF (guide_T) THEN
+        rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file T.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no AIR variable in file T.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *)trim(modname) // ' ncidT,varidT', ncidt, varidt
+        IF (ncidpl==-99) ncidpl = ncidt
+      endif
+      ! Humidite
+      IF (guide_Q) THEN
+        rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file hur.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no RH,variable in file hur.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *)trim(modname) // ' ncidQ,varidQ', ncidQ, varidQ
+        IF (ncidpl==-99) ncidpl = ncidQ
+      endif
+      ! Pression de surface
+      IF ((guide_P).OR.(guide_plevs==1)) THEN
+        rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file ps.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidps, 'SP', varidps)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no SP variable in file ps.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *)trim(modname) // ' ncidps,varidps', ncidps, varidps
+      endif
+      ! Coordonnee verticale
+      IF (guide_plevs==0) THEN
+        rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
+        IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
+        WRITE(*, *)trim(modname) // ' ncidpl,varidpl', ncidpl, varidpl
+      endif
+      ! Coefs ap, bp pour calcul de la pression aux differents niveaux
+      IF (guide_plevs==1) THEN
+        status = nf90_put_var(ncidpl, varidap, apnc, [1], [nlevnc])
+        status = nf90_put_var(ncidpl, varidbp, bpnc, [1], [nlevnc])
+      elseif (guide_plevs==0) THEN
+        status = nf90_put_var(ncidpl, varidpl, apnc, [1], [nlevnc])
+        apnc = apnc * 100.! conversion en Pascals
+        bpnc(:) = 0.
+      endif
+      first = .FALSE.
+    endif ! (first)
+
+    ! -----------------------------------------------------------------
+    !   lecture des champs u, v, T, Q, ps
+    ! -----------------------------------------------------------------
+
+    !  dimensions pour les champs scalaires et le vent zonal
+    start(1) = 1
+    start(2) = jjb_u
+    start(3) = 1
+    start(4) = timestep
+
+    count(1) = 1
+    count(2) = jjnb_u
+    count(3) = nlevnc
+    count(4) = 1
+
+    IF (invert_y) start(2) = jjp1 - jje_u + 1
+    !  Pression
+    IF (guide_plevs==2) THEN
+      status = nf90_put_var(ncidp, varidp, zu, start, count)
+      DO i = 1, iip1
+        pnat2(i, :, :) = zu(:, :)
+      ENDDO
+
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, nlevnc, pnat2)
+      ENDIF
+    endif
+    !  Vent zonal
+    IF (guide_u) THEN
+      status = nf90_put_var(ncidu, varidu, zu, start, count)
+      DO i = 1, iip1
+        unat2(i, :, :) = zu(:, :)
+      ENDDO
+
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, nlevnc, unat2)
+      ENDIF
+    endif
+
+
+    !  Temperature
+    IF (guide_T) THEN
+      status = nf90_put_var(ncidt, varidt, zu, start, count)
+      DO i = 1, iip1
+        tnat2(i, :, :) = zu(:, :)
+      ENDDO
+
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, nlevnc, tnat2)
+      ENDIF
+    endif
+
+    !  Humidite
+    IF (guide_Q) THEN
+      status = nf90_put_var(ncidQ, varidQ, zu, start, count)
+      DO i = 1, iip1
+        qnat2(i, :, :) = zu(:, :)
+      ENDDO
+
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, nlevnc, qnat2)
+      ENDIF
+    endif
+
+    !  Vent meridien
+    IF (guide_v) THEN
+      start(2) = jjb_v
+      count(2) = jjnb_v
+      IF (invert_y) start(2) = jjm - jje_v + 1
+      status = nf90_put_var(ncidv, varidv, zv, start, count)
+      DO i = 1, iip1
+        vnat2(i, :, :) = zv(:, :)
+      ENDDO
+
+      IF (invert_y) THEN
+
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_v, nlevnc, vnat2)
+      ENDIF
+    endif
+
+    !  Pression de surface
+    IF ((guide_P).OR.(guide_plevs==1))  THEN
+      start(2) = jjb_u
+      start(3) = timestep
+      start(4) = 0
+      count(2) = jjnb_u
+      count(3) = 1
+      count(4) = 0
+      IF (invert_y) start(2) = jjp1 - jje_u + 1
+      status = nf90_put_var(ncidps, varidps, zu(:, 1), start, count)
+      DO i = 1, iip1
+        psnat2(i, :) = zu(:, 1)
+      ENDDO
+
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, 1, psnat2)
+      ENDIF
+    endif
 
   END SUBROUTINE guide_read2D
-  
-!=======================================================================
-  SUBROUTINE guide_out(varname,hsize,vsize,field_loc,factt)
+
+  !=======================================================================
+  SUBROUTINE guide_out(varname, hsize, vsize, field_loc, factt)
     USE parallel_lmdz
     USE mod_hallo, ONLY: gather_field_u, gather_field_v
     USE comconst_mod, ONLY: pi
     USE comvert_mod, ONLY: presnivs
-    use netcdf95, ONLY: nf95_def_var, nf95_put_var
+    USE netcdf95, ONLY: nf95_def_var, nf95_put_var
 
     IMPLICIT NONE
@@ -2175,262 +2161,260 @@
     INCLUDE "paramet.h"
     INCLUDE "comgeom2.h"
-    
+
     ! Variables entree
-    CHARACTER*(*), INTENT(IN)                      :: varname
-    INTEGER,   INTENT (IN)                         :: hsize,vsize
-!   REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field_loc
-    REAL, DIMENSION (:,:), INTENT(IN) :: field_loc
+    CHARACTER*(*), INTENT(IN) :: varname
+    INTEGER, INTENT (IN) :: hsize, vsize
+    !   REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field_loc
+    REAL, DIMENSION (:, :), INTENT(IN) :: field_loc
     REAL factt
 
     ! Variables locales
-    INTEGER, SAVE :: timestep=0
+    INTEGER, SAVE :: timestep = 0
     ! Identites fichier netcdf
-    INTEGER       :: nid, id_lonu, id_lonv, id_latu, id_latv, id_tim, id_lev
-    INTEGER       :: vid_lonu,vid_lonv,vid_latu,vid_latv,vid_cu,vid_cv,vid_lev
-    INTEGER       :: vid_au,vid_av, varid_alpha_t, varid_alpha_q
+    INTEGER :: nid, id_lonu, id_lonv, id_latu, id_latv, id_tim, id_lev
+    INTEGER :: vid_lonu, vid_lonv, vid_latu, vid_latv, vid_cu, vid_cv, vid_lev
+    INTEGER :: vid_au, vid_av, varid_alpha_t, varid_alpha_q
     INTEGER, DIMENSION (3) :: dim3
-    INTEGER, DIMENSION (4) :: dim4,count,start
-    INTEGER                :: ierr, varid,l
-    REAL zu(ip1jmp1),zv(ip1jm), zt(iip1, jjp1), zq(iip1, jjp1)
-    REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: field_glo
-    CHARACTER(LEN=20),PARAMETER :: modname="guide_out"
-    
-!$OMP MASTER
-    ALLOCATE(field_glo(iip1,hsize,vsize))
-!$OMP END MASTER
-!$OMP BARRIER
-
-!    WRITE(*,*)trim(modname)//' after allocation ',hsize,vsize
+    INTEGER, DIMENSION (4) :: dim4, count, start
+    INTEGER :: ierr, varid, l
+    REAL zu(ip1jmp1), zv(ip1jm), zt(iip1, jjp1), zq(iip1, jjp1)
+    REAL, ALLOCATABLE, SAVE, DIMENSION(:, :, :) :: field_glo
+    CHARACTER(LEN = 20), PARAMETER :: modname = "guide_out"
+
+    !$OMP MASTER
+    ALLOCATE(field_glo(iip1, hsize, vsize))
+    !$OMP END MASTER
+    !$OMP BARRIER
+
+    !    WRITE(*,*)trim(modname)//' after allocation ',hsize,vsize
 
     IF (hsize==jjp1) THEN
-        CALL gather_field_u(field_loc,field_glo,vsize)
+      CALL gather_field_u(field_loc, field_glo, vsize)
     ELSE IF (hsize==jjm) THEN
-       CALL gather_field_v(field_loc,field_glo, vsize)
-    ENDIF
-
-!    WRITE(*,*)trim(modname)//' after gather '
-    CALL Gather_field_u(alpha_u,zu,1)
-    CALL Gather_field_u(alpha_t,zt,1)
-    CALL Gather_field_u(alpha_q,zq,1)
-    CALL Gather_field_v(alpha_v,zv,1)
+      CALL gather_field_v(field_loc, field_glo, vsize)
+    ENDIF
+
+    !    WRITE(*,*)trim(modname)//' after gather '
+    CALL Gather_field_u(alpha_u, zu, 1)
+    CALL Gather_field_u(alpha_t, zt, 1)
+    CALL Gather_field_u(alpha_q, zq, 1)
+    CALL Gather_field_v(alpha_v, zv, 1)
 
     IF (mpi_rank >  0) THEN
-!$OMP MASTER
-       DEALLOCATE(field_glo)
-!$OMP END MASTER
-!$OMP BARRIER
-
-       RETURN
-    ENDIF
-    
-!$OMP MASTER
+      !$OMP MASTER
+      DEALLOCATE(field_glo)
+      !$OMP END MASTER
+      !$OMP BARRIER
+
+      RETURN
+    ENDIF
+
+    !$OMP MASTER
     IF (timestep==0) THEN
-! ----------------------------------------------
-! initialisation fichier de sortie
-! ----------------------------------------------
-! Ouverture du fichier
-        ierr=nf90_create("guide_ins.nc",IOR(nf90_clobber,nf90_64bit_offset),nid)
-! Definition des dimensions
-        ierr=nf90_def_dim(nid,"LONU",iip1,id_lonu)
-        ierr=nf90_def_dim(nid,"LONV",iip1,id_lonv)
-        ierr=nf90_def_dim(nid,"LATU",jjp1,id_latu)
-        ierr=nf90_def_dim(nid,"LATV",jjm,id_latv)
-        ierr=nf90_def_dim(nid,"LEVEL",llm,id_lev)
-        ierr=nf90_def_dim(nid,"TIME",nf90_unlimited,id_tim)
-
-! Creation des variables dimensions
-        ierr=nf90_def_var(nid,"LONU",nf90_float,id_lonu,vid_lonu)
-        ierr=nf90_def_var(nid,"LONV",nf90_float,id_lonv,vid_lonv)
-        ierr=nf90_def_var(nid,"LATU",nf90_float,id_latu,vid_latu)
-        ierr=nf90_def_var(nid,"LATV",nf90_float,id_latv,vid_latv)
-        ierr=nf90_def_var(nid,"LEVEL",nf90_float,id_lev,vid_lev)
-        ierr=nf90_def_var(nid,"cu",nf90_float,(/id_lonu,id_latu/),vid_cu)
-        ierr=nf90_def_var(nid,"cv",nf90_float,(/id_lonv,id_latv/),vid_cv)
-        ierr=nf90_def_var(nid,"au",nf90_float,(/id_lonu,id_latu/),vid_au)
-        ierr=nf90_def_var(nid,"av",nf90_float,(/id_lonv,id_latv/),vid_av)
-        CALL nf95_def_var(nid, "alpha_T", nf90_float, (/id_lonv, id_latu/), &
-             varid_alpha_t)
-        CALL nf95_def_var(nid, "alpha_q", nf90_float, (/id_lonv, id_latu/), &
-             varid_alpha_q)
-        
-        ierr=nf90_enddef(nid)
-
-! Enregistrement des variables dimensions
-        ierr = nf90_put_var(nid,vid_lonu,rlonu*180./pi)
-        ierr = nf90_put_var(nid,vid_lonv,rlonv*180./pi)
-        ierr = nf90_put_var(nid,vid_latu,rlatu*180./pi)
-        ierr = nf90_put_var(nid,vid_latv,rlatv*180./pi)
-        ierr = nf90_put_var(nid,vid_lev,presnivs)
-        ierr = nf90_put_var(nid,vid_cu,cu)
-        ierr = nf90_put_var(nid,vid_cv,cv)
-        ierr = nf90_put_var(nid,vid_au,zu)
-        ierr = nf90_put_var(nid,vid_av,zv)
-        CALL nf95_put_var(nid, varid_alpha_t, zt)
-        CALL nf95_put_var(nid, varid_alpha_q, zq)
-! --------------------------------------------------------------------
-! Création des variables sauvegardées
-! --------------------------------------------------------------------
-        ierr = nf90_redef(nid)
-! Pressure (GCM)
-        dim4=(/id_lonv,id_latu,id_lev,id_tim/)
-        ierr = nf90_def_var(nid,"SP",nf90_float,dim4,varid)
-! Surface pressure (guidage)
-        IF (guide_P) THEN
-            dim3=(/id_lonv,id_latu,id_tim/)
-            ierr = nf90_def_var(nid,"ps",nf90_float,dim3,varid)
-        ENDIF
-! Zonal wind
-        IF (guide_u) THEN
-            dim4=(/id_lonu,id_latu,id_lev,id_tim/)
-            ierr = nf90_def_var(nid,"u",nf90_float,dim4,varid)
-            ierr = nf90_def_var(nid,"ua",nf90_float,dim4,varid)
-            ierr = nf90_def_var(nid,"ucov",nf90_float,dim4,varid)
-        ENDIF
-! Merid. wind
-        IF (guide_v) THEN
-            dim4=(/id_lonv,id_latv,id_lev,id_tim/)
-            ierr = nf90_def_var(nid,"v",nf90_float,dim4,varid)
-            ierr = nf90_def_var(nid,"va",nf90_float,dim4,varid)
-            ierr = nf90_def_var(nid,"vcov",nf90_float,dim4,varid)
-        ENDIF
-! Pot. Temperature
-        IF (guide_T) THEN
-            dim4=(/id_lonv,id_latu,id_lev,id_tim/)
-            ierr = nf90_def_var(nid,"teta",nf90_float,dim4,varid)
-        ENDIF
-! Specific Humidity
-        IF (guide_Q) THEN
-            dim4=(/id_lonv,id_latu,id_lev,id_tim/)
-            ierr = nf90_def_var(nid,"q",nf90_float,dim4,varid)
-        ENDIF
-        
-        ierr = nf90_enddef(nid)
-        ierr = nf90_close(nid)
+      ! ----------------------------------------------
+      ! initialisation fichier de sortie
+      ! ----------------------------------------------
+      ! Ouverture du fichier
+      ierr = nf90_create("guide_ins.nc", IOR(nf90_clobber, nf90_64bit_offset), nid)
+      ! Definition des dimensions
+      ierr = nf90_def_dim(nid, "LONU", iip1, id_lonu)
+      ierr = nf90_def_dim(nid, "LONV", iip1, id_lonv)
+      ierr = nf90_def_dim(nid, "LATU", jjp1, id_latu)
+      ierr = nf90_def_dim(nid, "LATV", jjm, id_latv)
+      ierr = nf90_def_dim(nid, "LEVEL", llm, id_lev)
+      ierr = nf90_def_dim(nid, "TIME", nf90_unlimited, id_tim)
+
+      ! Creation des variables dimensions
+      ierr = nf90_def_var(nid, "LONU", nf90_float, id_lonu, vid_lonu)
+      ierr = nf90_def_var(nid, "LONV", nf90_float, id_lonv, vid_lonv)
+      ierr = nf90_def_var(nid, "LATU", nf90_float, id_latu, vid_latu)
+      ierr = nf90_def_var(nid, "LATV", nf90_float, id_latv, vid_latv)
+      ierr = nf90_def_var(nid, "LEVEL", nf90_float, id_lev, vid_lev)
+      ierr = nf90_def_var(nid, "cu", nf90_float, (/id_lonu, id_latu/), vid_cu)
+      ierr = nf90_def_var(nid, "cv", nf90_float, (/id_lonv, id_latv/), vid_cv)
+      ierr = nf90_def_var(nid, "au", nf90_float, (/id_lonu, id_latu/), vid_au)
+      ierr = nf90_def_var(nid, "av", nf90_float, (/id_lonv, id_latv/), vid_av)
+      CALL nf95_def_var(nid, "alpha_T", nf90_float, (/id_lonv, id_latu/), &
+              varid_alpha_t)
+      CALL nf95_def_var(nid, "alpha_q", nf90_float, (/id_lonv, id_latu/), &
+              varid_alpha_q)
+
+      ierr = nf90_enddef(nid)
+
+      ! Enregistrement des variables dimensions
+      ierr = nf90_put_var(nid, vid_lonu, rlonu * 180. / pi)
+      ierr = nf90_put_var(nid, vid_lonv, rlonv * 180. / pi)
+      ierr = nf90_put_var(nid, vid_latu, rlatu * 180. / pi)
+      ierr = nf90_put_var(nid, vid_latv, rlatv * 180. / pi)
+      ierr = nf90_put_var(nid, vid_lev, presnivs)
+      ierr = nf90_put_var(nid, vid_cu, cu)
+      ierr = nf90_put_var(nid, vid_cv, cv)
+      ierr = nf90_put_var(nid, vid_au, zu)
+      ierr = nf90_put_var(nid, vid_av, zv)
+      CALL nf95_put_var(nid, varid_alpha_t, zt)
+      CALL nf95_put_var(nid, varid_alpha_q, zq)
+      ! --------------------------------------------------------------------
+      ! Création des variables sauvegardées
+      ! --------------------------------------------------------------------
+      ierr = nf90_redef(nid)
+      ! Pressure (GCM)
+      dim4 = (/id_lonv, id_latu, id_lev, id_tim/)
+      ierr = nf90_def_var(nid, "SP", nf90_float, dim4, varid)
+      ! Surface pressure (guidage)
+      IF (guide_P) THEN
+        dim3 = (/id_lonv, id_latu, id_tim/)
+        ierr = nf90_def_var(nid, "ps", nf90_float, dim3, varid)
+      ENDIF
+      ! Zonal wind
+      IF (guide_u) THEN
+        dim4 = (/id_lonu, id_latu, id_lev, id_tim/)
+        ierr = nf90_def_var(nid, "u", nf90_float, dim4, varid)
+        ierr = nf90_def_var(nid, "ua", nf90_float, dim4, varid)
+        ierr = nf90_def_var(nid, "ucov", nf90_float, dim4, varid)
+      ENDIF
+      ! Merid. wind
+      IF (guide_v) THEN
+        dim4 = (/id_lonv, id_latv, id_lev, id_tim/)
+        ierr = nf90_def_var(nid, "v", nf90_float, dim4, varid)
+        ierr = nf90_def_var(nid, "va", nf90_float, dim4, varid)
+        ierr = nf90_def_var(nid, "vcov", nf90_float, dim4, varid)
+      ENDIF
+      ! Pot. Temperature
+      IF (guide_T) THEN
+        dim4 = (/id_lonv, id_latu, id_lev, id_tim/)
+        ierr = nf90_def_var(nid, "teta", nf90_float, dim4, varid)
+      ENDIF
+      ! Specific Humidity
+      IF (guide_Q) THEN
+        dim4 = (/id_lonv, id_latu, id_lev, id_tim/)
+        ierr = nf90_def_var(nid, "q", nf90_float, dim4, varid)
+      ENDIF
+
+      ierr = nf90_enddef(nid)
+      ierr = nf90_close(nid)
     ENDIF ! timestep=0
 
-! --------------------------------------------------------------------
-! Enregistrement du champ
-! --------------------------------------------------------------------
- 
-    ierr=nf90_open("guide_ins.nc",nf90_write,nid)
-
-    IF (varname=="SP") timestep=timestep+1
-
-    ierr = nf90_inq_varid(nid,varname,varid)
+    ! --------------------------------------------------------------------
+    ! Enregistrement du champ
+    ! --------------------------------------------------------------------
+
+    ierr = nf90_open("guide_ins.nc", nf90_write, nid)
+
+    IF (varname=="SP") timestep = timestep + 1
+
+    ierr = nf90_inq_varid(nid, varname, varid)
     SELECT CASE (varname)
-    CASE ("SP","ps")
-        start=(/1,1,1,timestep/)
-        count=(/iip1,jjp1,llm,1/)
-    CASE ("v","va","vcov")
-        start=(/1,1,1,timestep/)
-        count=(/iip1,jjm,llm,1/)
+    CASE ("SP", "ps")
+      start = (/1, 1, 1, timestep/)
+      count = (/iip1, jjp1, llm, 1/)
+    CASE ("v", "va", "vcov")
+      start = (/1, 1, 1, timestep/)
+      count = (/iip1, jjm, llm, 1/)
     CASE DEFAULT
-        start=(/1,1,1,timestep/)
-        count=(/iip1,jjp1,llm,1/)
+      start = (/1, 1, 1, timestep/)
+      count = (/iip1, jjp1, llm, 1/)
     END SELECT
 
-!$OMP END MASTER
-!$OMP BARRIER
+    !$OMP END MASTER
+    !$OMP BARRIER
 
     SELECT CASE (varname)
 
-    CASE("u","ua")
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        DO l=1,llm 
-            field_glo(:,2:jjm,l)=field_glo(:,2:jjm,l)/cu(:,2:jjm)
-            field_glo(:,1,l)=0. ; field_glo(:,jjp1,l)=0.
-        ENDDO
-    CASE("v","va")
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        DO l=1,llm
-           field_glo(:,:,l)=field_glo(:,:,l)/cv(:,:)
-        ENDDO
+    CASE("u", "ua")
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        field_glo(:, 2:jjm, l) = field_glo(:, 2:jjm, l) / cu(:, 2:jjm)
+        field_glo(:, 1, l) = 0. ; field_glo(:, jjp1, l) = 0.
+      ENDDO
+    CASE("v", "va")
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        field_glo(:, :, l) = field_glo(:, :, l) / cv(:, :)
+      ENDDO
     END SELECT
 
-!    if (varname=="ua") THEN
-!    CALL dump2d(iip1,jjp1,field_glo,'ua gui1 1ere couche ')
-!    CALL dump2d(iip1,jjp1,field_glo(:,:,llm),'ua gui1 llm ')
-!    endif
-
-!$OMP MASTER
-
-    ierr = nf90_put_var(nid,varid,field_glo,start,count)
+    !    if (varname=="ua") THEN
+    !    CALL dump2d(iip1,jjp1,field_glo,'ua gui1 1ere couche ')
+    !    CALL dump2d(iip1,jjp1,field_glo(:,:,llm),'ua gui1 llm ')
+    !    endif
+
+    !$OMP MASTER
+
+    ierr = nf90_put_var(nid, varid, field_glo, start, count)
     ierr = nf90_close(nid)
 
-       DEALLOCATE(field_glo)
-!$OMP END MASTER
-!$OMP BARRIER
+    DEALLOCATE(field_glo)
+    !$OMP END MASTER
+    !$OMP BARRIER
 
   END SUBROUTINE guide_out
-    
-  
-!===========================================================================
-  SUBROUTINE correctbid(iim,nl,x)
-    integer iim,nl
-    real x(iim+1,nl)
-    integer i,l
-    real zz
-
-    do l=1,nl
-        do i=2,iim-1
-            IF(abs(x(i,l))>1.e10) THEN
-               zz=0.5*(x(i-1,l)+x(i+1,l))
-              PRINT*,'correction ',i,l,x(i,l),zz
-               x(i,l)=zz
-            endif
-         enddo
-     enddo
+
+
+  !===========================================================================
+  SUBROUTINE correctbid(iim, nl, x)
+    INTEGER iim, nl
+    REAL x(iim + 1, nl)
+    INTEGER i, l
+    REAL zz
+
+    do l = 1, nl
+      do i = 2, iim - 1
+        IF(abs(x(i, l))>1.e10) THEN
+          zz = 0.5 * (x(i - 1, l) + x(i + 1, l))
+          PRINT*, 'correction ', i, l, x(i, l), zz
+          x(i, l) = zz
+        endif
+      enddo
+    enddo
 
   END SUBROUTINE  correctbid
 
 
-!====================================================================
-! Ascii debug output. Could be reactivated
-!====================================================================
-
-SUBROUTINE dump2du(var,varname)
-use parallel_lmdz
-use mod_hallo
-IMPLICIT NONE
-include 'dimensions.h'
-include 'paramet.h'
-
-      CHARACTER (len=*) :: varname
-
-
-real, dimension(ijb_u:ije_u) :: var
-
-real, dimension(ip1jmp1) :: var_glob
+  !====================================================================
+  ! Ascii debug output. Could be reactivated
+  !====================================================================
+
+  SUBROUTINE dump2du(var, varname)
+    USE parallel_lmdz
+    USE mod_hallo
+    IMPLICIT NONE
+    include 'dimensions.h'
+    include 'paramet.h'
+
+    CHARACTER (len = *) :: varname
+
+    REAL, DIMENSION(ijb_u:ije_u) :: var
+
+    REAL, DIMENSION(ip1jmp1) :: var_glob
 
     RETURN
 
     CALL barrier
-    CALL Gather_field_u(var,var_glob,1)
+    CALL Gather_field_u(var, var_glob, 1)
     CALL barrier
 
-    if (mpi_rank==0) THEN
-       CALL dump2d(iip1,jjp1,var_glob,varname)
+    IF (mpi_rank==0) THEN
+      CALL dump2d(iip1, jjp1, var_glob, varname)
     endif
 
     CALL barrier
 
-
-    END SUBROUTINE  dump2du
-
-!====================================================================
-! Ascii debug output. Could be reactivated
-!====================================================================
-SUBROUTINE dumpall
-     IMPLICIT NONE
-     include "dimensions.h"
-     include "paramet.h"
-     include "comgeom.h"
-     CALL barrier
-     CALL dump2du(alpha_u(ijb_u:ije_u),'  alpha_u couche 1')
-     CALL dump2du(unat2(:,jjbu:jjeu,nlevnc),'  unat2 couche nlevnc')
-     CALL dump2du(ugui1(ijb_u:ije_u,1)*sqrt(unscu2(ijb_u:ije_u)),'  ugui1 couche 1')
-
-END SUBROUTINE  dumpall
-
-!===========================================================================
+  END SUBROUTINE  dump2du
+
+  !====================================================================
+  ! Ascii debug output. Could be reactivated
+  !====================================================================
+  SUBROUTINE dumpall
+    IMPLICIT NONE
+    include "dimensions.h"
+    include "paramet.h"
+    include "comgeom.h"
+    CALL barrier
+    CALL dump2du(alpha_u(ijb_u:ije_u), '  alpha_u couche 1')
+    CALL dump2du(unat2(:, jjbu:jjeu, nlevnc), '  unat2 couche nlevnc')
+    CALL dump2du(ugui1(ijb_u:ije_u, 1) * sqrt(unscu2(ijb_u:ije_u)), '  ugui1 couche 1')
+
+  END SUBROUTINE  dumpall
+
+  !===========================================================================
 END MODULE guide_loc_mod
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/iniacademic_loc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/iniacademic_loc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/iniacademic_loc.F90	(revision 5117)
@@ -7,9 +7,9 @@
   USE infotrac,    ONLY: nqtot, niso, iqIsoPha, tracers, getKey, isoName
   USE control_mod, ONLY: day_step,planet_type
-  use exner_hyb_m, ONLY: exner_hyb
-  use exner_milieu_m, ONLY: exner_milieu
+  USE exner_hyb_m, ONLY: exner_hyb
+  USE exner_milieu_m, ONLY: exner_milieu
   USE parallel_lmdz, ONLY: ijb_u, ije_u, ijb_v, ije_v
   USE IOIPSL, ONLY: getin
-  USE Write_Field
+  USE lmdz_write_field
   USE comconst_mod, ONLY: cpp, kappa, g, daysec, dtvr, pi, im, jm
   USE logic_mod, ONLY: iflag_phys, read_start
@@ -17,6 +17,7 @@
   USE temps_mod, ONLY: annee_ref, day_ini, day_ref
   USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
-  USE readTracFiles_mod, ONLY: addPhase
-  use netcdf, ONLY: nf90_nowrite,nf90_open,nf90_noerr,nf90_inq_varid,nf90_close, nf90_get_var
+  USE lmdz_readTracFiles, ONLY: addPhase
+  USE netcdf, ONLY: nf90_nowrite,nf90_open,nf90_noerr,nf90_inq_varid,nf90_close, nf90_get_var
+  USE lmdz_ran1, ONLY: ran1
 
   !   Author:    Frederic Hourdin      original: 15/01/93
@@ -60,11 +61,10 @@
   REAL phi(ip1jmp1,llm)                  ! geopotentiel
   REAL ddsin,zsig,tetapv,w_pv  ! variables auxiliaires
-  real tetastrat ! potential temperature in the stratosphere, in K
-  real tetajl(jjp1,llm)
+  REAL tetastrat ! potential temperature in the stratosphere, in K
+  REAL tetajl(jjp1,llm)
   INTEGER i,j,l,lsup,ij, iq, iName, iPhase, iqParent
 
   INTEGER :: nid_relief,varid,ierr
-  real, dimension(iip1,jjp1) :: relief
-
+  REAL, DIMENSION(iip1,jjp1) :: relief
 
   REAL teta0,ttp,delt_y,delt_z,eps ! Constantes pour profil de T
@@ -74,6 +74,6 @@
   REAL phi_pv,dphi_pv,gam_pv,tetanoise   ! Constantes pour polar vortex 
 
-  real zz,ran1
-  integer idum
+  REAL zz
+  INTEGER idum
 
   REAL zdtvr, tnat, alpha_ideal
@@ -84,5 +84,5 @@
 
   ! Sanity check: verify that options selected by user are not incompatible
-  if ((iflag_phys==1).and. .not. read_start) THEN
+  IF ((iflag_phys==1).AND. .NOT. read_start) THEN
     WRITE(lunout,*) trim(modname)," error: if read_start is set to ", &
     " false then iflag_phys should not be 1"
@@ -90,5 +90,5 @@
     " (iflag_phys >= 100)"
     CALL abort_gcm(modname,"incompatible iflag_phys==1 and read_start==.FALSE.",1)
-  endif
+  ENDIF
   
   !-----------------------------------------------------------------------
@@ -114,8 +114,8 @@
   ang0       = 0.
 
-  if (llm == 1) THEN
+  IF (llm == 1) THEN
      ! specific initializations for the shallow water case
      kappa=1
-  endif
+  ENDIF
 
   CALL iniconst
@@ -148,7 +148,7 @@
      relief=0.
      ierr = nf90_open ('relief_in.nc', nf90_nowrite,nid_relief)
-     if (ierr==nf90_noerr) THEN
+     IF (ierr==nf90_noerr) THEN
          ierr=nf90_inq_varid(nid_relief,'RELIEF',varid)
-         if (ierr==nf90_noerr) THEN
+         IF (ierr==nf90_noerr) THEN
               ierr=nf90_get_var(nid_relief,varid,relief(1:iim,1:jjp1))
               relief(iip1,:)=relief(1,:)
@@ -173,5 +173,5 @@
 
      CALL pression ( ip1jmp1, ap, bp, ps_glo, p       )
-     if (pressure_exner) THEN
+     IF (pressure_exner) THEN
        CALL exner_hyb( ip1jmp1, ps_glo, p, pks, pk )
      else
@@ -181,12 +181,12 @@
   ENDIF
 
-  if (llm == 1) THEN
+  IF (llm == 1) THEN
      ! initialize fields for the shallow water case, if required
-     if (.not.read_start) THEN
+     IF (.NOT.read_start) THEN
         phis(ijb_u:ije_u)=0.
         q(ijb_u:ije_u,1:llm,1:nqtot)=0
         CALL sw_case_williamson91_6_loc(vcov,ucov,teta,masse,ps)
      endif
-  endif
+  ENDIF
 
   academic_case: if (iflag_phys >= 2) THEN
@@ -258,5 +258,5 @@
            tetajl(j,l)=teta0-delt_y*ddsin*ddsin+eps*ddsin &
                 -delt_z*(1.-ddsin*ddsin)*log(zsig)
-           if (planet_type=="giant") THEN
+           IF (planet_type=="giant") THEN
              tetajl(j,l)=teta0+(delt_y*                   &
                 ((sin(rlatu(j)*3.14159*eps+0.0001))**2)   &
@@ -295,5 +295,5 @@
 
         ! winds
-        if (ok_geost) THEN
+        IF (ok_geost) THEN
            CALL ugeostr(phi,ucov_glo)
         else
@@ -303,5 +303,5 @@
 
         ! bulk initialization of tracers
-        if (planet_type=="earth") THEN
+        IF (planet_type=="earth") THEN
            ! Earth: first two tracers will be water
            do iq=1,nqtot
@@ -313,9 +313,9 @@
               ! distill de Rayleigh très simplifiée
               iName    = tracers(iq)%iso_iName
-              if (niso <= 0 .OR. iName <= 0) CYCLE
+              IF (niso <= 0 .OR. iName <= 0) CYCLE
               iPhase   = tracers(iq)%iso_iPhase
               iqParent = tracers(iq)%iqParent
               IF(tracers(iq)%iso_iZone == 0) THEN
-                 if (tnat1) THEN
+                 IF (tnat1) THEN
                          tnat=1.0
                          alpha_ideal=1.0
@@ -374,5 +374,5 @@
         deallocate(phis_glo)
      ENDIF ! of IF (.NOT. read_start)
-  endif academic_case
+  ENDIF academic_case
 
 END SUBROUTINE iniacademic_loc
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initdynav_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initdynav_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initdynav_loc.f90	(revision 5117)
@@ -7,8 +7,8 @@
    USE IOIPSL
    USE parallel_lmdz
-   use Write_field
-   use misc_mod
+   USE lmdz_write_field
+   USE misc_mod
     ! USE infotrac
-   use com_io_dyn_mod, ONLY: histaveid,histvaveid,histuaveid,       &
+   USE com_io_dyn_mod, ONLY: histaveid,histvaveid,histuaveid,       &
          dynhistave_file,dynhistvave_file,dynhistuave_file
    USE comconst_mod, ONLY: pi
@@ -51,5 +51,5 @@
   !   Arguments
   !
-  integer(kind=4) day0, anne0
+  INTEGER(kind=4) day0, anne0
   REAL :: tstep, t_ops, t_wrt
 
@@ -81,5 +81,5 @@
   INTEGER :: dynhistuave_domain_id
 
-  if (adjust) return
+  IF (adjust) return
 
   !
@@ -219,5 +219,5 @@
   !  Vents V
   !
-  if (pole_sud) jjn=jj_nb-1
+  IF (pole_sud) jjn=jj_nb-1
   CALL histdef(histvaveid, 'v', 'vent v moyen', &
         'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv, &
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initfluxsto_p.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initfluxsto_p.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initfluxsto_p.f90	(revision 5117)
@@ -4,6 +4,6 @@
   USE IOIPSL
   USE parallel_lmdz
-  use Write_field
-  use misc_mod
+  USE lmdz_write_field
+  USE misc_mod
   USE comconst_mod, ONLY: pi
   USE comvert_mod, ONLY: nivsigs
@@ -64,5 +64,5 @@
   INTEGER :: ii, jj
   INTEGER :: zan, idayref
-  logical :: ok_sync
+  LOGICAL :: ok_sync
   INTEGER :: jjb, jje, jjn
 
@@ -136,6 +136,6 @@
   jje = jj_end
   jjn = jj_nb
-  if (pole_sud) jje = jj_end - 1
-  if (pole_sud) jjn = jj_nb - 1
+  IF (pole_sud) jje = jj_end - 1
+  IF (pole_sud) jjn = jj_nb - 1
 
   ddid = (/ 1, 2 /)
@@ -156,10 +156,10 @@
   rl(1, 1) = 1.
 
-  if (mpi_rank==0) THEN
+  IF (mpi_rank==0) THEN
     CALL histbeg('defstoke.nc', 1, rl, 1, rl, &
             1, 1, 1, 1, &
             tau0, zjulian, tstep, dhoriid, filedid)
 
-  endif
+  ENDIF
   !
   !  Appel a histhori pour rajouter les autres grilles horizontales
@@ -190,10 +190,10 @@
           llm, nivsigs, zvertiid)
   ! pour le fichier def
-  if (mpi_rank==0) THEN
+  IF (mpi_rank==0) THEN
     nivd(1) = 1
     CALL histvert(filedid, 'sig_s', 'Niveaux sigma', &
             'sigma_level', &
             1, nivd, dvertiid)
-  endif
+  ENDIF
   !
   !  Appels a histdef pour la definition des variables a sauvegarder
@@ -207,5 +207,5 @@
           "once", t_ops, t_wrt)
 
-  if (mpi_rank==0) THEN
+  IF (mpi_rank==0) THEN
     CALL histdef(filedid, "dtvr", "tps dyn", "s", &
             1, 1, dhoriid, 1, 1, 1, -99, 32, &
@@ -220,5 +220,5 @@
             "once", t_ops, t_wrt)
 
-  endif
+  ENDIF
   !
   ! Masse
@@ -237,5 +237,5 @@
   !  Pbarv
   !
-  if (pole_sud) jjn = jj_nb - 1
+  IF (pole_sud) jjn = jj_nb - 1
 
   CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', &
@@ -245,5 +245,5 @@
   !  w
   !
-  if (pole_sud) jjn = jj_nb
+  IF (pole_sud) jjn = jj_nb
   CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', &
           iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
@@ -269,10 +269,10 @@
   CALL histend(fileid)
   CALL histend(filevid)
-  if (mpi_rank==0) CALL histend(filedid)
-  if (ok_sync) THEN
+  IF (mpi_rank==0) CALL histend(filedid)
+  IF (ok_sync) THEN
     CALL histsync(fileid)
     CALL histsync(filevid)
-    if (mpi_rank==0) CALL histsync(filedid)
-  endif
+    IF (mpi_rank==0) CALL histsync(filedid)
+  ENDIF
 
 END SUBROUTINE initfluxsto_p
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/inithist_loc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/inithist_loc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/inithist_loc.F90	(revision 5117)
@@ -6,5 +6,5 @@
   USE IOIPSL
   USE parallel_lmdz
-  USE Write_field
+  USE lmdz_write_field
   USE misc_mod
   USE com_io_dyn_mod, ONLY: histid, histvid, histuid, &
@@ -78,5 +78,5 @@
   INTEGER :: dynhistu_domain_id
 
-  if (adjust) return
+  IF (adjust) return
 
   !
@@ -215,5 +215,5 @@
   !  Vents V
   !
-  if (pole_sud) jjn = jj_nb - 1
+  IF (pole_sud) jjn = jj_nb - 1
   CALL histdef(histvid, 'v', 'vent v', &
           'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv, &
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/integrd_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/integrd_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/integrd_loc.f90	(revision 5117)
@@ -9,5 +9,5 @@
   USE lmdz_filtreg_p
   USE write_field_loc
-  USE write_field
+  USE lmdz_write_field
   USE integrd_mod
   USE comconst_mod, ONLY: pi
@@ -15,5 +15,5 @@
   USE comvert_mod, ONLY: ap, bp
   USE temps_mod, ONLY: dt
-  USE strings_mod, ONLY: int2str
+  USE lmdz_strings, ONLY: int2str
 
   IMPLICIT NONE
@@ -43,5 +43,5 @@
   !   ----------
 
-  INTEGER,intent(in) :: nq ! number of tracers to handle in this routine
+  INTEGER,INTENT(IN) :: nq ! number of tracers to handle in this routine
 
   REAL,INTENT(INOUT) :: vcov(ijb_v:ije_v,llm) ! covariant meridional wind
@@ -90,5 +90,5 @@
 
 !$OMP BARRIER
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO  l = 1,llm
@@ -101,5 +101,5 @@
   ENDIF
 
-  if (pole_sud) THEN
+  IF (pole_sud) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO  l = 1,llm
@@ -195,5 +195,5 @@
   !   !WRITE(*,*) 'integrd 200'
 !$OMP MASTER
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
 
     DO  ij    = 1, iim
@@ -207,5 +207,5 @@
   ENDIF
 
-  if (pole_sud) THEN
+  IF (pole_sud) THEN
 
     DO  ij    = 1, iim
@@ -255,6 +255,6 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij = ijb,ije
@@ -265,5 +265,5 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij = ijb,ije
@@ -320,5 +320,5 @@
     ucovm1(ijb:ije,l)=uscr(ijb:ije)
     tetam1(ijb:ije,l)=hscr(ijb:ije)
-    if (pole_sud) ije=ij_end-iip1
+    IF (pole_sud) ije=ij_end-iip1
     vcovm1(ijb:ije,l)=vscr(ijb:ije)
 
@@ -334,5 +334,5 @@
   ije=ij_end
 
-     if (planet_type=="earth") THEN
+     IF (planet_type=="earth") THEN
   ! Earth-specific treatment of first 2 tracers (water)
 !$OMP BARRIER
@@ -415,5 +415,5 @@
   !c$OMP END DO NOWAIT
 
-  endif ! of if (planet_type.eq."earth")
+  ENDIF ! of if (planet_type.EQ."earth")
 
   !
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_gam_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_gam_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_gam_loc.f90	(revision 5117)
@@ -45,6 +45,6 @@
   ijb=ij_begin-iip1
   ije=ij_end+iip1
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud ) ije=ij_end
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud ) ije=ij_end
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_loc.f90	(revision 5117)
@@ -36,6 +36,6 @@
   ijb=ij_begin-iip1
   ije=ij_end+iip1
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud ) ije=ij_end
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud ) ije=ij_end
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -47,6 +47,6 @@
   jjb=jj_begin-1
   jje=jj_end+1
-  if (pole_nord) jjb=jj_begin
-  if (pole_sud ) jje=jj_end
+  IF (pole_nord) jjb=jj_begin
+  IF (pole_sud ) jje=jj_end
 
   CALL filtreg_p( divgra,jjb_u,jje_u,jjb,jje,jjp1, &
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_rot_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_rot_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_rot_loc.f90	(revision 5117)
@@ -35,6 +35,6 @@
   jje=jj_end+1
 
-  if (pole_nord) jjb=jj_begin
-  if (pole_sud) jje=jj_end-1
+  IF (pole_nord) jjb=jj_begin
+  IF (pole_sud) jje=jj_end-1
 
   CALL  filtreg_p ( rotin ,jjb_v,jje_v,jjb,jje,jjm, &
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/leapfrog_loc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/leapfrog_loc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/leapfrog_loc.F90	(revision 5117)
@@ -9,7 +9,7 @@
   USE mod_hallo
   USE Bands
-  USE strings_mod, ONLY: int2str
+  USE lmdz_strings, ONLY: int2str
   USE Write_Field_p
-  USE vampir
+  USE lmdz_vampir
   USE lmdz_timer_filtre, ONLY: print_filtre_timer
   USE infotrac
@@ -27,6 +27,6 @@
           , leapfrog_allocate, leapfrog_switch_caldyn, leapfrog_switch_dissip
 
-  use exner_hyb_loc_m, ONLY: exner_hyb_loc
-  use exner_milieu_loc_m, ONLY: exner_milieu_loc
+  USE exner_hyb_loc_m, ONLY: exner_hyb_loc
+  USE exner_milieu_loc_m, ONLY: exner_milieu_loc
   USE comconst_mod, ONLY: cpp, dtvr, ihf
   USE comvert_mod, ONLY: ap, bp, pressure_exner
@@ -150,5 +150,5 @@
   REAL :: secondes
 
-  logical :: physic
+  LOGICAL :: physic
   LOGICAL :: first, callinigrads
 
@@ -213,9 +213,9 @@
   lafin = .FALSE.
 
-  if (nday>=0) THEN
+  IF (nday>=0) THEN
     itaufin = nday * day_step
   else
     itaufin = -nday
-  endif
+  ENDIF
 
   itaufinp1 = itaufin + 1
@@ -225,5 +225,5 @@
   itau = 0
   physic = .TRUE.
-  if (iflag_phys==0.or.iflag_phys==2) physic = .FALSE.
+  IF (iflag_phys==0.OR.iflag_phys==2) physic = .FALSE.
   CALL init_nan
   CALL leapfrog_allocate
@@ -247,5 +247,5 @@
   ! Allocate variables depending on dynamic variable nqtot
   !$OMP MASTER
-  if (firstcall) THEN
+  IF (firstcall) THEN
     ! ALLOCATE(p(ijb_u:ije_u,llmp1))
     !      ALLOCATE(pks(ijb_u:ije_u))
@@ -274,5 +274,5 @@
     ! ALLOCATE(vcont(ijb_v:ije_v,llm),ucont(ijb_u:ije_u,llm))
     ! ALLOCATE(vnat(ijb_v:ije_v,llm),unat(ijb_u:ije_u,llm))
-  endif
+  ENDIF
   !$OMP END MASTER
   !$OMP BARRIER
@@ -290,9 +290,9 @@
   CALL pression (ijnb_u, ap, bp, ps, p)
   !$OMP END MASTER
-  if (pressure_exner) THEN
+  IF (pressure_exner) THEN
     CALL exner_hyb_loc(ijnb_u, ps, p, pks, pk, pkf)
   else
     CALL exner_milieu_loc(ijnb_u, ps, p, pks, pk, pkf)
-  endif
+  ENDIF
   !-----------------------------------------------------------------------
   !   Debut de l'integration temporelle:
@@ -309,15 +309,15 @@
   jH_cur = jH_ref + start_time + &
           mod(itau + 1, day_step) / float(day_step)
-  if (jH_cur > 1.0) THEN
+  IF (jH_cur > 1.0) THEN
     jD_cur = jD_cur + 1.
     jH_cur = jH_cur - 1.
-  endif
+  ENDIF
 
   CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 321')
 
-  if (ok_guide) THEN
+  IF (ok_guide) THEN
     CALL guide_main(itau,ucov,vcov,teta,q,masse,ps)
 !$OMP BARRIER
-  endif
+  ENDIF
 
 
@@ -334,5 +334,5 @@
   !ym      CALL SCOPY( ip1jmp1, ps  , 1,   psm1 , 1 )
 
-  if (FirstCaldyn) THEN
+  IF (FirstCaldyn) THEN
     !$OMP MASTER
     ucovm1 = ucov
@@ -365,5 +365,5 @@
       ! finvmaold(ijb:ije,l)=masse(ijb:ije,l)
 
-      if (pole_sud) ije = ij_end - iip1
+      IF (pole_sud) ije = ij_end - iip1
       vcovm1(ijb:ije, l) = vcov  (ijb:ije, l)
 
@@ -376,5 +376,5 @@
     ! .                    llm, -2,2, .TRUE., 1 )
 
-  endif ! of if (FirstCaldyn)
+  ENDIF ! of if (FirstCaldyn)
 
   forward = .TRUE.
@@ -398,9 +398,9 @@
   !$OMP MASTER
   ItCount = ItCount + 1
-  if (MOD(ItCount, 1)==1) THEN
+  IF (MOD(ItCount, 1)==1) THEN
     debug = .TRUE.
   else
     debug = .FALSE.
-  endif
+  ENDIF
   !$OMP END MASTER
   !-----------------------------------------------------------------------
@@ -414,5 +414,5 @@
     jH_cur = jH_ref + start_time + &
             mod(itau + 1, day_step) / float(day_step)
-    if (jH_cur > 1.0) THEN
+    IF (jH_cur > 1.0) THEN
       jD_cur = jD_cur + 1.
       jH_cur = jH_cur - 1.
@@ -436,5 +436,5 @@
             apdiss = .TRUE.
     IF(MOD(itau, iphysiq)==0.AND..NOT.forward &
-            .and. physic) apphys = .TRUE.
+            .AND. physic) apphys = .TRUE.
   ELSE
     ! Leapfrog/Matsuno time stepping
@@ -447,7 +447,7 @@
   ! Ehouarn: for Shallow Water case (ie: 1 vertical layer),
   ! supress dissipation step
-  if (llm==1) THEN
+  IF (llm==1) THEN
     apdiss = .FALSE.
-  endif
+  ENDIF
 
   !ym    ---> Pour le moment
@@ -456,5 +456,5 @@
   ! conser = .FALSE. ! ie: no output of control variables to stdout in //
 
-  if (firstCaldyn) THEN
+  IF (firstCaldyn) THEN
     !$OMP MASTER
     CALL Set_Distrib(distrib_caldyn)
@@ -466,5 +466,5 @@
     CALL Init_timer
     !$OMP END MASTER
-  endif
+  ENDIF
 
   !$OMP MASTER
@@ -478,14 +478,14 @@
 
   !ym  PAS D'AJUSTEMENT POUR LE MOMENT
-  if (Adjust) THEN
+  IF (Adjust) THEN
     AdjustCount = AdjustCount + 1
-    ! if (iapptrac==iapp_tracvl .and. (forward .OR.  leapf)
-    ! &         .and. itau/iphysiq>2 .and. Adjustcount>30) THEN
-    if (Adjustcount>1) THEN
+    ! if (iapptrac==iapp_tracvl .AND. (forward .OR.  leapf)
+    ! &         .AND. itau/iphysiq>2 .AND. Adjustcount>30) THEN
+    IF (Adjustcount>1) THEN
       AdjustCount = 0
       !$OMP MASTER
       CALL allgather_timer_average
 
-      if (prt_level > 9) THEN
+      IF (prt_level > 9) THEN
         print *, '*********************************'
         print *, '******    TIMER CALDYN     ******'
@@ -586,9 +586,9 @@
 
       !$OMP MASTER
-      if (mpi_rank==0) CALL WriteBands
+      IF (mpi_rank==0) CALL WriteBands
       !$OMP END MASTER
 
     endif
-  endif
+  ENDIF
 
   CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 589')
@@ -625,5 +625,5 @@
   !$OMP BARRIER
 
-  if (debug) THEN
+  IF (debug) THEN
     CALL WriteField_u('ucov', ucov)
     CALL WriteField_v('vcov', vcov)
@@ -639,5 +639,5 @@
               q(:, :, iq))
     enddo
-  endif
+  ENDIF
 
   True_itau = True_itau + 1
@@ -670,5 +670,5 @@
 
   !$OMP MASTER
-  if (mpi_rank==0.AND.conser) THEN
+  IF (mpi_rank==0.AND.conser) THEN
     WRITE(lunout, *) 'leapfrog_loc, Time step: ', itau, ' Day:', time
   ENDIF
@@ -728,5 +728,5 @@
   !$OMP END MASTER
   IF (CPPKEY_DEBUGIO) THEN
-    if (true_itau>20) THEN
+    IF (true_itau>20) THEN
       CALL WriteField_u('ucovm1', ucovm1)
       CALL WriteField_v('vcovm1', vcovm1)
@@ -802,5 +802,5 @@
     ! c-jld
     !$OMP MASTER
-    if (FirstPhysic) THEN
+    IF (FirstPhysic) THEN
       ok_start_timer = .TRUE.
       FirstPhysic = .FALSE.
@@ -814,5 +814,5 @@
   IF(iflag_phys==2) THEN ! "Newtonian" case
     !$OMP MASTER
-    if (FirstPhysic) THEN
+    IF (FirstPhysic) THEN
       ok_start_timer = .TRUE.
       FirstPhysic = .FALSE.
@@ -838,5 +838,5 @@
 
     !$OMP MASTER
-    if (planet_type=="giant") THEN
+    IF (planet_type=="giant") THEN
       ! add an intrinsic heat flux at the base of the atmosphere
       teta(ijb:ije, 1) = teta(ijb:ije, 1) &
@@ -864,9 +864,9 @@
   CALL pression_loc (ip1jmp1, ap, bp, ps, p)
   !$OMP BARRIER
-  if (pressure_exner) THEN
+  IF (pressure_exner) THEN
     CALL exner_hyb_loc(ijnb_u, ps, p, pks, pk, pkf)
   else
     CALL exner_milieu_loc(ijnb_u, ps, p, pks, pk, pkf)
-  endif
+  ENDIF
   !$OMP BARRIER
   CALL massdair_loc(p, masse)
@@ -897,5 +897,5 @@
     CALL allgather_timer_average
     CALL barrier
-    if (mpi_rank==0) THEN
+    IF (mpi_rank==0) THEN
       print *, '*********************************'
       print *, '******    TIMER CALDYN     ******'
@@ -944,5 +944,5 @@
     !$OMP END MASTER
 
-    if (ok_guide) THEN
+    IF (ok_guide) THEN
       ! set ok_guide to false to avoid extra output
       ! in following forward step
@@ -960,5 +960,5 @@
       ENDIF
 #ifdef REPROBUS
-     if (type_trac == 'repr') CALL finalize_reprobus
+     IF (type_trac == 'repr') CALL finalize_reprobus
 #endif
 
@@ -988,5 +988,5 @@
 
     IF(itau == itaufinp1) THEN
-      if (flag_verif) THEN
+      IF (flag_verif) THEN
         WRITE(79, *) 'ucov', ucov
         WRITE(80, *) 'vcov', vcov
@@ -1013,5 +1013,5 @@
         ENDIF
 #ifdef REPROBUS
-          if (type_trac == 'repr') CALL finalize_reprobus
+          IF (type_trac == 'repr') CALL finalize_reprobus
 #endif
 
@@ -1064,5 +1064,5 @@
     IF(MOD(itau, iecri)==0) THEN
       ! Ehouarn: output only during LF or Backward Matsuno
-      if (leapf.or.(.not.leapf.and.(.not.forward))) THEN
+      IF (leapf.OR.(.NOT.leapf.AND.(.NOT.forward))) THEN
         !$OMP BARRIER
         !$OMP MASTER
@@ -1071,5 +1071,5 @@
         !$OMP BARRIER
 
-         if (ok_dyn_ins) THEN
+         IF (ok_dyn_ins) THEN
              CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q, &
                    masse,ps,phis)
@@ -1085,5 +1085,5 @@
         ENDIF
 
-      endif                 ! of if (leapf.or.(.not.leapf.and.(.not.forward)))
+      endif                 ! of if (leapf.OR.(.NOT.leapf.AND.(.NOT.forward)))
 
     ENDIF ! of IF(MOD(itau,iecri).EQ.0)
@@ -1093,10 +1093,10 @@
       !$OMP BARRIER
 
-      ! if (planet_type.eq."earth") THEN
+      ! if (planet_type.EQ."earth") THEN
       ! Write an Earth-format restart file
       CALL dynredem1_loc("restart.nc", 0.0, &
               vcov, ucov, teta, q, masse, ps)
-      ! endif ! of if (planet_type.eq."earth")
-      if (ok_guide) THEN
+      ! END IF ! of if (planet_type.EQ."earth")
+      IF (ok_guide) THEN
         ! set ok_guide to false to avoid extra output
         ! in following forward step
@@ -1141,5 +1141,5 @@
     !    ELSEIF (MOD(itau-1,iperiod).EQ.0)
 
-  ELSE ! of IF (.not.purmats)
+  ELSE ! of IF (.NOT.purmats)
 
     CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1664')
@@ -1175,5 +1175,5 @@
           ENDIF
 #ifdef REPROBUS
-             if (type_trac == 'repr') CALL finalize_reprobus
+             IF (type_trac == 'repr') CALL finalize_reprobus
 #endif
 
@@ -1226,5 +1226,5 @@
 
 
-          if (ok_dyn_ins) THEN
+          IF (ok_dyn_ins) THEN
              CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q, &
                    masse,ps,phis)
@@ -1243,9 +1243,9 @@
 
       IF(itau==itaufin) THEN
-        ! if (planet_type.eq."earth") THEN
+        ! if (planet_type.EQ."earth") THEN
         CALL dynredem1_loc("restart.nc", 0.0, &
                 vcov, ucov, teta, q, masse, ps)
-        ! endif ! of if (planet_type.eq."earth")
-        if (ok_guide) THEN
+        ! END IF ! of if (planet_type.EQ."earth")
+        IF (ok_guide) THEN
           ! set ok_guide to false to avoid extra output
           ! in following forward step
@@ -1262,5 +1262,5 @@
     CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1750')
 
-  END IF ! of IF(.not.purmats)
+  END IF ! of IF(.NOT.purmats)
   !$OMP MASTER
   CALL fin_getparam
@@ -1277,5 +1277,5 @@
     ENDIF
 #ifdef REPROBUS
-  if (type_trac == 'repr') CALL finalize_reprobus
+  IF (type_trac == 'repr') CALL finalize_reprobus
 #endif
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/lmdz_call_calfis.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/lmdz_call_calfis.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/lmdz_call_calfis.F90	(revision 5117)
@@ -71,15 +71,15 @@
           phis_dyn, q_dyn, flxw_dyn)
     USE dimensions_mod
-    use exner_hyb_loc_m, ONLY: exner_hyb_loc
-    use exner_milieu_loc_m, ONLY: exner_milieu_loc
+    USE exner_hyb_loc_m, ONLY: exner_hyb_loc
+    USE exner_milieu_loc_m, ONLY: exner_milieu_loc
     USE parallel_lmdz
     USE times
     USE mod_hallo
     USE Bands
-    USE vampir
+    USE lmdz_vampir
     USE infotrac, ONLY: nqtot
     USE control_mod
     USE write_field_loc
-    USE strings_mod, ONLY: int2str
+    USE lmdz_strings, ONLY: int2str
     USE comconst_mod, ONLY: dtphys
     USE logic_mod, ONLY: leapf, forward, ok_strato
@@ -144,5 +144,5 @@
     jH_cur = jH_ref + start_time + &
             mod(itau + 1, day_step) / float(day_step)
-    if (jH_cur > 1.0) THEN
+    IF (jH_cur > 1.0) THEN
       jD_cur = jD_cur + 1.
       jH_cur = jH_cur - 1.
@@ -231,5 +231,5 @@
     ijb = ij_begin
     ije = ij_end
-    IF (.not. pole_nord) THEN
+    IF (.NOT. pole_nord) THEN
 
       !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -246,5 +246,5 @@
       !$OMP END MASTER
 
-    ENDIF ! of if ( .not. pole_nord)
+    ENDIF ! of if ( .NOT. pole_nord)
 
     !$OMP BARRIER
@@ -275,5 +275,5 @@
     !$OMP BARRIER
     ijb = ij_begin
-    IF (.not. pole_nord) THEN
+    IF (.NOT. pole_nord) THEN
 
       !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -290,5 +290,5 @@
       !$OMP END MASTER
 
-    endif ! of if (.not. pole_nord)
+    endif ! of if (.NOT. pole_nord)
 
     IF (CPPKEY_DEBUGIO) THEN
@@ -334,5 +334,5 @@
     CALL massdair_loc(p, masse)
     !$OMP BARRIER
-    if (pressure_exner) THEN
+    IF (pressure_exner) THEN
       CALL exner_hyb_loc(ijnb_u, ps, p, pks, pk, pkf)
     else
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/lmdz_filtreg_p.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/lmdz_filtreg_p.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/lmdz_filtreg_p.F90	(revision 5117)
@@ -102,5 +102,5 @@
     !-------------------------------------------------------c
 
-    IF(ifiltre==1.or.ifiltre==-1) &
+    IF(ifiltre==1.OR.ifiltre==-1) &
             CALL abort_gcm("lmdz_filtreg_p", 'Pas de transformee&
                     &simple dans cette version', 1)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/massdair_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/massdair_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/massdair_loc.f90	(revision 5117)
@@ -88,6 +88,6 @@
   ije=ij_end+2*iip1
 
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_const_mpi.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_const_mpi.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_const_mpi.F90	(revision 5117)
@@ -18,5 +18,5 @@
     USE mod_prism
 #endif
-    USE wxios, ONLY: wxios_init, using_xios
+    USE lmdz_wxios, ONLY: wxios_init, using_xios
     IMPLICIT NONE
 
@@ -56,5 +56,5 @@
   SUBROUTINE Init_mpi
     USE lmdz_mpi
-    USE wxios, ONLY: wxios_init, using_xios
+    USE lmdz_wxios, ONLY: wxios_init, using_xios
 
   IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_hallo.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_hallo.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_hallo.F90	(revision 5117)
@@ -3,21 +3,21 @@
 IMPLICIT NONE
   logical,save :: use_mpi_alloc
-  integer, parameter :: MaxProc=512
-  integer, parameter :: DefaultMaxBufferSize=1024*1024*100
-  integer, SAVE :: MaxBufferSize=0
-  integer, parameter :: ListSize=1000
-  
-  integer,save       :: MaxBufferSize_Used
+  INTEGER, parameter :: MaxProc=512
+  INTEGER, parameter :: DefaultMaxBufferSize=1024*1024*100
+  INTEGER, SAVE :: MaxBufferSize=0
+  INTEGER, parameter :: ListSize=1000
+  
+  INTEGER,save       :: MaxBufferSize_Used
 !$OMP THREADPRIVATE( MaxBufferSize_Used)
 
-   real,save,pointer,dimension(:) :: Buffer
+   REAL,SAVE,pointer,DIMENSION(:) :: Buffer
 !$OMP THREADPRIVATE(Buffer)
 
-   integer,save,dimension(Listsize) :: Buffer_Pos
-   integer,save :: Index_Pos
+   INTEGER,SAVE,DIMENSION(Listsize) :: Buffer_Pos
+   INTEGER,save :: Index_Pos
 !$OMP THREADPRIVATE(Buffer_Pos,Index_pos)
    
   type Hallo
-    real, dimension(:,:),pointer :: Field
+    REAL, DIMENSION(:,:),pointer :: Field
     INTEGER :: offset
     INTEGER :: size
@@ -37,6 +37,6 @@
 
   type request
-    type(request_SR),dimension(0:MaxProc-1) :: RequestSend
-    type(request_SR),dimension(0:MaxProc-1) :: RequestRecv
+    type(request_SR),DIMENSION(0:MaxProc-1) :: RequestSend
+    type(request_SR),DIMENSION(0:MaxProc-1) :: RequestRecv
     INTEGER :: tag=1
   end type request
@@ -143,11 +143,11 @@
     INTEGER :: Pos
 
-    if (Buffer_pos(Index_pos)+Size>MaxBufferSize_Used) MaxBufferSize_Used=Buffer_pos(Index_pos)+Size  
-    if (Buffer_pos(Index_pos)+Size>MaxBufferSize) THEN
+    IF (Buffer_pos(Index_pos)+Size>MaxBufferSize_Used) MaxBufferSize_Used=Buffer_pos(Index_pos)+Size
+    IF (Buffer_pos(Index_pos)+Size>MaxBufferSize) THEN
       print *,'STOP :: La taille de MaxBufferSize dans mod_hallo.F90 est trop petite !!!!'
       CALL abort_gcm("mod_hallo","stopped",1)
     endif
     
-    if (Index_pos>=ListSize) THEN
+    IF (Index_pos>=ListSize) THEN
       print *,'STOP :: La taille de ListSize dans mod_hallo.F90 est trop petite !!!!'
       CALL abort_gcm("mod_hallo","stopped",1)
@@ -167,5 +167,5 @@
     Buffer_Pos(Index)=-1
     
-    do while (Buffer_Pos(Index_Pos)==-1 .and. Index_Pos>1)
+    do while (Buffer_Pos(Index_Pos)==-1 .AND. Index_Pos>1)
       Index_Pos=Index_Pos-1
     END DO
@@ -187,5 +187,5 @@
     INTEGER :: size
     INTEGER :: offset
-    real, dimension(Stride,NbLevel),target :: Field
+    REAL, DIMENSION(Stride,NbLevel),target :: Field
     type(request_SR),pointer :: Ptr_request
     type(Hallo),POINTER :: NewHallos(:),HalloSwitch(:), NewHallo
@@ -220,5 +220,5 @@
     
       INTEGER :: ij,ll,offset,size,target
-      REAL, dimension(ij,ll) :: Field
+      REAL, DIMENSION(ij,ll) :: Field
       type(request),target :: a_request
       type(request_SR),pointer :: Ptr_request
@@ -236,5 +236,5 @@
    
       INTEGER :: ij,ll,offset,size,target
-      REAL, dimension(ij,ll) :: Field
+      REAL, DIMENSION(ij,ll) :: Field
       type(request),target :: a_request
       type(request_SR),pointer :: Ptr_request
@@ -253,9 +253,9 @@
     
     INTEGER :: ij,ll
-    REAL, dimension(ij,ll) :: FieldS
-    REAL, dimension(ij,ll) :: FieldR
+    REAL, DIMENSION(ij,ll) :: FieldS
+    REAL, DIMENSION(ij,ll) :: FieldR
     type(request) :: a_request
-    integer,dimension(0:MPI_Size-1) :: jj_Nb_New   
-    integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
+    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
+    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
     
     INTEGER ::i,jje,jjb
@@ -269,11 +269,11 @@
     
     do i=0,MPI_Size-1
-      if (i /= MPI_Rank) THEN
+      IF (i /= MPI_Rank) THEN
         jjb=max(jj_begin_new(i),jj_begin)
         jje=min(jj_end_new(i),jj_end)
         
-        if (ij==ip1jm .and. jje==jjp1) jje=jjm
-        
-        if (jje >= jjb) THEN
+        IF (ij==ip1jm .AND. jje==jjp1) jje=jjm
+        
+        IF (jje >= jjb) THEN
           CALL Register_SendField(FieldS,ij,ll,jjb,jje-jjb+1,i,a_request)
         endif
@@ -282,7 +282,7 @@
         jje=min(jj_end_new(MPI_Rank),jj_end_Para(i))
         
-        if (ij==ip1jm .and. jje==jjp1) jje=jjm
-        
-        if (jje >= jjb) THEN
+        IF (ij==ip1jm .AND. jje==jjp1) jje=jjm
+        
+        IF (jje >= jjb) THEN
           CALL Register_RecvField(FieldR,ij,ll,jjb,jje-jjb+1,i,a_request)
         endif
@@ -301,9 +301,9 @@
     
     INTEGER :: ij,ll,Up,Down
-    REAL, dimension(ij,ll) :: FieldS
-    REAL, dimension(ij,ll) :: FieldR
+    REAL, DIMENSION(ij,ll) :: FieldS
+    REAL, DIMENSION(ij,ll) :: FieldR
     type(request) :: a_request
-    integer,dimension(0:MPI_Size-1) :: jj_Nb_New   
-    integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
+    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
+    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
     
     INTEGER ::i,jje,jjb
@@ -322,11 +322,11 @@
    
     do i=0,MPI_Size-1
-      if (i /= MPI_Rank) THEN
+      IF (i /= MPI_Rank) THEN
         jjb=max(jj_begin_new(i),jj_begin)
         jje=min(jj_end_new(i),jj_end)
         
-        if (ij==ip1jm .and. jje==jjp1) jje=jjm
-        
-        if (jje >= jjb) THEN
+        IF (ij==ip1jm .AND. jje==jjp1) jje=jjm
+        
+        IF (jje >= jjb) THEN
           CALL Register_SendField(FieldS,ij,ll,jjb,jje-jjb+1,i,a_request)
         endif
@@ -335,7 +335,7 @@
         jje=min(jj_end_new(MPI_Rank),jj_end_Para(i))
         
-        if (ij==ip1jm .and. jje==jjp1) jje=jjm
-        
-        if (jje >= jjb) THEN
+        IF (ij==ip1jm .AND. jje==jjp1) jje=jjm
+        
+        IF (jje >= jjb) THEN
           CALL Register_RecvField(FieldR,ij,ll,jjb,jje-jjb+1,i,a_request)
         endif
@@ -1153,5 +1153,5 @@
 
       INTEGER :: ij,ll
-      REAL, dimension(ij,ll) :: Field
+      REAL, DIMENSION(ij,ll) :: Field
       INTEGER :: Sup,Sdown,rup,rdown
       type(request) :: a_request
@@ -1176,17 +1176,17 @@
       ENDIF
       
-      if (Sup==0) THEN
+      IF (Sup==0) THEN
         SendUp=.FALSE.
        endif
       
-      if (Sdown==0) THEN
+      IF (Sdown==0) THEN
         SendDown=.FALSE.
       endif
 
-      if (Rup==0) THEN
+      IF (Rup==0) THEN
         RecvUp=.FALSE.
       endif
       
-      if (Rdown==0) THEN
+      IF (Rdown==0) THEN
         RecvDown=.FALSE.
       endif
@@ -1217,5 +1217,5 @@
       IMPLICIT NONE
       INTEGER :: ll
-      REAL, dimension(ijb_u:ije_u,ll) :: Field
+      REAL, DIMENSION(ijb_u:ije_u,ll) :: Field
       INTEGER :: Sup,Sdown,rup,rdown
       type(request) :: a_request
@@ -1240,17 +1240,17 @@
       ENDIF
       
-      if (Sup==0) THEN
+      IF (Sup==0) THEN
         SendUp=.FALSE.
        endif
       
-      if (Sdown==0) THEN
+      IF (Sdown==0) THEN
         SendDown=.FALSE.
       endif
 
-      if (Rup==0) THEN
+      IF (Rup==0) THEN
         RecvUp=.FALSE.
       endif
       
-      if (Rdown==0) THEN
+      IF (Rdown==0) THEN
         RecvDown=.FALSE.
       endif
@@ -1280,5 +1280,5 @@
       IMPLICIT NONE
       INTEGER :: ll
-      REAL, dimension(ijb_v:ije_v,ll) :: Field
+      REAL, DIMENSION(ijb_v:ije_v,ll) :: Field
       INTEGER :: Sup,Sdown,rup,rdown
       type(request) :: a_request
@@ -1303,17 +1303,17 @@
       ENDIF
       
-      if (Sup==0) THEN
+      IF (Sup==0) THEN
         SendUp=.FALSE.
        endif
       
-      if (Sdown==0) THEN
+      IF (Sdown==0) THEN
         SendDown=.FALSE.
       endif
 
-      if (Rup==0) THEN
+      IF (Rup==0) THEN
         RecvUp=.FALSE.
       endif
       
-      if (Rdown==0) THEN
+      IF (Rdown==0) THEN
         RecvDown=.FALSE.
       endif
@@ -1349,5 +1349,5 @@
       INTEGER :: i,rank,l,ij,Pos,ierr
       INTEGER :: offset
-      real,dimension(:,:),pointer :: Field
+      REAL,DIMENSION(:,:),pointer :: Field
       INTEGER :: Nb
        
@@ -1367,5 +1367,5 @@
       
          Req%BufferSize=SizeBuffer
-         if (Req%NbRequest>0) THEN
+         IF (Req%NbRequest>0) THEN
           CALL allocate_buffer(SizeBuffer,Req%Index,Req%pos)
 
@@ -1389,5 +1389,5 @@
           enddo
     
-         if (SizeBuffer>0) THEN
+         IF (SizeBuffer>0) THEN
 !$OMP CRITICAL (MPI)
          
@@ -1426,8 +1426,8 @@
           Req%BufferSize=SizeBuffer
           
-          if (Req%NbRequest>0) THEN
+          IF (Req%NbRequest>0) THEN
           CALL allocate_buffer(SizeBuffer,Req%Index,Req%Pos)
    
-          if (SizeBuffer>0) THEN
+          IF (SizeBuffer>0) THEN
 !$OMP CRITICAL (MPI)
 
@@ -1462,6 +1462,6 @@
       type(request_SR),pointer :: Req
       type(Hallo),pointer :: PtrHallo
-      integer, dimension(2*mpi_size) :: TabRequest
-      integer, dimension(MPI_STATUS_SIZE,2*mpi_size) :: TabStatus
+      INTEGER, DIMENSION(2*mpi_size) :: TabRequest
+      INTEGER, DIMENSION(MPI_STATUS_SIZE,2*mpi_size) :: TabStatus
       INTEGER :: NbRequest
       INTEGER :: i,rank,pos,ij,l,ierr
@@ -1473,5 +1473,5 @@
       do rank=0,MPI_SIZE-1
         Req=>a_request%RequestSend(rank)
-        if (Req%NbRequest>0 .AND. Req%BufferSize > 0) THEN
+        IF (Req%NbRequest>0 .AND. Req%BufferSize > 0) THEN
           NbRequest=NbRequest+1
           TabRequest(NbRequest)=Req%MSG_Request
@@ -1481,5 +1481,5 @@
       do rank=0,MPI_SIZE-1
         Req=>a_request%RequestRecv(rank)
-        if (Req%NbRequest>0 .AND. Req%BufferSize > 0 ) THEN
+        IF (Req%NbRequest>0 .AND. Req%BufferSize > 0 ) THEN
           NbRequest=NbRequest+1
           TabRequest(NbRequest)=Req%MSG_Request
@@ -1487,5 +1487,5 @@
       enddo
      
-      if (NbRequest>0) THEN
+      IF (NbRequest>0) THEN
 !$OMP CRITICAL (MPI)
 !        PRINT *,"-------------------------------------------------------------------"
@@ -1499,5 +1499,5 @@
       do rank=0,MPI_Size-1
         Req=>a_request%RequestRecv(rank)
-        if (Req%NbRequest>0) THEN
+        IF (Req%NbRequest>0) THEN
           Pos=Req%Pos
           do i=1,Req%NbRequest
@@ -1522,5 +1522,5 @@
       do rank=0,MPI_SIZE-1
         Req=>a_request%RequestSend(rank)
-        if (Req%NbRequest>0) THEN
+        IF (Req%NbRequest>0) THEN
           CALL deallocate_buffer(Req%Index)
           Req%NbRequest=0 
@@ -1530,5 +1530,5 @@
       do rank=0,MPI_SIZE-1
         Req=>a_request%RequestRecv(rank)
-        if (Req%NbRequest>0) THEN
+        IF (Req%NbRequest>0) THEN
           CALL deallocate_buffer(Req%Index)
           Req%NbRequest=0 
@@ -1547,6 +1547,6 @@
       type(request_SR),pointer :: Req
       type(Hallo),pointer :: PtrHallo
-      integer, dimension(mpi_size) :: TabRequest
-      integer, dimension(MPI_STATUS_SIZE,mpi_size) :: TabStatus
+      INTEGER, DIMENSION(mpi_size) :: TabRequest
+      INTEGER, DIMENSION(MPI_STATUS_SIZE,mpi_size) :: TabStatus
       INTEGER :: NbRequest
       INTEGER :: i,rank,pos,ij,l,ierr
@@ -1557,5 +1557,5 @@
       do rank=0,MPI_SIZE-1
         Req=>a_request%RequestSend(rank)
-        if (Req%NbRequest>0) THEN
+        IF (Req%NbRequest>0) THEN
           NbRequest=NbRequest+1
           TabRequest(NbRequest)=Req%MSG_Request
@@ -1564,5 +1564,5 @@
       
 
-      if (NbRequest>0 .AND. Req%BufferSize > 0 ) THEN 
+      IF (NbRequest>0 .AND. Req%BufferSize > 0 ) THEN
 !$OMP CRITICAL (MPI)     
 !        PRINT *,"-------------------------------------------------------------------"
@@ -1578,5 +1578,5 @@
       do rank=0,MPI_SIZE-1
         Req=>a_request%RequestSend(rank)
-        if (Req%NbRequest>0) THEN
+        IF (Req%NbRequest>0) THEN
           CALL deallocate_buffer(Req%Index)
           Req%NbRequest=0 
@@ -1594,6 +1594,6 @@
       type(request_SR),pointer :: Req
       type(Hallo),pointer :: PtrHallo
-      integer, dimension(mpi_size) :: TabRequest
-      integer, dimension(MPI_STATUS_SIZE,mpi_size) :: TabStatus
+      INTEGER, DIMENSION(mpi_size) :: TabRequest
+      INTEGER, DIMENSION(MPI_STATUS_SIZE,mpi_size) :: TabStatus
       INTEGER :: NbRequest
       INTEGER :: i,rank,pos,ij,l,ierr
@@ -1605,5 +1605,5 @@
       do rank=0,MPI_SIZE-1
         Req=>a_request%RequestRecv(rank)
-        if (Req%NbRequest>0 .AND. Req%BufferSize > 0 ) THEN
+        IF (Req%NbRequest>0 .AND. Req%BufferSize > 0 ) THEN
           NbRequest=NbRequest+1
           TabRequest(NbRequest)=Req%MSG_Request
@@ -1612,5 +1612,5 @@
      
       
-      if (NbRequest>0) THEN
+      IF (NbRequest>0) THEN
 !$OMP CRITICAL (MPI)     
 !        PRINT *,"-------------------------------------------------------------------"
@@ -1625,5 +1625,5 @@
       do rank=0,MPI_Size-1
         Req=>a_request%RequestRecv(rank)
-        if (Req%NbRequest>0) THEN
+        IF (Req%NbRequest>0) THEN
           Pos=Req%Pos
           do i=1,Req%NbRequest
@@ -1647,5 +1647,5 @@
       do rank=0,MPI_SIZE-1
         Req=>a_request%RequestRecv(rank)
-        if (Req%NbRequest>0) THEN
+        IF (Req%NbRequest>0) THEN
           CALL deallocate_buffer(Req%Index)
           Req%NbRequest=0 
@@ -1664,8 +1664,8 @@
     
     INTEGER :: ij,ll,l
-    REAL, dimension(ij,ll) :: FieldS
-    REAL, dimension(ij,ll) :: FieldR
-    integer,dimension(0:MPI_Size-1) :: jj_Nb_New   
-    integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
+    REAL, DIMENSION(ij,ll) :: FieldS
+    REAL, DIMENSION(ij,ll) :: FieldR
+    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
+    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
     
     INTEGER ::i,jje,jjb,ijb,ije
@@ -1680,7 +1680,7 @@
     jjb=max(jj_begin,jj_begin_new(MPI_Rank))
     jje=min(jj_end,jj_end_new(MPI_Rank))
-    if (ij==ip1jm) jje=min(jje,jjm)
-
-    if (jje >= jjb) THEN
+    IF (ij==ip1jm) jje=min(jje,jjm)
+
+    IF (jje >= jjb) THEN
       ijb=(jjb-1)*iip1+1
       ije=jje*iip1
@@ -1702,8 +1702,8 @@
     
     INTEGER :: ij,ll,Up,Down
-    REAL, dimension(ij,ll) :: FieldS
-    REAL, dimension(ij,ll) :: FieldR
-    integer,dimension(0:MPI_Size-1) :: jj_Nb_New   
-    integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
+    REAL, DIMENSION(ij,ll) :: FieldS
+    REAL, DIMENSION(ij,ll) :: FieldR
+    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
+    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
 
     INTEGER ::i,jje,jjb,ijb,ije,l
@@ -1720,8 +1720,8 @@
     jjb=max(jj_begin,jj_begin_new(MPI_Rank)-Up)
     jje=min(jj_end,jj_end_new(MPI_Rank)+Down)
-    if (ij==ip1jm) jje=min(jje,jjm)
-    
-    
-    if (jje >= jjb) THEN
+    IF (ij==ip1jm) jje=min(jje,jjm)
+    
+    
+    IF (jje >= jjb) THEN
       ijb=(jjb-1)*iip1+1
       ije=jje*iip1
@@ -1743,5 +1743,5 @@
      REAL :: field_glo(ip1jmp1,ll)
      type(request) :: request_gather
-     integer       :: l
+     INTEGER       :: l
 
 
@@ -1767,10 +1767,10 @@
      type(request) :: request_gather
      INTEGER :: ijb,ije
-     integer       :: l
+     INTEGER       :: l
      
    
      ijb=ij_begin
      ije=ij_end
-     if (pole_sud) ije=ij_end-iip1
+     IF (pole_sud) ije=ij_end-iip1
         
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -1795,5 +1795,5 @@
      type(request) :: request_gather
      TYPE(distrib) :: distrib_swap
-     integer       :: l
+     INTEGER       :: l
      
 !$OMP BARRIER
@@ -1829,5 +1829,5 @@
      type(request) :: request_gather
      TYPE(distrib) :: distrib_swap
-     integer       :: ijb,ije,l
+     INTEGER       :: ijb,ije,l
      
 
@@ -1849,5 +1849,5 @@
      ijb=ij_begin
      ije=ij_end
-     if (pole_sud) ije=ij_end-iip1
+     IF (pole_sud) ije=ij_end-iip1
      
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_xios_dyn3dmem.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_xios_dyn3dmem.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_xios_dyn3dmem.F90	(revision 5117)
@@ -15,5 +15,5 @@
 
      USE lmdz_xios
-     USE wxios, ONLY: g_comm
+     USE lmdz_wxios, ONLY: g_comm
      CHARACTER(len=100), SAVE :: dyn3d_ctx_name = "LMDZDYN"
      TYPE(xios_context), SAVE :: dyn3d_ctx_handle
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_gam_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_gam_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_gam_loc.f90	(revision 5117)
@@ -52,15 +52,15 @@
   END DO
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
     DO  ij = 1,iip1
      x(    ij    ,l ) = 0.
     ENDDO
-  endif
+  ENDIF
 
-  if (pole_sud) THEN
+  IF (pole_sud) THEN
     DO  ij = 1,iip1
      x( ij +ip1jm,l ) = 0.
     ENDDO
-  endif
+  ENDIF
   !
   END DO
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_loc.f90	(revision 5117)
@@ -27,5 +27,5 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij = ijb+1, ije
@@ -44,6 +44,6 @@
   ije=ij_end+iip1
 
-  if (pole_nord)  ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord)  ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij = ijb,ije
@@ -51,15 +51,15 @@
   END DO
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
     DO ij = 1,iip1
       x(    ij    ,l ) = 0.
     ENDDO
-  endif
+  ENDIF
 
-  if (pole_sud) THEN
+  IF (pole_sud) THEN
     DO ij = 1,iip1
       x( ij +ip1jm,l ) = 0.
     ENDDO
-  endif
+  ENDIF
   !
   END DO
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgraro2_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgraro2_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgraro2_loc.f90	(revision 5117)
@@ -107,5 +107,5 @@
   jjb=jj_begin
   jje=jj_end
-  if (pole_sud) jje=jj_end-1
+  IF (pole_sud) jje=jj_end-1
 
   CALL filtreg_p( rot, jjb_v,jje_v, jjb,jje,jjm, &
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/parallel_lmdz.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/parallel_lmdz.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/parallel_lmdz.F90	(revision 5117)
@@ -5,5 +5,5 @@
   USE mod_const_mpi
   USE lmdz_mpi, ONLY: using_mpi
-      use IOIPSL
+      USE IOIPSL
     INTEGER,PARAMETER :: halo_max=3
     
@@ -12,36 +12,36 @@
 !$OMP THREADPRIVATE(is_master)
     
-    integer, save :: mpi_size
-    integer, save :: mpi_rank
-    integer, save :: jj_begin
-    integer, save :: jj_end
-    integer, save :: jj_nb
-    integer, save :: ij_begin
-    integer, save :: ij_end
+    INTEGER, save :: mpi_size
+    INTEGER, save :: mpi_rank
+    INTEGER, save :: jj_begin
+    INTEGER, save :: jj_end
+    INTEGER, save :: jj_nb
+    INTEGER, save :: ij_begin
+    INTEGER, save :: ij_end
     logical, save :: pole_nord
     logical, save :: pole_sud
 
-    integer,save  :: jjb_u
-    integer,save  :: jje_u
-    integer,save  :: jjnb_u
-    integer,save  :: jjb_v
-    integer,save  :: jje_v
-    integer,save  :: jjnb_v    
-
-    integer,save  :: ijb_u
-    integer,save  :: ije_u
-    integer,save  :: ijnb_u    
-    
-    integer,save  :: ijb_v
-    integer,save  :: ije_v
-    integer,save  :: ijnb_v    
+    INTEGER,save  :: jjb_u
+    INTEGER,save  :: jje_u
+    INTEGER,save  :: jjnb_u
+    INTEGER,save  :: jjb_v
+    INTEGER,save  :: jje_v
+    INTEGER,save  :: jjnb_v
+
+    INTEGER,save  :: ijb_u
+    INTEGER,save  :: ije_u
+    INTEGER,save  :: ijnb_u
+    
+    INTEGER,save  :: ijb_v
+    INTEGER,save  :: ije_v
+    INTEGER,save  :: ijnb_v
      
     
-    integer, allocatable, save, dimension(:) :: jj_begin_para
-    integer, allocatable, save, dimension(:) :: jj_end_para
-    integer, allocatable, save, dimension(:) :: jj_nb_para
-    integer, save :: OMP_CHUNK
-    integer, save :: omp_rank
-    integer, save :: omp_size  
+    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: jj_begin_para
+    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: jj_end_para
+    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: jj_nb_para
+    INTEGER, save :: OMP_CHUNK
+    INTEGER, save :: omp_rank
+    INTEGER, save :: omp_size
 !$OMP THREADPRIVATE(omp_rank)
 
@@ -53,23 +53,23 @@
       INTEGER :: ij_end
 
-      integer  :: jjb_u
-      integer  :: jje_u
-      integer  :: jjnb_u
-      integer  :: jjb_v
-      integer  :: jje_v
-      integer  :: jjnb_v    
+      INTEGER  :: jjb_u
+      INTEGER  :: jje_u
+      INTEGER  :: jjnb_u
+      INTEGER  :: jjb_v
+      INTEGER  :: jje_v
+      INTEGER  :: jjnb_v
  
-      integer  :: ijb_u
-      integer  :: ije_u
-      integer  :: ijnb_u    
-    
-      integer  :: ijb_v
-      integer  :: ije_v
-      integer  :: ijnb_v    
+      INTEGER  :: ijb_u
+      INTEGER  :: ije_u
+      INTEGER  :: ijnb_u
+    
+      INTEGER  :: ijb_v
+      INTEGER  :: ije_v
+      INTEGER  :: ijnb_v
      
     
-      integer, pointer :: jj_begin_para(:) => NULL()
-      integer, pointer :: jj_end_para(:) => NULL()
-      integer, pointer :: jj_nb_para(:) => NULL()
+      INTEGER, pointer :: jj_begin_para(:) => NULL()
+      INTEGER, pointer :: jj_end_para(:) => NULL()
+      INTEGER, pointer :: jj_nb_para(:) => NULL()
     END TYPE distrib  
     
@@ -82,5 +82,5 @@
  
     SUBROUTINE init_parallel
-    USE vampir
+    USE lmdz_vampir
     USE lmdz_mpi
     IMPLICIT NONE
@@ -92,5 +92,5 @@
       INTEGER :: i,j
       INTEGER :: type_size
-      integer, dimension(3) :: blocklen,type
+      INTEGER, DIMENSION(3) :: blocklen,type
       INTEGER :: comp_id
       CHARACTER(LEN=4)  :: num
@@ -122,5 +122,5 @@
 
 ! Open text output file with mpi_rank in suffix of file name 
-      IF (lunout /= 5 .and. lunout /= 6) THEN
+      IF (lunout /= 5 .AND. lunout /= 6) THEN
          WRITE(num,'(I4.4)') mpi_rank
          filename='lmdz.out_'//num
@@ -138,7 +138,7 @@
       do i=0,mpi_size-1
         jj_nb_para(i)=(jjm+1)/mpi_size
-        if ( i < MOD((jjm+1),mpi_size) ) jj_nb_para(i)=jj_nb_para(i)+1
-        
-        if (jj_nb_para(i) <= 1 ) THEN
+        IF ( i < MOD((jjm+1),mpi_size) ) jj_nb_para(i)=jj_nb_para(i)+1
+        
+        IF (jj_nb_para(i) <= 1 ) THEN
          WRITE(lunout,*)"Arret : le nombre de bande de lattitude par process est trop faible (<2)."
          WRITE(lunout,*)" ---> diminuez le nombre de CPU ou augmentez la taille en lattitude"
@@ -172,5 +172,5 @@
       ij_end=jj_end*iip1
       
-      if (mpi_rank==0) THEN
+      IF (mpi_rank==0) THEN
         pole_nord=.TRUE.
       else 
@@ -178,5 +178,5 @@
       endif
       
-      if (mpi_rank==mpi_size-1) THEN
+      IF (mpi_rank==mpi_size-1) THEN
         pole_sud=.TRUE.
       else 
@@ -233,5 +233,5 @@
       CALL create_distrib(jj_nb_para,current_dist)
       
-      IF ((mpi_rank==0).and.(omp_rank==0)) THEN
+      IF ((mpi_rank==0).AND.(omp_rank==0)) THEN
         is_master=.TRUE.
       ELSE
@@ -379,15 +379,15 @@
     USE lmdz_mpi
     ! ug Pour les sorties XIOS
-  	USE wxios
+  	USE lmdz_wxios
 
 #ifdef CPP_COUPLE
 ! Use of Oasis-MCT coupler 
 #if defined CPP_OMCT
-    use mod_prism
+    USE mod_prism
 #else
-    use mod_prism_proto
+    USE mod_prism_proto
 #endif
 ! Ehouarn: surface_data module is in 'phylmd' ...
-      use surface_data, ONLY: type_ocean
+      USE surface_data, ONLY: type_ocean
       IMPLICIT NONE
 #else
@@ -403,9 +403,9 @@
       INTEGER :: i
 
-      if (allocated(jj_begin_para)) deallocate(jj_begin_para)
-      if (allocated(jj_end_para))   deallocate(jj_end_para)
-      if (allocated(jj_nb_para))    deallocate(jj_nb_para)
-
-      if (type_ocean == 'couple') THEN
+      IF (allocated(jj_begin_para)) deallocate(jj_begin_para)
+      IF (allocated(jj_end_para))   deallocate(jj_end_para)
+      IF (allocated(jj_nb_para))    deallocate(jj_nb_para)
+
+      IF (type_ocean == 'couple') THEN
 #ifdef CPP_COUPLE
         IF (using_xios) THEN
@@ -413,10 +413,10 @@
           CALL wxios_close()
           CALL prism_terminate_proto(ierr)
-          IF (ierr .ne. PRISM_Ok) THEN
+          IF (ierr .NE. PRISM_Ok) THEN
             CALL abort_gcm('Finalize_parallel',' Probleme dans prism_terminate_proto ',1)
           ENDIF
         ELSE
            CALL prism_terminate_proto(ierr)
-           IF (ierr .ne. PRISM_Ok) THEN
+           IF (ierr .NE. PRISM_Ok) THEN
               CALL abort_gcm('Finalize_parallel',' Probleme dans prism_terminate_proto ',1)
            endif
@@ -441,7 +441,7 @@
       INCLUDE "paramet.h"
 
-      integer, intent(in) :: ij,ll,row
-      real,dimension(ij,ll),intent(in) ::Field
-      real,dimension(ll*iip1*row), intent(out) :: Buffer 
+      INTEGER, INTENT(IN) :: ij,ll,row
+      REAL,DIMENSION(ij,ll),INTENT(IN) ::Field
+      REAL,DIMENSION(ll*iip1*row), INTENT(OUT) :: Buffer
             
       INTEGER :: Pos
@@ -464,7 +464,7 @@
       INCLUDE "paramet.h"
 
-      integer, intent(in) :: ij,ll,row
-      real,dimension(ij,ll),intent(out) ::Field
-      real,dimension(ll*iip1*row), intent(in) :: Buffer 
+      INTEGER, INTENT(IN) :: ij,ll,row
+      REAL,DIMENSION(ij,ll),INTENT(OUT) ::Field
+      REAL,DIMENSION(ll*iip1*row), INTENT(IN) :: Buffer
             
       INTEGER :: Pos
@@ -497,10 +497,10 @@
     SUBROUTINE exchange_hallo(Field,ij,ll,up,down)
     USE lmdz_mpi
-    USE Vampir
+    USE lmdz_vampir
     IMPLICIT NONE
       INCLUDE "dimensions.h"
       INCLUDE "paramet.h"    
       INTEGER :: ij,ll
-      REAL, dimension(ij,ll) :: Field
+      REAL, DIMENSION(ij,ll) :: Field
       INTEGER :: up,down
       
@@ -512,6 +512,6 @@
 
       INTEGER :: NbRequest
-      REAL, dimension(:),allocatable :: Buffer_Send_up,Buffer_Send_down
-      REAL, dimension(:),allocatable :: Buffer_Recv_up,Buffer_Recv_down
+      REAL, DIMENSION(:),ALLOCATABLE :: Buffer_Send_up,Buffer_Send_down
+      REAL, DIMENSION(:),ALLOCATABLE :: Buffer_Recv_up,Buffer_Recv_down
       INTEGER :: Buffer_size      
 
@@ -537,10 +537,10 @@
         ENDIF
         
-        if (up==0) THEN
+        IF (up==0) THEN
           SendDown=.FALSE.
           RecvUp=.FALSE.
         endif
       
-        if (down==0) THEN
+        IF (down==0) THEN
           SendUp=.FALSE.
           RecvDown=.FALSE.
@@ -599,5 +599,5 @@
         ENDIF
   
-        if (NbRequest > 0) CALL MPI_WAITALL(NbRequest,Request,Status,ierr)
+        IF (NbRequest > 0) CALL MPI_WAITALL(NbRequest,Request,Status,ierr)
         IF (RecvUp)  CALL Unpack_Data(Field(ij_begin-up*iip1,1),ij,ll,up,Buffer_Recv_up)
         IF (RecvDown) CALL Unpack_Data(Field(ij_end+1,1),ij,ll,down,Buffer_Recv_down)
@@ -620,8 +620,8 @@
     INCLUDE "iniprint.h"
       INTEGER :: ij,ll,rank
-      REAL, dimension(ij,ll) :: Field
-      REAL, dimension(:),allocatable :: Buffer_send   
-      REAL, dimension(:),allocatable :: Buffer_Recv
-      INTEGER, dimension(0:MPI_Size-1) :: Recv_count, displ
+      REAL, DIMENSION(ij,ll) :: Field
+      REAL, DIMENSION(:),ALLOCATABLE :: Buffer_send
+      REAL, DIMENSION(:),ALLOCATABLE :: Buffer_Recv
+      INTEGER, DIMENSION(0:MPI_Size-1) :: Recv_count, displ
       INTEGER :: ierr
       INTEGER ::i
@@ -629,8 +629,8 @@
       IF (using_mpi) THEN
 
-        if (ij==ip1jmp1) THEN
+        IF (ij==ip1jmp1) THEN
            allocate(Buffer_send(iip1*ll*(jj_end-jj_begin+1)))
            CALL Pack_Data(Field(ij_begin,1),ij,ll,jj_end-jj_begin+1,Buffer_send)
-        else if (ij==ip1jm) THEN
+        ELSE IF (ij==ip1jm) THEN
            allocate(Buffer_send(iip1*ll*(min(jj_end,jjm)-jj_begin+1)))
            CALL Pack_Data(Field(ij_begin,1),ij,ll,min(jj_end,jjm)-jj_begin+1,Buffer_send)
@@ -640,5 +640,5 @@
         endif
         
-        if (MPI_Rank==rank) THEN
+        IF (MPI_Rank==rank) THEN
           allocate(Buffer_Recv(ij*ll))
 
@@ -646,7 +646,7 @@
           do i=0,MPI_Size-1
              
-            if (ij==ip1jmp1) THEN
+            IF (ij==ip1jmp1) THEN
               Recv_count(i)=(jj_end_para(i)-jj_begin_para(i)+1)*ll*iip1
-            else if (ij==ip1jm) THEN
+            ELSE IF (ij==ip1jm) THEN
               Recv_count(i)=(min(jj_end_para(i),jjm)-jj_begin_para(i)+1)*ll*iip1
             else
@@ -654,5 +654,5 @@
             endif
                    
-            if (i==0) THEN
+            IF (i==0) THEN
               displ(i)=0 
             else
@@ -674,11 +674,11 @@
 !$OMP END CRITICAL (MPI)
       
-        if (MPI_Rank==rank) THEN
-          if (ij==ip1jmp1) THEN
+        IF (MPI_Rank==rank) THEN
+          IF (ij==ip1jmp1) THEN
             do i=0,MPI_Size-1
               CALL Unpack_Data(Field((jj_begin_para(i)-1)*iip1+1,1),ij,ll,                 &
                                jj_end_para(i)-jj_begin_para(i)+1,Buffer_Recv(displ(i)+1))
             enddo
-          else if (ij==ip1jm) THEN
+          ELSE IF (ij==ip1jm) THEN
             do i=0,MPI_Size-1
                CALL Unpack_Data(Field((jj_begin_para(i)-1)*iip1+1,1),ij,ll,                       &
@@ -698,5 +698,5 @@
     INCLUDE "paramet.h"    
       INTEGER :: ij,ll
-      REAL, dimension(ij,ll) :: Field
+      REAL, DIMENSION(ij,ll) :: Field
       INTEGER :: ierr
       
@@ -716,5 +716,5 @@
     INCLUDE "paramet.h"    
       INTEGER :: ij,ll
-      REAL, dimension(ij,ll) :: Field
+      REAL, DIMENSION(ij,ll) :: Field
       INTEGER :: rank
       INTEGER :: ierr
@@ -737,8 +737,8 @@
 
 !      INTEGER :: ij,ll
-!      REAL, dimension(ij,ll) :: Field
+!      REAL, DIMENSION(ij,ll) :: Field
 !      INTEGER :: up,down 
 
-!      REAL,dimension(ij,ll): NewField
+!      REAL,DIMENSION(ij,ll): NewField
 
 !      NewField=0
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/pression_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/pression_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/pression_loc.f90	(revision 5117)
@@ -29,6 +29,6 @@
   ije=ij_end+2*iip1
 
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/qminimum_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/qminimum_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/qminimum_loc.f90	(revision 5117)
@@ -6,6 +6,6 @@
   USE infotrac, ONLY: niso, ntiso, iqIsoPha, tracers, &
         isoCheck, min_qParent
-  USE strings_mod, ONLY: strIdx
-  USE readTracFiles_mod, ONLY: addPhase
+  USE lmdz_strings, ONLY: strIdx
+  USE lmdz_readTracFiles, ONLY: addPhase
   IMPLICIT none
   !
@@ -87,6 +87,6 @@
 !$OMP DO SCHEDULE(STATIC)
     DO i = ijb, ije
-      if (seuil_liq - q(i,k,iq_liq) > 0.d0 ) THEN
-        if (niso > 0) zx_defau_diag(i,k,2)=AMAX1 &
+      IF (seuil_liq - q(i,k,iq_liq) > 0.d0 ) THEN
+        IF (niso > 0) zx_defau_diag(i,k,2)=AMAX1 &
               ( seuil_liq - q(i,k,iq_liq), 0.0 )
 
@@ -108,6 +108,6 @@
     DO i = ijb, ije
 
-      if ( seuil_vap - q(i,k,iq_vap) > 0.d0 ) THEN
-        if (niso > 0) zx_defau_diag(i,k,1) &
+      IF ( seuil_vap - q(i,k,iq_vap) > 0.d0 ) THEN
+        IF (niso > 0) zx_defau_diag(i,k,1) &
               = AMAX1( seuil_vap - q(i,k,iq_vap), 0.0 )
 
@@ -148,5 +148,5 @@
 
   !WRITE(lunout,*) 'qminimum 128'
-  if (niso > 0) THEN
+  IF (niso > 0) THEN
           !WRITE(lunout,*) 'qminimum 140'
   ! CRisi: traiter de même les traceurs d'eau
@@ -164,5 +164,5 @@
 !$OMP DO SCHEDULE(STATIC)
   DO i = ijb, ije
-    if (zx_pump(i)>0.0) THEN
+    IF (zx_pump(i)>0.0) THEN
       q_follow(i,1,1)=q_follow(i,1,1)+zx_pump(i)
     endif !if (zx_pump(i).gt.0.0) THEN
@@ -175,9 +175,9 @@
 !$OMP DO SCHEDULE(STATIC)
     DO i = ijb, ije
-      if (zx_defau_diag(i,k,1)>0.0) THEN
+      IF (zx_defau_diag(i,k,1)>0.0) THEN
           ! on ajoute la vapeur en k
           !  WRITE(lunout,*) 'i,k,q_follow(i,k-1,ivap)=',
   ! :                 i,k,q_follow(i,k-1,1)
-          if (q_follow(i,k-1,1)<min_qParent) THEN
+          IF (q_follow(i,k-1,1)<min_qParent) THEN
             WRITE(lunout,*) 'tmp qmin: on stoppe'
             WRITE(lunout,*) 'zx_pump(i)=',zx_pump(i)
@@ -200,5 +200,5 @@
                  *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,1)
 
-          if (isoCheck) THEN
+          IF (isoCheck) THEN
             IF(iso_verif_noNaN_nostop(q(i,k,iqIsoPha(ixt,iq_vap)), &
                   'qminimum 155')==1) THEN
@@ -224,6 +224,6 @@
                  /q_follow(i,k-1,1)
 
-           if (isoCheck) THEN
-            if (iso_verif_noNaN_nostop( &
+           IF (isoCheck) THEN
+            IF (iso_verif_noNaN_nostop( &
                   q(i,k-1,iqIsoPha(ixt,iq_vap)), &
                   'qminimum 175')==1) THEN
@@ -260,5 +260,5 @@
 !$OMP DO SCHEDULE(STATIC)
     DO i = ijb, ije
-      if (zx_defau_diag(i,k,2)>0.0) THEN
+      IF (zx_defau_diag(i,k,2)>0.0) THEN
           ! on ajoute eau liquide en k en k
           do ixt=1,ntiso
@@ -282,5 +282,5 @@
    CALL check_isotopes(q,ijb,ije,'qminimum 197')
 
-  endif !if (niso > 0) THEN
+  ENDIF !if (niso > 0) THEN
   !WRITE(*,*) 'qminimum 188'
 !$OMP BARRIER
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotatf_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotatf_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotatf_loc.f90	(revision 5117)
@@ -53,5 +53,5 @@
     jjb=jj_begin
     jje=jj_end
-    if (pole_sud) jje=jj_end-1
+    IF (pole_sud) jje=jj_end-1
     CALL filtreg_p( rot, jjb_v, jje_v,jjb,jje,jjm, &
           klevel, 2, 2, .FALSE., 1 )
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/sw_case_williamson91_6_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/sw_case_williamson91_6_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/sw_case_williamson91_6_loc.f90	(revision 5117)
@@ -53,9 +53,9 @@
   !   ------
 
-  real,allocatable :: ucov_glo(:,:)
-  real,allocatable :: vcov_glo(:,:)
-  real,allocatable :: teta_glo(:,:)
-  real,allocatable :: masse_glo(:,:)
-  real,allocatable :: ps_glo(:)
+  REAL,ALLOCATABLE :: ucov_glo(:,:)
+  REAL,ALLOCATABLE :: vcov_glo(:,:)
+  REAL,ALLOCATABLE :: teta_glo(:,:)
+  REAL,ALLOCATABLE :: masse_glo(:,:)
+  REAL,ALLOCATABLE :: ps_glo(:)
 
    ! REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
@@ -65,9 +65,9 @@
    ! REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
 
-  real,allocatable :: p(:,:)
-  real,allocatable :: pks(:)
-  real,allocatable :: pk(:,:)
-  real,allocatable :: pkf(:,:)
-  real,allocatable :: alpha(:,:),beta(:,:)
+  REAL,ALLOCATABLE :: p(:,:)
+  REAL,ALLOCATABLE :: pks(:)
+  REAL,ALLOCATABLE :: pk(:,:)
+  REAL,ALLOCATABLE :: pkf(:,:)
+  REAL,ALLOCATABLE :: alpha(:,:),beta(:,:)
 
   REAL :: sinth,costh,costh2, Ath,Bth,Cth, lon,dps
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/times.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/times.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/times.F90	(revision 5117)
@@ -1,24 +1,24 @@
 module times
-  integer,PRIVATE,save :: Last_Count=0
-  real, PRIVATE,save :: Last_cpuCount=0
+  INTEGER,PRIVATE,save :: Last_Count=0
+  REAL, PRIVATE,save :: Last_cpuCount=0
   logical, PRIVATE,save :: AllTimer_IsActive=.FALSE.
   
-  integer, parameter :: nb_timer = 4
-  integer, parameter :: timer_caldyn  = 1
-  integer, parameter :: timer_vanleer = 2
-  integer, parameter :: timer_dissip = 3
-  integer, parameter :: timer_physic = 4
-  integer, parameter :: stopped = 1
-  integer, parameter :: running = 2
-  integer, parameter :: suspended = 3 
+  INTEGER, parameter :: nb_timer = 4
+  INTEGER, parameter :: timer_caldyn  = 1
+  INTEGER, parameter :: timer_vanleer = 2
+  INTEGER, parameter :: timer_dissip = 3
+  INTEGER, parameter :: timer_physic = 4
+  INTEGER, parameter :: stopped = 1
+  INTEGER, parameter :: running = 2
+  INTEGER, parameter :: suspended = 3
   
   INTEGER :: max_size
-  real,    allocatable, dimension(:,:,:) :: timer_table
-  real,    allocatable, dimension(:,:,:) :: timer_table_sqr 
-  integer, allocatable, dimension(:,:,:) :: timer_iteration
-  real,    allocatable, dimension(:,:,:) :: timer_average
-  real,    allocatable, dimension(:,:,:) :: timer_delta
-  real,    allocatable,dimension(:) :: timer_running, last_time
-  integer, allocatable,dimension(:) :: timer_state
+  REAL,    ALLOCATABLE, DIMENSION(:,:,:) :: timer_table
+  REAL,    ALLOCATABLE, DIMENSION(:,:,:) :: timer_table_sqr
+  INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: timer_iteration
+  REAL,    ALLOCATABLE, DIMENSION(:,:,:) :: timer_average
+  REAL,    ALLOCATABLE, DIMENSION(:,:,:) :: timer_delta
+  REAL,    ALLOCATABLE,DIMENSION(:) :: timer_running, last_time
+  INTEGER, ALLOCATABLE,DIMENSION(:) :: timer_state
   
   contains
@@ -52,6 +52,6 @@
     INTEGER :: no_timer
     
-    if (AllTimer_IsActive) THEN
-      if (timer_state(no_timer)/=stopped) THEN
+    IF (AllTimer_IsActive) THEN
+      IF (timer_state(no_timer)/=stopped) THEN
         CALL abort_gcm("times","start_timer :: timer is already running or suspended",1)
       else
@@ -70,6 +70,6 @@
     INTEGER :: no_timer
      
-    if (AllTimer_IsActive) THEN
-      if (timer_state(no_timer)/=running) THEN
+    IF (AllTimer_IsActive) THEN
+      IF (timer_state(no_timer)/=running) THEN
          CALL abort_gcm("times","suspend_timer :: timer is not running",1)
       else
@@ -87,6 +87,6 @@
     INTEGER :: no_timer
      
-    if (AllTimer_IsActive) THEN
-      if (timer_state(no_timer)/=suspended) THEN
+    IF (AllTimer_IsActive) THEN
+      IF (timer_state(no_timer)/=suspended) THEN
         CALL abort_gcm("times","resume_timer :: timer is not suspended",1)
       else
@@ -106,6 +106,6 @@
     REAL :: V,V2
     
-    if (AllTimer_IsActive) THEN
-      if (timer_state(no_timer)/=running) THEN
+    IF (AllTimer_IsActive) THEN
+      IF (timer_state(no_timer)/=running) THEN
         CALL abort_gcm("times","stop_timer :: timer is not running",1)
       else
@@ -121,5 +121,5 @@
       timer_iteration(jj_nb,no_timer,mpi_rank)=timer_iteration(jj_nb,no_timer,mpi_rank)+1
       timer_average(jj_nb,no_timer,mpi_rank)=timer_table(jj_nb,no_timer,mpi_rank)/timer_iteration(jj_nb,no_timer,mpi_rank)
-      if (timer_iteration(jj_nb,no_timer,mpi_rank)>=2) THEN
+      IF (timer_iteration(jj_nb,no_timer,mpi_rank)>=2) THEN
         N=timer_iteration(jj_nb,no_timer,mpi_rank)
 	V2=timer_table_sqr(jj_nb,no_timer,mpi_rank)
@@ -140,9 +140,9 @@
     INTEGER :: ierr
     INTEGER :: data_size
-    real, allocatable,dimension(:,:) :: tmp_table
+    REAL, ALLOCATABLE,DIMENSION(:,:) :: tmp_table
 
     IF (using_mpi) THEN    
    
-      if (AllTimer_IsActive) THEN
+      IF (AllTimer_IsActive) THEN
       allocate(tmp_table(max_size,nb_timer))
     
@@ -167,11 +167,11 @@
     INTEGER :: ierr
     INTEGER :: data_size
-    real, allocatable,dimension(:,:),target :: tmp_table
-    integer, allocatable,dimension(:,:),target :: tmp_iter
+    REAL, ALLOCATABLE,DIMENSION(:,:),target :: tmp_table
+    INTEGER, ALLOCATABLE,DIMENSION(:,:),target :: tmp_iter
     INTEGER :: istats
 
     IF (using_mpi) THEN
         
-      if (AllTimer_IsActive) THEN
+      IF (AllTimer_IsActive) THEN
       allocate(tmp_table(max_size,nb_timer))
       allocate(tmp_iter(max_size,nb_timer))
@@ -197,5 +197,5 @@
     
     AllTimer_IsActive=.TRUE.
-    if (AllTimer_IsActive) THEN
+    IF (AllTimer_IsActive) THEN
       CALL system_clock(count,count_rate,count_max)
       CALL cpu_time(Last_cpuCount)
@@ -210,5 +210,5 @@
   
     CALL system_clock(count,count_rate,count_max)
-    if (Count>=Last_Count) THEN
+    IF (Count>=Last_Count) THEN
       DiffTime=(1.*(Count-last_Count))/count_rate
     else
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/top_bound_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/top_bound_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/top_bound_loc.f90	(revision 5117)
@@ -60,9 +60,9 @@
   !   ----------
 
-  real,intent(inout) :: ucov(iip1,jjb_u:jje_u,llm) ! covariant zonal wind
-  real,intent(inout) :: vcov(iip1,jjb_v:jje_v,llm) ! covariant meridional wind
-  real,intent(inout) :: teta(iip1,jjb_u:jje_u,llm) ! potential temperature
-  real,intent(in) :: masse(iip1,jjb_u:jje_u,llm) ! mass of atmosphere
-  real,intent(in) :: dt ! time step (s) of sponge model
+  REAL,INTENT(INOUT) :: ucov(iip1,jjb_u:jje_u,llm) ! covariant zonal wind
+  REAL,INTENT(INOUT) :: vcov(iip1,jjb_v:jje_v,llm) ! covariant meridional wind
+  REAL,INTENT(INOUT) :: teta(iip1,jjb_u:jje_u,llm) ! potential temperature
+  REAL,INTENT(IN) :: masse(iip1,jjb_u:jje_u,llm) ! mass of atmosphere
+  REAL,INTENT(IN) :: dt ! time step (s) of sponge model
 
    ! REAL dv(iip1,jjb_v:jje_v,llm),du(iip1,jjb_u:jje_u,llm)
@@ -78,15 +78,15 @@
   INTEGER :: i
   REAL,SAVE :: rdamp(llm)
-  real,save :: lambda(llm) ! inverse or quenching time scale (Hz)
+  REAL,save :: lambda(llm) ! inverse or quenching time scale (Hz)
   LOGICAL,SAVE :: first=.TRUE.
   INTEGER :: j,l,jjb,jje
 
 
-  if (iflag_top_bound == 0) return
-
-  if (first) THEN
+  IF (iflag_top_bound == 0) return
+
+  IF (first) THEN
 !$OMP BARRIER
 !$OMP MASTER
-     if (iflag_top_bound == 1) THEN
+     IF (iflag_top_bound == 1) THEN
   ! sponge quenching over the topmost 4 atmospheric layers
          lambda(:)=0.
@@ -95,5 +95,5 @@
          lambda(llm-2)=tau_top_bound/4.
          lambda(llm-3)=tau_top_bound/8.
-     else if (iflag_top_bound == 2) THEN
+     ELSE IF (iflag_top_bound == 2) THEN
   ! sponge quenching over topmost layers down to pressures which are
   ! higher than 100 times the topmost layer pressure
@@ -110,5 +110,5 @@
      WRITE(lunout,*)'p (Pa)  z(km)  tau(s)   1./tau (Hz)'
      do l=1,llm
-       if (rdamp(l)/=0.) THEN
+       IF (rdamp(l)/=0.) THEN
          WRITE(lunout,'(6(1pe12.4,1x))') &
                presnivs(l),log(preff/presnivs(l))*scaleheight, &
@@ -119,5 +119,5 @@
 !$OMP END MASTER
 !$OMP BARRIER
-  endif ! of if (first)
+  ENDIF ! of if (first)
 
 
@@ -125,5 +125,5 @@
 
   ! compute zonal average of vcov (or set it to zero)
-  if (mode_top_bound>=2) THEN
+  IF (mode_top_bound>=2) THEN
    jjb=jj_begin
    jje=jj_end
@@ -150,8 +150,8 @@
    enddo
 !$OMP END DO NOWAIT
-  endif ! of if (mode_top_bound.ge.2)
+  ENDIF ! of if (mode_top_bound.ge.2)
 
   ! compute zonal average of u (or set it to zero)
-  if (mode_top_bound>=2) THEN
+  IF (mode_top_bound>=2) THEN
    jjb=jj_begin
    jje=jj_end
@@ -177,8 +177,8 @@
    enddo
 !$OMP END DO NOWAIT
-  endif ! of if (mode_top_bound.ge.2)
+  ENDIF ! of if (mode_top_bound.ge.2)
 
   ! compute zonal average of potential temperature, if necessary
-  if (mode_top_bound>=3) THEN
+  IF (mode_top_bound>=3) THEN
    jjb=jj_begin
    jje=jj_end
@@ -198,7 +198,7 @@
    enddo
 !$OMP END DO NOWAIT
-  endif ! of if (mode_top_bound.ge.3)
-
-  if (mode_top_bound>=1) THEN
+  ENDIF ! of if (mode_top_bound.ge.3)
+
+  IF (mode_top_bound>=1) THEN
    ! Apply sponge quenching on vcov:
    jjb=jj_begin
@@ -233,7 +233,7 @@
    enddo
 !$OMP END DO NOWAIT
-  endif ! of if (mode_top_bound.ge.1)
-
-  if (mode_top_bound>=3) THEN
+  ENDIF ! of if (mode_top_bound.ge.1)
+
+  IF (mode_top_bound>=3) THEN
    ! Apply sponge quenching on teta:
    jjb=jj_begin
@@ -252,5 +252,5 @@
    enddo
 !$OMP END DO NOWAIT
-  endif ! of if (mode_top_bond.ge.3)
+  ENDIF ! of if (mode_top_bond.ge.3)
 
 END SUBROUTINE top_bound_loc
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlsplt_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlsplt_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlsplt_loc.f90	(revision 5117)
@@ -60,6 +60,6 @@
   ije = ije_x
 
-  if (pole_nord.and.ijb==1) ijb = ijb + iip1
-  if (pole_sud.and.ije==ip1jmp1)  ije = ije - iip1
+  IF (pole_nord.AND.ijb==1) ijb = ijb + iip1
+  IF (pole_sud.AND.ije==ip1jmp1)  ije = ije - iip1
 
   IF (pente_max>-1.e-5) THEN
@@ -238,5 +238,5 @@
       !   indicage des mailles concernees par le traitement special
       DO ij = ijb, ije
-        IF(iadvplus(ij, l)==1.and.mod(ij, iip1)/=0) THEN
+        IF(iadvplus(ij, l)==1.AND.mod(ij, iip1)/=0) THEN
           iju = iju + 1
           indu(iju) = ij
@@ -313,5 +313,5 @@
         !MVals: veiller a ce qu'on n'ait pas de denominateur nul
         masse(ij, l, iq2) = max(masse(ij, l, iq) * q(ij, l, iq), min_qMass)
-        if (q(ij, l, iq)>min_qParent) then ! modif 13 nov 2020
+        IF (q(ij, l, iq)>min_qParent) then ! modif 13 nov 2020
           Ratio(ij, l, iq2) = q(ij, l, iq2) / q(ij, l, iq)
         else
@@ -440,6 +440,6 @@
   ijb = ij_begin - 2 * iip1
   ije = ij_end + 2 * iip1
-  if (pole_nord) ijb = ij_begin
-  if (pole_sud)  ije = ij_end
+  IF (pole_nord) ijb = ij_begin
+  IF (pole_sud)  ije = ij_end
 
   IF(first) THEN
@@ -474,5 +474,5 @@
     !    le pole nord) qui sera utilisee pour evaluer les pentes au pole.
 
-    if (pole_nord) THEN
+    IF (pole_nord) THEN
       DO i = 1, iim
         airescb(i) = aire(i + iip1) * q(i + iip1, l, iq)
@@ -481,5 +481,5 @@
     endif
 
-    if (pole_sud) THEN
+    IF (pole_sud) THEN
       DO i = 1, iim
         airesch(i) = aire(i + ip1jm - iip1) * q(i + ip1jm - iip1, l, iq)
@@ -492,6 +492,6 @@
     ijb = ij_begin - 2 * iip1
     ije = ij_end + iip1
-    if (pole_nord) ijb = ij_begin
-    if (pole_sud)  ije = ij_end - iip1
+    IF (pole_nord) ijb = ij_begin
+    IF (pole_sud)  ije = ij_end - iip1
 
     ! on a besoin de q entre ij_begin-2*iip1 et ij_end+2*iip1
@@ -507,6 +507,6 @@
     ijb = ij_begin - iip1
     ije = ij_end + iip1
-    if (pole_nord) ijb = ij_begin + iip1
-    if (pole_sud)  ije = ij_end - iip1
+    IF (pole_nord) ijb = ij_begin + iip1
+    IF (pole_sud)  ije = ij_end - iip1
 
     DO ij = ijb, ije
@@ -654,6 +654,6 @@
     ijb = ij_begin - iip1
     ije = ij_end + iip1
-    if (pole_nord) ijb = ij_begin + iip1
-    if (pole_sud)  ije = ij_end - iip1
+    IF (pole_nord) ijb = ij_begin + iip1
+    IF (pole_sud)  ije = ij_end - iip1
 
     DO ij = ijb, ije
@@ -670,6 +670,6 @@
   ijb = ij_begin - iip1
   ije = ij_end
-  if (pole_nord) ijb = ij_begin
-  if (pole_sud)  ije = ij_end - iip1
+  IF (pole_nord) ijb = ij_begin
+  IF (pole_sud)  ije = ij_end - iip1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -697,8 +697,8 @@
   ijbm = ij_begin - iip1
   ijem = ij_end + iip1
-  if (pole_nord) ijb = ij_begin
-  if (pole_sud)  ije = ij_end
-  if (pole_nord) ijbm = ij_begin
-  if (pole_sud)  ijem = ij_end
+  IF (pole_nord) ijb = ij_begin
+  IF (pole_sud)  ije = ij_end
+  IF (pole_nord) ijbm = ij_begin
+  IF (pole_sud)  ijem = ij_end
 
   do ifils = 1, tracers(iq)%nqDescen
@@ -716,5 +716,5 @@
       DO ij = ijb, ije
         !MVals: veiller a ce qu'on n'ait pas de denominateur nul
-        if (q(ij, l, iq)>min_qParent) then ! modif 13 nov 2020
+        IF (q(ij, l, iq)>min_qParent) then ! modif 13 nov 2020
           Ratio(ij, l, iq2) = q(ij, l, iq2) / q(ij, l, iq)
         else
@@ -734,6 +734,6 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_nord) ijb = ij_begin + iip1
-  if (pole_sud)  ije = ij_end - iip1
+  IF (pole_nord) ijb = ij_begin + iip1
+  IF (pole_sud)  ije = ij_end - iip1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -750,5 +750,5 @@
     ENDDO
 
-    if (pole_nord) THEN
+    IF (pole_nord) THEN
       convpn = SSUM(iim, qbyv(1, l), 1)
       convmpn = ssum(iim, masse_adv_v(1, l), 1)
@@ -764,5 +764,5 @@
     endif
 
-    if (pole_sud) THEN
+    IF (pole_sud) THEN
       convps = -SSUM(iim, qbyv(ip1jm - iim, l), 1)
       convmps = -ssum(iim, masse_adv_v(ip1jm - iim, l), 1)
@@ -1014,5 +1014,5 @@
             ! CRisi 24nov2020: ajout d'un message d'erreur clair au lieu d'un plantage
             ! pour seg fault
-            if (lorig(ij, l)==0) THEN
+            IF (lorig(ij, l)==0) THEN
               CALL abort_gcm("vlz in vlsplt_loc", &
                       "unfixable violation of CFL", 1)
@@ -1065,5 +1065,5 @@
         !MVals: veiller a ce qu'on n'ait pas de denominateur nul
         masse(ij, l, iq2) = max(masse(ij, l, iq) * q(ij, l, iq), min_qMass)
-        if (q(ij, l, iq)>min_qParent) THEN
+        IF (q(ij, l, iq)>min_qParent) THEN
           Ratio(ij, l, iq2) = q(ij, l, iq2) / q(ij, l, iq)
         else
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltgen_loc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltgen_loc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltgen_loc.F90	(revision 5117)
@@ -25,5 +25,5 @@
   USE mod_hallo
   USE write_field_loc, ONLY: WriteField_u, WriteField_v
-  USE VAMPIR
+  USE lmdz_vampir
   ! CRisi: on rajoute variables utiles d'infotrac
   USE infotrac, ONLY: nqtot, tracers, isoCheck
@@ -97,6 +97,6 @@
   ijb = ij_begin - iip1
   ije = ij_end + iip1
-  if (pole_nord) ijb = ij_begin
-  if (pole_sud) ije = ij_end
+  IF (pole_nord) ijb = ij_begin
+  IF (pole_sud) ije = ij_end
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -124,6 +124,6 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_nord) ijb = ijb + iip1
-  if (pole_sud)  ije = ije - iip1
+  IF (pole_nord) ijb = ijb + iip1
+  IF (pole_sud)  ije = ije - iip1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -137,6 +137,6 @@
   ijb = ij_begin - iip1
   ije = ij_end
-  if (pole_nord) ijb = ij_begin
-  if (pole_sud)  ije = ij_end - iip1
+  IF (pole_nord) ijb = ij_begin
+  IF (pole_sud)  ije = ij_end - iip1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -253,6 +253,6 @@
   ijb = ij_begin - 2 * iip1
   ije = ij_end + 2 * iip1
-  if (pole_nord) ijb = ij_begin
-  if (pole_sud)  ije = ij_end
+  IF (pole_nord) ijb = ij_begin
+  IF (pole_sud)  ije = ij_end
   CALL check_isotopes(zq, ij_begin, ij_end, 'vlspltgen_loc 280')
 
@@ -290,6 +290,6 @@
     ijb = ij_begin - 2 * iip1
     ije = ij_end + 2 * iip1
-    if (pole_nord) ijb = ij_begin
-    if (pole_sud)  ije = ij_end
+    IF (pole_nord) ijb = ij_begin
+    IF (pole_sud)  ije = ij_end
     CALL check_isotopes(zq, ijb, ije, 'vlspltgen_loc 336')
   END IF
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltqs_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltqs_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltqs_loc.f90	(revision 5117)
@@ -59,6 +59,6 @@
   ije=ije_x
 
-  if (pole_nord.and.ijb==1) ijb=ijb+iip1
-  if (pole_sud.and.ije==ip1jmp1)  ije=ije-iip1
+  IF (pole_nord.AND.ijb==1) ijb=ijb+iip1
+  IF (pole_sud.AND.ije==ip1jmp1)  ije=ije-iip1
 
   IF (pente_max>-1.e-5) THEN
@@ -157,5 +157,5 @@
 !$OMP END DO NOWAIT
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l=1,llm
@@ -163,7 +163,7 @@
     ENDDO
 !$OMP END DO NOWAIT
-  endif
-
-  if (pole_sud)  THEN
+  ENDIF
+
+  IF (pole_sud)  THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l=1,llm
@@ -171,5 +171,5 @@
     ENDDO
 !$OMP END DO NOWAIT
-  endif
+  ENDIF
 
   !   calcul des flux a gauche et a droite
@@ -247,5 +247,5 @@
   !   indicage des mailles concernees par le traitement special
            DO ij=ijb,ije
-              IF(iadvplus(ij,l)==1.and.mod(ij,iip1)/=0) THEN
+              IF(iadvplus(ij,l)==1.AND.mod(ij,iip1)/=0) THEN
                  iju=iju+1
                  indu(iju)=ij
@@ -319,5 +319,5 @@
         !MVals: veiller a ce qu'on n'ait pas de denominateur nul
         masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
-        if (q(ij,l,iq)>min_qParent) then ! modif 13 nov 2020
+        IF (q(ij,l,iq)>min_qParent) then ! modif 13 nov 2020
           Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
         else
@@ -448,12 +448,12 @@
   ijb=ij_begin-2*iip1
   ije=ij_end+2*iip1
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end
   ij=3525
   l=3
-  if ((ij>=ijb).and.(ij<=ije)) THEN
+  IF ((ij>=ijb).AND.(ij<=ije)) THEN
     !WRITE(*,*) 'vlyqs 480: ij,l,iq,ijb,q(ij,l,:)=',
   ! &             ij,l,iq,ijb,q(ij,l,:)
-  endif
+  ENDIF
 
   IF(first) THEN
@@ -488,17 +488,17 @@
   !    le pole nord) qui sera utilisee pour evaluer les pentes au pole.
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
     DO i = 1, iim
       airescb(i) = aire(i+ iip1) * q(i+ iip1,l,iq)
     ENDDO
     qpns   = SSUM( iim,  airescb ,1 ) / airej2
-  endif
-
-  if (pole_sud) THEN
+  ENDIF
+
+  IF (pole_sud) THEN
     DO i = 1, iim
       airesch(i) = aire(i+ ip1jm- iip1) * q(i+ ip1jm- iip1,l,iq)
     ENDDO
     qpsn   = SSUM( iim,  airesch ,1 ) / airejjm
-  endif
+  ENDIF
 
 
@@ -507,6 +507,6 @@
   ijb=ij_begin-2*iip1
   ije=ij_end+iip1
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij=ijb,ije
@@ -520,6 +520,6 @@
   ijb=ij_begin-iip1
   ije=ij_end+iip1
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij=ijb,ije
@@ -664,6 +664,6 @@
   ijb=ij_begin-iip1
   ije=ij_end+iip1
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij=ijb,ije
@@ -680,6 +680,6 @@
   ijb=ij_begin-iip1
   ije=ij_end
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end-iip1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -708,8 +708,8 @@
   ijbm=ij_begin-iip1
   ijem=ij_end+iip1
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end
-  if (pole_nord) ijbm=ij_begin
-  if (pole_sud)  ijem=ij_end
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end
+  IF (pole_nord) ijbm=ij_begin
+  IF (pole_sud)  ijem=ij_end
 
   !WRITE(lunout,*) 'vlspltqs 737: iq,ijb,ije=',iq,ijb,ije
@@ -731,5 +731,5 @@
         !MVals: veiller a ce qu'on n'ait pas de denominateur nul
         !WRITE(lunout,*) 'ij,l,q(ij,l,iq)=',ij,l,q(ij,l,iq)
-        if (q(ij,l,iq)>min_qParent) then ! modif 13 nov 2020
+        IF (q(ij,l,iq)>min_qParent) then ! modif 13 nov 2020
           Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
         else
@@ -751,6 +751,6 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/wrgrads.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/wrgrads.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/wrgrads.f90	(revision 5117)
@@ -24,5 +24,5 @@
   INTEGER :: im, jm, lm, i, j, l, iv, iii, iji, iif, ijf
 
-  logical :: writectl
+  LOGICAL :: writectl
 
   writectl = .FALSE.
@@ -63,5 +63,5 @@
   else
     ivar(if) = mod(ivar(if), nvar(if)) + 1
-    if (ivar(if)==nvar(if)) THEN
+    IF (ivar(if)==nvar(if)) THEN
       writectl = .TRUE.
       itime(if) = itime(if) + 1
@@ -77,5 +77,5 @@
       CALL abort_gcm("wrgrads", "problem", 1)
     endif
-  endif
+  ENDIF
 
   PRINT*, 'ivar(if),nvar(if),var(ivar(if),if),writectl'
@@ -90,5 +90,5 @@
                     , i = iii, iif), j = iji, ijf)
   enddo
-  if (writectl) THEN
+  IF (writectl) THEN
     file = fichier(if)
     !   WARNING! on reecrase le fichier .ctl a chaque ecriture
@@ -118,5 +118,5 @@
     close(unit(if))
 
-  endif ! writectl
+  ENDIF ! writectl
 
 END SUBROUTINE wrgrads
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_loc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_loc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_loc.F90	(revision 5117)
@@ -14,5 +14,5 @@
   SUBROUTINE write_field1D_u(name,Field)
     CHARACTER(LEN=*)   :: name
-    real, dimension(:) :: Field
+    REAL, DIMENSION(:) :: Field
 
     CALL write_field_u_gen(name,Field,1)
@@ -24,5 +24,5 @@
       
     CHARACTER(LEN=*)   :: name
-    real, dimension(:,:) :: Field
+    REAL, DIMENSION(:,:) :: Field
     INTEGER :: ll
     
@@ -35,5 +35,5 @@
    SUBROUTINE write_field_u_gen(name,Field,ll)
     USE parallel_lmdz
-    USE write_field
+    USE lmdz_write_field
     USE mod_hallo
     IMPLICIT NONE
@@ -42,7 +42,7 @@
       
     CHARACTER(LEN=*)   :: name
-    real, dimension(ijb_u:ije_u,ll) :: Field
-    real, allocatable,SAVE :: New_Field(:,:,:)
-    integer,dimension(0:mpi_size-1) :: jj_nb_master
+    REAL, DIMENSION(ijb_u:ije_u,ll) :: Field
+    REAL, ALLOCATABLE,SAVE :: New_Field(:,:,:)
+    INTEGER,DIMENSION(0:mpi_size-1) :: jj_nb_master
     type(Request),SAVE :: Request_write
 !$OMP THREADPRIVATE(Request_write)
@@ -70,5 +70,5 @@
 
 !$OMP MASTER
-    if (MPI_Rank==0) CALL WriteField(name,New_Field)
+    IF (MPI_Rank==0) CALL WriteField(name,New_Field)
     DEALLOCATE(New_Field)
 !$OMP END MASTER        
@@ -79,5 +79,5 @@
   SUBROUTINE write_field1D_v(name,Field)
     CHARACTER(LEN=*)   :: name
-    real, dimension(:) :: Field
+    REAL, DIMENSION(:) :: Field
 
     CALL write_field_v_gen(name,Field,1)
@@ -89,5 +89,5 @@
       
     CHARACTER(LEN=*)   :: name
-    real, dimension(:,:) :: Field
+    REAL, DIMENSION(:,:) :: Field
     INTEGER :: ll
     
@@ -100,5 +100,5 @@
    SUBROUTINE write_field_v_gen(name,Field,ll)
     USE parallel_lmdz
-    USE write_field
+    USE lmdz_write_field
     USE mod_hallo
     IMPLICIT NONE
@@ -107,7 +107,7 @@
       
     CHARACTER(LEN=*)   :: name
-    real, dimension(ijb_v:ije_v,ll) :: Field
-    real, allocatable,SAVE :: New_Field(:,:,:)
-    integer,dimension(0:mpi_size-1) :: jj_nb_master
+    REAL, DIMENSION(ijb_v:ije_v,ll) :: Field
+    REAL, ALLOCATABLE,SAVE :: New_Field(:,:,:)
+    INTEGER,DIMENSION(0:mpi_size-1) :: jj_nb_master
     type(Request),SAVE :: Request_write
 !$OMP THREADPRIVATE(Request_write)    
@@ -146,5 +146,5 @@
 
 !$OMP MASTER
-    if (MPI_Rank==0) CALL WriteField(name,New_Field)
+    IF (MPI_Rank==0) CALL WriteField(name,New_Field)
     DEALLOCATE(New_Field)
 !$OMP END MASTER        
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_p.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_p.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_p.F90	(revision 5117)
@@ -10,12 +10,12 @@
   SUBROUTINE write_field1D_p(name,Field)
     USE parallel_lmdz
-    USE write_field
+    USE lmdz_write_field
     IMPLICIT NONE
   
-    integer, parameter :: MaxDim=1
+    INTEGER, parameter :: MaxDim=1
     CHARACTER(LEN=*)   :: name
-    real, dimension(:) :: Field
-    real, dimension(:),allocatable :: New_Field
-    integer, dimension(MaxDim) :: Dim
+    REAL, DIMENSION(:) :: Field
+    REAL, DIMENSION(:),ALLOCATABLE :: New_Field
+    INTEGER, DIMENSION(MaxDim) :: Dim
     
     
@@ -25,5 +25,5 @@
     CALL Gather_Field(New_Field,dim(1),1,0)
     
-    if (MPI_Rank==0) CALL WriteField(name,New_Field)
+    IF (MPI_Rank==0) CALL WriteField(name,New_Field)
     
     END SUBROUTINE  write_field1D_p
@@ -31,12 +31,12 @@
   SUBROUTINE write_field2D_p(name,Field)
     USE parallel_lmdz
-    USE write_field
+    USE lmdz_write_field
     IMPLICIT NONE
   
-    integer, parameter :: MaxDim=2
+    INTEGER, parameter :: MaxDim=2
     CHARACTER(LEN=*)   :: name
-    real, dimension(:,:) :: Field
-    real, dimension(:,:),allocatable :: New_Field
-    integer, dimension(MaxDim) :: Dim
+    REAL, DIMENSION(:,:) :: Field
+    REAL, DIMENSION(:,:),ALLOCATABLE :: New_Field
+    INTEGER, DIMENSION(MaxDim) :: Dim
     
     Dim=shape(Field)
@@ -45,5 +45,5 @@
     CALL Gather_Field(New_Field(1,1),dim(1)*dim(2),1,0)
     
-    if (MPI_Rank==0) CALL WriteField(name,New_Field)
+    IF (MPI_Rank==0) CALL WriteField(name,New_Field)
     
      
@@ -52,12 +52,12 @@
   SUBROUTINE write_field3D_p(name,Field)
     USE parallel_lmdz
-    USE write_field
+    USE lmdz_write_field
     IMPLICIT NONE
   
-    integer, parameter :: MaxDim=3
+    INTEGER, parameter :: MaxDim=3
     CHARACTER(LEN=*)   :: name
-    real, dimension(:,:,:) :: Field
-    real, dimension(:,:,:),allocatable :: New_Field
-    integer, dimension(MaxDim) :: Dim
+    REAL, DIMENSION(:,:,:) :: Field
+    REAL, DIMENSION(:,:,:),ALLOCATABLE :: New_Field
+    INTEGER, DIMENSION(MaxDim) :: Dim
     
     Dim=shape(Field)
@@ -66,5 +66,5 @@
     CALL Gather_Field(New_Field(1,1,1),dim(1)*dim(2),dim(3),0)
     
-   if (MPI_Rank==0) CALL WriteField(name,New_Field)
+   IF (MPI_Rank==0) CALL WriteField(name,New_Field)
     
   END SUBROUTINE  write_field3D_p
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedyn_xios.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedyn_xios.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedyn_xios.F90	(revision 5117)
@@ -8,5 +8,5 @@
   USE misc_mod
   USE infotrac, ONLY: nqtot
-  use com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
+  USE com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
   USE comconst_mod, ONLY: cpp
   USE temps_mod, ONLY: itau_dyn
@@ -47,5 +47,5 @@
   REAL phis(ijb_u:ije_u)
   REAL q(ijb_u:ije_u, llm, nqtot)
-  integer time
+  INTEGER time
 
 
@@ -57,6 +57,6 @@
   REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :)
   REAL, SAVE, ALLOCATABLE :: vbuffer(:, :)
-  logical ok_sync
-  integer itau_w
+  LOGICAL ok_sync
+  INTEGER itau_w
   INTEGER :: ijb, ije, jjn
   LOGICAL, SAVE :: first = .TRUE.
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedynav_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedynav_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedynav_loc.f90	(revision 5117)
@@ -9,5 +9,5 @@
   USE misc_mod
   USE infotrac, ONLY: nqtot
-  use com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
+  USE com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
   USE comconst_mod, ONLY: cpp
   USE temps_mod, ONLY: itau_dyn
@@ -67,5 +67,5 @@
   REAL, SAVE, ALLOCATABLE :: tm(:, :)
   REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :)
-  logical :: ok_sync
+  LOGICAL :: ok_sync
   INTEGER :: itau_w
   INTEGER :: ijb, ije, jjn
@@ -76,5 +76,5 @@
   !  Initialisations
   !
-  if (adjust) return
+  IF (adjust) return
 
   IF (first) THEN
@@ -121,6 +121,6 @@
   !
   ije = ij_end
-  if (pole_sud) jjn = jj_nb - 1
-  if (pole_sud) ije = ij_end - iip1
+  IF (pole_sud) jjn = jj_nb - 1
+  IF (pole_sud) ije = ij_end - iip1
   !$OMP BARRIER
   !$OMP MASTER
@@ -209,5 +209,5 @@
   !
   !$OMP MASTER
-  if (ok_sync) THEN
+  IF (ok_sync) THEN
     CALL histsync(histaveid)
     CALL histsync(histvaveid)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writehist_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writehist_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writehist_loc.f90	(revision 5117)
@@ -6,5 +6,5 @@
   USE misc_mod
   USE infotrac, ONLY: nqtot
-  use com_io_dyn_mod, ONLY: histid, histvid, histuid
+  USE com_io_dyn_mod, ONLY: histid, histvid, histuid
   USE comconst_mod, ONLY: cpp
   USE temps_mod, ONLY: itau_dyn
@@ -64,5 +64,5 @@
   REAL, SAVE, ALLOCATABLE :: tm(:, :)
   REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :)
-  logical :: ok_sync
+  LOGICAL :: ok_sync
   INTEGER :: itau_w
   INTEGER :: ijb, ije, jjn
@@ -73,5 +73,5 @@
   !  Initialisations
   !
-  if (adjust) return
+  IF (adjust) return
 
   IF (first) THEN
@@ -118,6 +118,6 @@
   !
   ije = ij_end
-  if (pole_sud) jjn = jj_nb - 1
-  if (pole_sud) ije = ij_end - iip1
+  IF (pole_sud) jjn = jj_nb - 1
+  IF (pole_sud) ije = ij_end - iip1
   !$OMP BARRIER
   !$OMP MASTER
@@ -205,9 +205,9 @@
   !
   !$OMP MASTER
-  if (ok_sync) THEN
+  IF (ok_sync) THEN
     CALL histsync(histid)
     CALL histsync(histvid)
     CALL histsync(histuid)
-  endif
+  ENDIF
   !$OMP END MASTER
 END SUBROUTINE writehist_loc
Index: LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/calfis.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/calfis.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/calfis.f90	(revision 5117)
@@ -299,5 +299,5 @@
   !   convergence dynamique pour les traceurs "EAU"
   ! Earth-specific treatment of first 2 tracers (water)
-   if (planet_type=="earth") THEN
+   IF (planet_type=="earth") THEN
     DO iq=1,2
      DO l=1,llm
@@ -479,6 +479,6 @@
 
      jH_cur_split=jH_cur+(isplit-1) * dtvr / (daysec *nsplit_phys)
-     debut_split=debut.and.isplit==1
-     lafin_split=lafin.and.isplit==nsplit_phys
+     debut_split=debut.AND.isplit==1
+     lafin_split=lafin.AND.isplit==nsplit_phys
 
    ! if (planet_type=="earth") THEN
@@ -493,5 +493,5 @@
           zdufi,zdvfi,zdtfi,zdqfi,zdpsrf)
 
-   ! else if ( planet_type=="generic" ) THEN
+   ! ELSE IF ( planet_type=="generic" ) THEN
    !    CALL physiq (ngridmx,     !! ngrid
   ! .             llm,            !! nlayer
@@ -518,5 +518,5 @@
   ! .             tracerdyn)      !! tracerdyn <-- utilite ???
 
-  !  endif ! of if (planet_type=="earth")
+  !  ENDIF ! of if (planet_type=="earth")
 
      zufi(:,:)=zufi(:,:)+zdufi(:,:)*zdt_split
Index: LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/grid_atob_m.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/grid_atob_m.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/grid_atob_m.f90	(revision 5117)
@@ -244,11 +244,11 @@
   WHERE(cham2tmp<0.001) cham2tmp=0.001
   CALL fine2coarse(xtmp,ytmp,xmod,ymod,out,REAL(LOG(cham2tmp)))
-  out=EXP(out)
-  amin=MINVAL(out); amax=MAXVAL(out)
+  out=EXP(OUT)
+  amin=MINVAL(OUT); amax=MAXVAL(OUT)
   PRINT*, 'Ecart-type du modele:', amin, amax
   out=out/amax*20.0
-  amin=MINVAL(out); amax=MAXVAL(out)
+  amin=MINVAL(OUT); amax=MAXVAL(OUT)
   PRINT*, 'Longueur de rugosite du modele:', amin, amax
-  rugs=REAL(out)
+  rugs=REAL(OUT)
 
 END SUBROUTINE rugsoro
Index: LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/inigeomphy_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/inigeomphy_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/inigeomphy_mod.F90	(revision 5117)
@@ -23,5 +23,5 @@
                                  south_west, south_east
   USE mod_interface_dyn_phys, ONLY:  init_interface_dyn_phys
-  USE nrtype, ONLY: pi
+  USE lmdz_physical_constants, ONLY: pi
   USE comvert_mod, ONLY: preff, ap, bp, aps, bps, presnivs, &
                          scaleheight, pseudoalt, presinter
@@ -144,5 +144,5 @@
         boundslonfi_glo(k,north_east)=rlonu(i)
         boundslatfi_glo(k,north_east)=rlatv(j-1)
-        if (i==1) THEN
+        IF (i==1) THEN
           ! special case for the first longitude's west bound
           boundslonfi_glo(k,north_west)=rlonu(iim)-2*PI
Index: LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/lmdz_calfis_loc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/lmdz_calfis_loc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/lmdz_calfis_loc.F90	(revision 5117)
@@ -40,5 +40,5 @@
     USE parallel_lmdz,ONLY:omp_chunk,using_mpi,jjb_u,jje_u,jjb_v,jje_v &
           ,jj_begin_dyn=>jj_begin,jj_end_dyn=>jj_end
-    USE Write_Field
+    USE lmdz_write_field
     Use Write_field_p
     USE Times
@@ -188,5 +188,5 @@
   ! J'ai été surpris au début que les tableaux zufi_omp, zdufi_omp n'co soitent
   ! en SAVE. Je crois comprendre que c'est parce que tu voulais qu'il
-  ! soit allocatable (plutot par exemple que de passer une dimension
+  ! soit ALLOCATABLE (plutot par exemple que de passer une dimension
   ! dépendant du process en argument des routines) et que, du coup,
   ! le SAVE évite d'avoir à refaire l'allocation à chaque appel.
@@ -222,8 +222,8 @@
 !$OMP THREADPRIVATE(firstcal,debut)
 
-  REAL,SAVE,dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv
+  REAL,SAVE,DIMENSION(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv
   INTEGER :: ierr
-  INTEGER,dimension(MPI_STATUS_SIZE,4) :: Status
-  INTEGER, dimension(4) :: Req
+  INTEGER,DIMENSION(MPI_STATUS_SIZE,4) :: Status
+  INTEGER, DIMENSION(4) :: Req
   REAL,ALLOCATABLE,SAVE:: zdufi2(:,:),zdvfi2(:,:)
   INTEGER :: k,kstart,kend
@@ -412,6 +412,6 @@
   kend=klon
 
-  if (is_north_pole_dyn) kstart=2
-  if (is_south_pole_dyn) kend=klon-1
+  IF (is_north_pole_dyn) kstart=2
+  IF (is_south_pole_dyn) kend=klon-1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -423,5 +423,5 @@
       i=index_i(ig0)
       j=index_j(ig0)
-      if (i==1) THEN
+      IF (i==1) THEN
         zufi(ig0,l)= 0.5 *(  pucov(iim,j,l)/cu(iim,j) &
               + pucov(1,j,l)/cu(1,j) )
@@ -440,6 +440,6 @@
   jjb=jj_begin_dyn-1
   jje=jj_end_dyn+1
-  if (is_north_pole_dyn) jjb=1
-  if (is_south_pole_dyn) jje=jjm
+  IF (is_north_pole_dyn) jjb=1
+  IF (is_south_pole_dyn) jje=jjm
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -469,5 +469,5 @@
       zvfi(ig0,l)= 0.5 *(  pvcov(i,j-1,l)/cv(i,j-1) &
             + pvcov(i,j,l)/cv(i,j) )
-      if (j==1 .OR. j==jjp1) then !  AdlC MAY 2014
+      IF (j==1 .OR. j==jjp1) then !  AdlC MAY 2014
         zrfi(ig0,l) = 0 !  AdlC MAY 2014
       else
@@ -491,5 +491,5 @@
      ! V = 1 / pi  *  integrale [ v * sin(long) * d long ]
 
-  if (is_north_pole_dyn) THEN
+  IF (is_north_pole_dyn) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l=1,llm
@@ -511,5 +511,5 @@
     ENDDO
 !$OMP END DO NOWAIT
-  endif
+  ENDIF
 
 
@@ -519,5 +519,5 @@
      ! V = 1 / pi  *  integrale [ v * sin(long) * d long ]
 
-  if (is_south_pole_dyn) THEN
+  IF (is_south_pole_dyn) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l=1,llm
@@ -538,5 +538,5 @@
     ENDDO
 !$OMP END DO NOWAIT
-  endif
+  ENDIF
 
   ! On change de grille, dynamique vers physiq, pour le flux de masse verticale
@@ -561,5 +561,5 @@
 
 !$OMP BARRIER
-  if (first_omp) THEN
+  IF (first_omp) THEN
     klon=klon_omp
 
@@ -586,5 +586,5 @@
     allocate(flxwfi_omp(klon,llm))
     first_omp=.FALSE.
-  endif
+  ENDIF
 
 
@@ -708,6 +708,6 @@
 
      jH_cur_split=jH_cur+(isplit-1) * dtvr / (daysec *nsplit_phys)
-     debut_split=debut.and.isplit==1
-     lafin_split=lafin.and.isplit==nsplit_phys
+     debut_split=debut.AND.isplit==1
+     lafin_split=lafin.AND.isplit==nsplit_phys
 
     CALL call_physiq(klon,llm,nqtot,tracers(:)%name, &
@@ -837,5 +837,5 @@
   IF (using_mpi) THEN
 
-  if (MPI_rank>0) THEN
+  IF (MPI_rank>0) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    DO l=1,llm
@@ -858,7 +858,7 @@
 !$OMP BARRIER
 
-  endif
-
-  if (MPI_rank<MPI_Size-1) THEN
+  ENDIF
+
+  IF (MPI_rank<MPI_Size-1) THEN
 !$OMP BARRIER
 
@@ -872,5 +872,5 @@
 !$OMP END MASTER
 
-  endif
+  ENDIF
 
 !$OMP BARRIER
@@ -879,11 +879,11 @@
 !$OMP MASTER
 !$OMP CRITICAL (MPI)
-  if (MPI_rank>0 .and. MPI_rank< MPI_Size-1) THEN
+  IF (MPI_rank>0 .AND. MPI_rank< MPI_Size-1) THEN
     CALL MPI_WAITALL(4,Req(1),Status,ierr)
-  else if (MPI_rank>0) THEN
+  ELSE IF (MPI_rank>0) THEN
     CALL MPI_WAITALL(2,Req(1),Status,ierr)
-  else if (MPI_rank <MPI_Size-1) THEN
+  ELSE IF (MPI_rank <MPI_Size-1) THEN
     CALL MPI_WAITALL(2,Req(3),Status,ierr)
-  endif
+  ENDIF
 !$OMP END CRITICAL (MPI)
 !$OMP END MASTER
@@ -908,5 +908,5 @@
     pdvfi(:,jj_begin,l)=0
 
-    if (.not. is_south_pole_dyn) THEN
+    IF (.NOT. is_south_pole_dyn) THEN
       pdhfi(:,jj_end:jj_end+1,l)=0
       pdqfi(:,jj_end:jj_end+1,l,:)=0
@@ -921,5 +921,5 @@
     pdpsfi(:,jj_begin)=0
 
-   if (.not. is_south_pole_dyn) THEN
+   IF (.NOT. is_south_pole_dyn) THEN
      pdpsfi(:,jj_end:jj_end+1)=0
    endif
@@ -937,6 +937,6 @@
   kend=klon
 
-  if (is_north_pole_dyn) kstart=2
-  if (is_south_pole_dyn)  kend=klon-1
+  IF (is_north_pole_dyn) kstart=2
+  IF (is_south_pole_dyn)  kend=klon-1
 
   !CDIR ON_ADB(index_i)
@@ -947,8 +947,8 @@
       j=index_j(ig0)
       pdpsfi(i,j) = zdpsrf(ig0)
-      if (i==1) pdpsfi(iip1,j) =  zdpsrf(ig0)
+      IF (i==1) pdpsfi(iip1,j) =  zdpsrf(ig0)
      enddo
 
-    if (is_north_pole_dyn) THEN
+    IF (is_north_pole_dyn) THEN
         DO i=1,iip1
           pdpsfi(i,1)    = zdpsrf(1)
@@ -956,5 +956,5 @@
     endif
 
-    if (is_south_pole_dyn) THEN
+    IF (is_south_pole_dyn) THEN
         DO i=1,iip1
           pdpsfi(i,jjp1) = zdpsrf(klon)
@@ -970,6 +970,6 @@
   kend=klon
 
-  if (is_north_pole_dyn) kstart=2
-  if (is_south_pole_dyn)  kend=klon-1
+  IF (is_north_pole_dyn) kstart=2
+  IF (is_south_pole_dyn)  kend=klon-1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -983,8 +983,8 @@
       j=index_j(ig0)
       pdhfi(i,j,l) = cpp * zdtfi(ig0,l) / ppk(i,j,l)
-      if (i==1) pdhfi(iip1,j,l) =  cpp * zdtfi(ig0,l) / ppk(i,j,l)
+      IF (i==1) pdhfi(iip1,j,l) =  cpp * zdtfi(ig0,l) / ppk(i,j,l)
      enddo
 
-    if (is_north_pole_dyn) THEN
+    IF (is_north_pole_dyn) THEN
         DO i=1,iip1
           pdhfi(i,1,l)    = cpp *  zdtfi(1,l)      / ppk(i, 1  ,l)
@@ -992,5 +992,5 @@
     endif
 
-    if (is_south_pole_dyn) THEN
+    IF (is_south_pole_dyn) THEN
         DO i=1,iip1
           pdhfi(i,jjp1,l) = cpp *  zdtfi(klon,l)/ ppk(i,jjp1,l)
@@ -1053,5 +1053,5 @@
           j=index_j(ig0)
           pdqfi(i,j,l,iq) = zdqfi(ig0,l,itr)
-          if (i==1) pdqfi(iip1,j,l,iq) = zdqfi(ig0,l,itr)
+          IF (i==1) pdqfi(iip1,j,l,iq) = zdqfi(ig0,l,itr)
         ENDDO
 
@@ -1083,9 +1083,9 @@
        j=index_j(ig0)
 
-       if (i/=iim) THEN
+       IF (i/=iim) THEN
          pdufi(i,j,l)=0.5*(zdufi2(ig0,l)+zdufi2(ig0+1,l))*cu(i,j)
        endif
 
-       if (i==1) THEN
+       IF (i==1) THEN
           pdufi(iim,j,l)=0.5*(  zdufi2(ig0,l) &
                 + zdufi2(ig0+iim-1,l))*cu(iim,j)
@@ -1095,5 +1095,5 @@
      enddo
 
-     if (is_north_pole_dyn) THEN
+     IF (is_north_pole_dyn) THEN
        DO i=1,iip1
         pdufi(i,1,l)    = 0.
@@ -1101,5 +1101,5 @@
      endif
 
-     if (is_south_pole_dyn) THEN
+     IF (is_south_pole_dyn) THEN
        DO i=1,iip1
         pdufi(i,jjp1,l) = 0.
@@ -1116,6 +1116,6 @@
   kend=klon
 
-  if (is_north_pole_dyn) kstart=2
-  if (is_south_pole_dyn)  kend=klon-1-iim
+  IF (is_north_pole_dyn) kstart=2
+  IF (is_south_pole_dyn)  kend=klon-1-iim
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -1128,5 +1128,5 @@
        j=index_j(ig0)
        pdvfi(i,j,l)=0.5*(zdvfi2(ig0,l)+zdvfi2(ig0+iim,l))*cv(i,j)
-       if (i==1) pdvfi(iip1,j,l) = 0.5*(zdvfi2(ig0,l)+ &
+       IF (i==1) pdvfi(iip1,j,l) = 0.5*(zdvfi2(ig0,l)+ &
              zdvfi2(ig0+iim,l)) &
              *cv(i,j)
@@ -1141,5 +1141,5 @@
    ! v = U * cos(long) + V * SIN(long)
 
-  if (is_north_pole_dyn) THEN
+  IF (is_north_pole_dyn) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l=1,llm
@@ -1158,7 +1158,7 @@
 !$OMP END DO NOWAIT
 
-  endif
-
-  if (is_south_pole_dyn) THEN
+  ENDIF
+
+  IF (is_south_pole_dyn) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
      DO l=1,llm
@@ -1177,5 +1177,5 @@
 !$OMP END DO NOWAIT
 
-  endif
+  ENDIF
   !-----------------------------------------------------------------------
 
Index: LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/lmdz_gr_fi_dyn_p.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/lmdz_gr_fi_dyn_p.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/lmdz_gr_fi_dyn_p.F90	(revision 5117)
@@ -27,5 +27,5 @@
         j=index_j(ig)
         pdyn(i,j,ifield)=pfi(ig,ifield)
-        if (i==1) pdyn(im,j,ifield)=pdyn(i,j,ifield)
+        IF (i==1) pdyn(im,j,ifield)=pdyn(i,j,ifield)
       ENDDO
 
Index: LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/mod_interface_dyn_phys.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/mod_interface_dyn_phys.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/mod_interface_dyn_phys.F90	(revision 5117)
@@ -3,6 +3,6 @@
 
 MODULE mod_interface_dyn_phys
-  INTEGER,SAVE,dimension(:),allocatable :: index_i
-  INTEGER,SAVE,dimension(:),allocatable :: index_j
+  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: index_i
+  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: index_j
   
   
Index: LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phydev/iniphysiq_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phydev/iniphysiq_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phydev/iniphysiq_mod.F90	(revision 5117)
@@ -18,5 +18,5 @@
   USE inifis_mod, ONLY: inifis
   USE phyaqua_mod, ONLY: iniaqua
-  USE nrtype, ONLY: pi
+  USE lmdz_physical_constants, ONLY: pi
   IMPLICIT NONE
 
Index: LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/callphysiq_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/callphysiq_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/callphysiq_mod.F90	(revision 5117)
@@ -69,7 +69,7 @@
 
   !$OMP MASTER
-  if (ok_dyn_xios) THEN
+  IF (ok_dyn_xios) THEN
      CALL xios_get_current_context(dyn3d_ctx_handle)
-  endif
+  ENDIF
   !$OMP END MASTER
 
@@ -99,7 +99,7 @@
 ! switching back to LMDZDYN context
 !$OMP MASTER
-  if (ok_dyn_xios) THEN
+  IF (ok_dyn_xios) THEN
      CALL xios_set_current_context(dyn3d_ctx_handle)
-  endif
+  ENDIF
 !$OMP END MASTER
 
Index: LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/ce0l.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/ce0l.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/ce0l.F90	(revision 5117)
@@ -73,5 +73,5 @@
 
 #ifdef CPP_PARA
-  integer ierr
+  INTEGER ierr
 #else
 ! for iniphysiq in serial mode
Index: LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/etat0dyn_netcdf.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/etat0dyn_netcdf.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/etat0dyn_netcdf.F90	(revision 5117)
@@ -39,5 +39,5 @@
   USE comvert_mod, ONLY: ap, bp, preff, pressure_exner
   USE temps_mod, ONLY: annee_ref, day_ref, itau_dyn, itau_phy, start_time
-  USE strings_mod, ONLY: strLower
+  USE lmdz_strings, ONLY: strLower
 
   IMPLICIT NONE
@@ -78,4 +78,5 @@
     USE lmdz_filtreg
     USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA
+    USE lmdz_q_sat, ONLY: q_sat
     IMPLICIT NONE
     !-------------------------------------------------------------------------------
Index: LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90	(revision 5117)
@@ -539,5 +539,5 @@
   do j=2,jmp1-1
      PRINT*,'avant if ',cos(rlatu(j)),coslat0
-     if (cos(rlatu(j))<coslat0) THEN
+     IF (cos(rlatu(j))<coslat0) THEN
          ! nb de pts affectes par le filtrage de part et d'autre du pt
          ifiltre=(coslat0/cos(rlatu(j))-1.)/2.
@@ -548,12 +548,12 @@
          wwf(ifiltre+1)=(coslat0/cos(rlatu(j))-1.)/2.-ifiltre
          do i=1,imp1-1
-            if (masque(i,j)>0.9) THEN
+            IF (masque(i,j)>0.9) THEN
                ssz=phis(i,j)
                do ifi=1,ifiltre+1
                   ii=i+ifi
-                  if (ii>imp1-1) ii=ii-imp1+1
+                  IF (ii>imp1-1) ii=ii-imp1+1
                   ssz=ssz+wwf(ifi)*phis(ii,j)
                   ii=i-ifi
-                  if (ii<1) ii=ii+imp1-1
+                  IF (ii<1) ii=ii+imp1-1
                   ssz=ssz+wwf(ifi)*phis(ii,j)
                enddo
Index: LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/limit_netcdf.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/limit_netcdf.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/limit_netcdf.f90	(revision 5117)
@@ -378,6 +378,6 @@
       REAL :: chmin, chmax, timeday, al
       INTEGER ierr, idx
-      integer n_extrap ! number of extrapolated points
-      logical skip
+      INTEGER n_extrap ! number of extrapolated points
+      LOGICAL skip
 
       !------------------------------------------------------------------------------
@@ -599,5 +599,5 @@
             CALL pchfe_95(timeyear, champtime(i, j, :), yder, skip, &
                     arth(0.5, real(ndays_in) / ndays, ndays), champan(i, j, :), ierr)
-            if (ierr < 0) CALL abort_physic("get_2Dfield", "", 1)
+            IF (ierr < 0) CALL abort_physic("get_2Dfield", "", 1)
             n_extrap = n_extrap + ierr
           END DO
Index: LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/test_disvert_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/test_disvert_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/test_disvert_m.F90	(revision 5117)
@@ -13,7 +13,7 @@
     ! the surface pressure, which sample possible values on Earth.
 
-    use exner_hyb_m, ONLY: exner_hyb
-    use lmdz_vertical_layers, ONLY: ap,bp,preff
-    use comconst_mod, ONLY: kappa, cpp
+    USE exner_hyb_m, ONLY: exner_hyb
+    USE lmdz_vertical_layers, ONLY: ap,bp,preff
+    USE comconst_mod, ONLY: kappa, cpp
     USE lmdz_abort_physic, ONLY: abort_physic
 
@@ -22,12 +22,12 @@
 
     ! Local:
-    integer l, i
-    integer, parameter:: ngrid = 7
-    real p(ngrid, llm + 1) ! pressure at half-level, in Pa
-    real pks(ngrid) ! exner function at the surface, in J K-1 kg-1 
-    real pk(ngrid, llm) ! exner function at full level, in J K-1 kg-1 
-    real ps(ngrid) ! surface pressure, in Pa
-    real p_lay(ngrid, llm) ! pressure at full level, in Pa
-    real delta_ps ! in Pa
+    INTEGER l, i
+    INTEGER, parameter:: ngrid = 7
+    REAL p(ngrid, llm + 1) ! pressure at half-level, in Pa
+    REAL pks(ngrid) ! exner function at the surface, in J K-1 kg-1
+    REAL pk(ngrid, llm) ! exner function at full level, in J K-1 kg-1
+    REAL ps(ngrid) ! surface pressure, in Pa
+    REAL p_lay(ngrid, llm) ! pressure at full level, in Pa
+    REAL delta_ps ! in Pa
 
     !---------------------
@@ -42,14 +42,14 @@
 
     ! Are pressure values in the right order?
-    if (any(p(:, :llm) <= p_lay .or. p_lay <= p(:, 2:))) THEN
+    IF (any(p(:, :llm) <= p_lay .OR. p_lay <= p(:, 2:))) THEN
        ! List details and stop:
        do l = 1, llm
           do i = 1, ngrid
-             if (p(i, l) <= p_lay(i, l)) THEN
+             IF (p(i, l) <= p_lay(i, l)) THEN
                 print 1000, "ps = ", ps(i) / 100., "hPa, p(level ",  l, &
                      ") = ", p(i, l) / 100., " hPa <= p(layer ", l, ") = ", &
                      p_lay(i, l) / 100., " hPa"
              end if
-             if (p_lay(i, l) <= p(i, l + 1)) THEN
+             IF (p_lay(i, l) <= p(i, l + 1)) THEN
                 print 1000, "ps = ", ps(i) / 100., "hPa, p(layer ", l, ") = ", &
                      p_lay(i, l) / 100., " hPa <= p(level ", l + 1, ") = ", &
Index: LMDZ6/branches/Amaury_dev/libf/filtrez/lmdz_filtreg.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/filtrez/lmdz_filtreg.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/filtrez/lmdz_filtreg.F90	(revision 5117)
@@ -78,5 +78,5 @@
     INTEGER :: sdd1_type, sdd2_type
 
-    if (iim == 1) return ! no filtre in 2D y-z
+    IF (iim == 1) return ! no filtre in 2D y-z
 
     IF (first) THEN
@@ -89,5 +89,5 @@
     ENDIF
 
-    IF(ifiltre==1.or.ifiltre==-1) &
+    IF(ifiltre==1.OR.ifiltre==-1) &
             stop 'Pas de transformee simple dans cette version'
 
@@ -425,10 +425,10 @@
     IMPLICIT NONE
     ! Arguments:
-    integer, intent(in) :: N
-    integer, intent(in) :: NP
-    integer, intent(out) :: NROT
-    real, intent(inout) :: A(NP, NP)
-    real, intent(out) :: D(NP)
-    real, intent(out) :: V(NP, NP)
+    INTEGER, INTENT(IN) :: N
+    INTEGER, INTENT(IN) :: NP
+    INTEGER, INTENT(OUT) :: NROT
+    REAL, INTENT(INOUT) :: A(NP, NP)
+    REAL, INTENT(OUT) :: D(NP)
+    REAL, INTENT(OUT) :: V(NP, NP)
 
     ! local variables:
@@ -562,5 +562,5 @@
     INTEGER :: i, j
     REAL :: sum
-    real, external :: ssum
+    REAL, external :: ssum
     do j = 1, im
       do i = 1, im
@@ -631,5 +631,5 @@
     !-----------------------------------------------------------
 
-    if (iim == 1) return ! No filtre in 2D y-z
+    IF (iim == 1) return ! No filtre in 2D y-z
 
     pi = 2. * ASIN(1.)
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_TO_MOVE_ssum_scopy.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_TO_MOVE_ssum_scopy.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_TO_MOVE_ssum_scopy.f90	(revision 5117)
@@ -7,6 +7,6 @@
   IMPLICIT NONE
 
-  integer n, incx, incy, ix, iy, i
-  real sx((n - 1) * incx + 1), sy((n - 1) * incy + 1)
+  INTEGER n, incx, incy, ix, iy, i
+  REAL sx((n - 1) * incx + 1), sy((n - 1) * incy + 1)
 
   iy = 1
@@ -24,6 +24,6 @@
   IMPLICIT NONE
 
-  integer n, incx, i, ix
-  real ssum, sx((n - 1) * incx + 1)
+  INTEGER n, incx, i, ix
+  REAL ssum, sx((n - 1) * incx + 1)
 
   ssum = 0.
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_assert.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_assert.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_assert.f90	(revision 5117)
@@ -15,5 +15,5 @@
     CHARACTER(LEN = *), INTENT(IN) :: string
     LOGICAL, INTENT(IN) :: n1
-    if (.not. n1) THEN
+    IF (.NOT. n1) THEN
       write (*, *) 'nrerror: an assertion failed with this tag:', &
               string
@@ -26,5 +26,5 @@
     CHARACTER(LEN = *), INTENT(IN) :: string
     LOGICAL, INTENT(IN) :: n1, n2
-    if (.not. (n1 .and. n2)) THEN
+    IF (.NOT. (n1 .AND. n2)) THEN
       write (*, *) 'nrerror: an assertion failed with this tag:', &
               string
@@ -37,5 +37,5 @@
     CHARACTER(LEN = *), INTENT(IN) :: string
     LOGICAL, INTENT(IN) :: n1, n2, n3
-    if (.not. (n1 .and. n2 .and. n3)) THEN
+    IF (.NOT. (n1 .AND. n2 .AND. n3)) THEN
       write (*, *) 'nrerror: an assertion failed with this tag:', &
               string
@@ -48,5 +48,5 @@
     CHARACTER(LEN = *), INTENT(IN) :: string
     LOGICAL, INTENT(IN) :: n1, n2, n3, n4
-    if (.not. (n1 .and. n2 .and. n3 .and. n4)) THEN
+    IF (.NOT. (n1 .AND. n2 .AND. n3 .AND. n4)) THEN
       write (*, *) 'nrerror: an assertion failed with this tag:', &
               string
@@ -59,5 +59,5 @@
     CHARACTER(LEN = *), INTENT(IN) :: string
     LOGICAL, DIMENSION(:), INTENT(IN) :: n
-    if (.not. all(n)) THEN
+    IF (.NOT. all(n)) THEN
       write (*, *) 'nrerror: an assertion failed with this tag:', &
               string
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_assert_eq.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_assert_eq.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_assert_eq.f90	(revision 5117)
@@ -29,5 +29,5 @@
     INTEGER, INTENT(IN) :: n1, n2, n3
     INTEGER  assert_eq3
-    IF (n1 == n2 .and. n2 == n3) THEN
+    IF (n1 == n2 .AND. n2 == n3) THEN
       assert_eq3 = n1
     ELSE
@@ -43,5 +43,5 @@
     INTEGER, INTENT(IN) :: n1, n2, n3, n4
     INTEGER  assert_eq4
-    IF (n1 == n2 .and. n2 == n3 .and. n3 == n4) THEN
+    IF (n1 == n2 .AND. n2 == n3 .AND. n3 == n4) THEN
       assert_eq4 = n1
     ELSE
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_coefpoly.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_coefpoly.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_coefpoly.f90	(revision 5117)
@@ -26,8 +26,8 @@
     ! a0, a1, a2, a3.
 
-    use nrtype, ONLY: k8
+    USE lmdz_physical_constants, ONLY: k8
 
-    REAL(K8), intent(in) :: xf1, xf2, xprim1, xprim2, xtild1, xtild2
-    REAL(K8), intent(out) :: a0, a1, a2, a3
+    REAL(K8), INTENT(IN) :: xf1, xf2, xprim1, xprim2, xtild1, xtild2
+    REAL(K8), INTENT(OUT) :: a0, a1, a2, a3
 
     ! Local:
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_formcoord.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_formcoord.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_formcoord.f90	(revision 5117)
@@ -7,5 +7,5 @@
     IMPLICIT NONE
     INTEGER :: n, unit, ndec
-    logical :: rev
+    LOGICAL :: rev
     REAL :: x(n), a
     CHARACTER(LEN = 4) :: text
@@ -27,5 +27,5 @@
     endif
 
-    if (n<2) THEN
+    IF (n<2) THEN
       ndec = 1
       WRITE(unit, 1000) text, n, x(1) * a
@@ -34,5 +34,5 @@
       do i = 2, n - 1
         dx = abs(x(i + 1) - x(i))
-        if (dx<dxmin) dxmin = dx
+        IF (dx<dxmin) dxmin = dx
       enddo
 
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_inca_wrappers.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_inca_wrappers.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_inca_wrappers.F90	(revision 5117)
@@ -9,5 +9,5 @@
 SUBROUTINE Init_chem_inca_trac(NBTR)
   IMPLICIT NONE
-  INTEGER, INTENT(out) :: nbtr
+  INTEGER, INTENT(OUT) :: nbtr
 
   CALL lmdz_inca_wrapper_abort
@@ -21,10 +21,10 @@
         vadv_flg_lmdz)
   IMPLICIT NONE
-  INTEGER, DIMENSION(:), INTENT(out) :: hadv_flg_lmdz
-  INTEGER, DIMENSION(:), INTENT(out) :: vadv_flg_lmdz
-
-  INTEGER, DIMENSION(:), INTENT(out) :: conv_flg_lmdz
-  INTEGER, DIMENSION(:), INTENT(out) :: pbl_flg_lmdz
-  CHARACTER(len = 8), DIMENSION(:), INTENT(out) :: tracnam_lmdz
+  INTEGER, DIMENSION(:), INTENT(OUT) :: hadv_flg_lmdz
+  INTEGER, DIMENSION(:), INTENT(OUT) :: vadv_flg_lmdz
+
+  INTEGER, DIMENSION(:), INTENT(OUT) :: conv_flg_lmdz
+  INTEGER, DIMENSION(:), INTENT(OUT) :: pbl_flg_lmdz
+  CHARACTER(len = 8), DIMENSION(:), INTENT(OUT) :: tracnam_lmdz
 
   CALL lmdz_inca_wrapper_abort
@@ -76,6 +76,6 @@
   IMPLICIT NONE
   REAL, INTENT(IN) :: calday
-  INTEGER, INTENT(in) :: ijour  ! jour julien
-  REAL, INTENT(in) :: gmtime ! input-R-temps universel dans la journee (0 a 86400 s)
+  INTEGER, INTENT(IN) :: ijour  ! jour julien
+  REAL, INTENT(IN) :: gmtime ! input-R-temps universel dans la journee (0 a 86400 s)
   INTEGER, INTENT(IN) :: ctop(:)
   INTEGER, INTENT(IN) :: cbot(:)
@@ -105,9 +105,9 @@
   REAL, INTENT(IN) :: cldfr (:, :)
   ! variables used in nightingale
-  REAL, INTENT(in) :: ftsol(:, :)
-  REAL, INTENT(in) :: paprs(:, :)
-  REAL, INTENT(in) :: cdragh(:), cdragm(:)
-  REAL, INTENT(in) :: pctsrf(:, :)
-  REAL, INTENT(in) :: delt               ! timestep in seconds of physics
+  REAL, INTENT(IN) :: ftsol(:, :)
+  REAL, INTENT(IN) :: paprs(:, :)
+  REAL, INTENT(IN) :: cdragh(:), cdragm(:)
+  REAL, INTENT(IN) :: pctsrf(:, :)
+  REAL, INTENT(IN) :: delt               ! timestep in seconds of physics
   INTEGER, INTENT(IN) :: nstep              ! model time step
 
@@ -148,8 +148,8 @@
 SUBROUTINE chemtime(istp, date0, dt, itap)
   IMPLICIT NONE
-  INTEGER, INTENT(in) :: istp   ! time step of the restart file
-  REAL, INTENT(in) :: date0  ! the date at which itau = 0
-  REAL, INTENT(in) :: dt     ! time step
-  INTEGER, INTENT(in) :: itap
+  INTEGER, INTENT(IN) :: istp   ! time step of the restart file
+  REAL, INTENT(IN) :: date0  ! the date at which itau = 0
+  REAL, INTENT(IN) :: dt     ! time step
+  INTEGER, INTENT(IN) :: itap
   CALL lmdz_inca_wrapper_abort
 END SUBROUTINE chemtime
@@ -165,9 +165,9 @@
         config_inca_l)
   IMPLICIT NONE
-  INTEGER, INTENT(in) :: nday_l
-  INTEGER, INTENT(in) :: nbsrf_l
-  INTEGER, INTENT(in) :: is_oce_l, is_sic_l, is_lic_l, is_ter_l
-  CHARACTER (len = 10), INTENT(in) :: calend_l
-  CHARACTER(len = 4), INTENT(in) :: config_inca_l
+  INTEGER, INTENT(IN) :: nday_l
+  INTEGER, INTENT(IN) :: nbsrf_l
+  INTEGER, INTENT(IN) :: is_oce_l, is_sic_l, is_lic_l, is_ter_l
+  CHARACTER (len = 10), INTENT(IN) :: calend_l
+  CHARACTER(len = 4), INTENT(IN) :: config_inca_l
 
   CALL lmdz_inca_wrapper_abort
@@ -217,17 +217,17 @@
   IMPLICIT NONE
   REAL, INTENT(IN) :: pmid(:, :)
-  INTEGER, INTENT(in) :: nbp_lon_lmdz, nbp_lat_lmdz
-  REAL, INTENT(in) :: calday
-  REAL, INTENT(in) :: latgcm(:)
-  REAL, INTENT(in) :: longcm(:)
-  REAL, INTENT(in) :: presnivs(:)
-  INTEGER, INTENT(in) :: klon
-  INTEGER, INTENT(in) :: nqmax  ! nombre total de traceurs = inca + lmdz
-  INTEGER, INTENT(in) :: nqo ! nombre de traceurs lus dans traceur.def
-  REAL, INTENT(in) :: pdtphys
-  INTEGER, INTENT(in) :: annee_ref, year_cur
-  INTEGER, INTENT(in) :: day_ref, day_ini
-  REAL, INTENT(in) :: start_time
-  INTEGER, INTENT(in) :: itau_phy
+  INTEGER, INTENT(IN) :: nbp_lon_lmdz, nbp_lat_lmdz
+  REAL, INTENT(IN) :: calday
+  REAL, INTENT(IN) :: latgcm(:)
+  REAL, INTENT(IN) :: longcm(:)
+  REAL, INTENT(IN) :: presnivs(:)
+  INTEGER, INTENT(IN) :: klon
+  INTEGER, INTENT(IN) :: nqmax  ! nombre total de traceurs = inca + lmdz
+  INTEGER, INTENT(IN) :: nqo ! nombre de traceurs lus dans traceur.def
+  REAL, INTENT(IN) :: pdtphys
+  INTEGER, INTENT(IN) :: annee_ref, year_cur
+  INTEGER, INTENT(IN) :: day_ref, day_ini
+  REAL, INTENT(IN) :: start_time
+  INTEGER, INTENT(IN) :: itau_phy
   REAL, OPTIONAL, INTENT(IN) :: io_lat(nbp_lat_lmdz) ! latitudes (of global grid)
   REAL, OPTIONAL, INTENT(IN) :: io_lon(nbp_lon_lmdz) ! longitudes (of global grid)
@@ -260,35 +260,35 @@
         cldtaupi, topswai_inca, solswai_inca)
   IMPLICIT NONE
-  LOGICAL, INTENT(in) :: chemistry_couple
-  INTEGER, INTENT(in) :: kdlon, kflev
-  REAL, INTENT(in) :: solaire
-  REAL, INTENT(in) :: dist
-  REAL, INTENT(in) :: rmu0(:), fract(:)
-  REAL, INTENT(in) :: paprs(:, :), pplay(:, :)
-  REAL, INTENT(in) :: albedo(:), alblw(:), tsol(:)
-  REAL, INTENT(in) :: t(:, :), q(:, :)
-  INTEGER, INTENT(in) :: size_wo
-  REAL, INTENT(in) :: wo(:, :, :)  ! column-density of ozone in a layer, in kilo-Dobsons
-  LOGICAL, INTENT(in) :: ok_ade, ok_aie     ! switches whether to use aerosol direct (indirect) effects or not
-  REAL, INTENT(in) :: cldfra(:, :), cldemi(:, :), cldtaupd(:, :)
-  REAL, INTENT(in) :: tau_inca(:, :, :, :) ! aerosol optical properties (see aeropt.F)
-  REAL, INTENT(in) :: piz_inca(:, :, :, :) ! aerosol optical properties (see aeropt.F)
-  REAL, INTENT(in) :: cg_inca(:, :, :, :)        ! aerosol optical properties (see aeropt.F)
-  REAL, INTENT(in) :: cldtaupi(:, :)  ! cloud optical thickness for pre-industrial aerosol concentrations
-  REAL, INTENT(out) :: heat(:, :), cool(:, :)
-  REAL, INTENT(out) :: heat0(:, :), cool0(:, :)
-  REAL, INTENT(out) :: topsw(:), toplw(:)
-  REAL, INTENT(out) :: solsw(:), sollw(:), albpla(:)
-  REAL, INTENT(out) :: topsw0(:), toplw0(:), solsw0(:), sollw0(:)
-  REAL, INTENT(out) :: sollwdown(:)
-  REAL, INTENT(out) :: swdn(:, :), swdn0(:, :)
-  REAL, INTENT(out) :: swup(:, :), swup0(:, :)
-  REAL, INTENT(out) :: lwdn(:, :), lwdn0(:, :)
-  REAL, INTENT(out) :: lwup(:, :), lwup0(:, :)
-  REAL, INTENT(out) :: topswad_inca(:), solswad_inca(:) ! output: aerosol direct forcing at TOA and surface
-  REAL, INTENT(out) :: topswad0_inca(:), solswad0_inca(:) ! output: aerosol direct forcing at TOA and surface
-  REAL, INTENT(out) :: topswai_inca(:), solswai_inca(:) ! output: aerosol indirect forcing atTOA and surface
-  REAL(kind = 8), INTENT(out) :: topsw_inca(:, :), topsw0_inca(:, :)
-  REAL(kind = 8), INTENT(out) :: solsw_inca(:, :), solsw0_inca(:, :)
+  LOGICAL, INTENT(IN) :: chemistry_couple
+  INTEGER, INTENT(IN) :: kdlon, kflev
+  REAL, INTENT(IN) :: solaire
+  REAL, INTENT(IN) :: dist
+  REAL, INTENT(IN) :: rmu0(:), fract(:)
+  REAL, INTENT(IN) :: paprs(:, :), pplay(:, :)
+  REAL, INTENT(IN) :: albedo(:), alblw(:), tsol(:)
+  REAL, INTENT(IN) :: t(:, :), q(:, :)
+  INTEGER, INTENT(IN) :: size_wo
+  REAL, INTENT(IN) :: wo(:, :, :)  ! column-density of ozone in a layer, in kilo-Dobsons
+  LOGICAL, INTENT(IN) :: ok_ade, ok_aie     ! switches whether to use aerosol direct (indirect) effects or not
+  REAL, INTENT(IN) :: cldfra(:, :), cldemi(:, :), cldtaupd(:, :)
+  REAL, INTENT(IN) :: tau_inca(:, :, :, :) ! aerosol optical properties (see aeropt.F)
+  REAL, INTENT(IN) :: piz_inca(:, :, :, :) ! aerosol optical properties (see aeropt.F)
+  REAL, INTENT(IN) :: cg_inca(:, :, :, :)        ! aerosol optical properties (see aeropt.F)
+  REAL, INTENT(IN) :: cldtaupi(:, :)  ! cloud optical thickness for pre-industrial aerosol concentrations
+  REAL, INTENT(OUT) :: heat(:, :), cool(:, :)
+  REAL, INTENT(OUT) :: heat0(:, :), cool0(:, :)
+  REAL, INTENT(OUT) :: topsw(:), toplw(:)
+  REAL, INTENT(OUT) :: solsw(:), sollw(:), albpla(:)
+  REAL, INTENT(OUT) :: topsw0(:), toplw0(:), solsw0(:), sollw0(:)
+  REAL, INTENT(OUT) :: sollwdown(:)
+  REAL, INTENT(OUT) :: swdn(:, :), swdn0(:, :)
+  REAL, INTENT(OUT) :: swup(:, :), swup0(:, :)
+  REAL, INTENT(OUT) :: lwdn(:, :), lwdn0(:, :)
+  REAL, INTENT(OUT) :: lwup(:, :), lwup0(:, :)
+  REAL, INTENT(OUT) :: topswad_inca(:), solswad_inca(:) ! output: aerosol direct forcing at TOA and surface
+  REAL, INTENT(OUT) :: topswad0_inca(:), solswad0_inca(:) ! output: aerosol direct forcing at TOA and surface
+  REAL, INTENT(OUT) :: topswai_inca(:), solswai_inca(:) ! output: aerosol indirect forcing atTOA and surface
+  REAL(kind = 8), INTENT(OUT) :: topsw_inca(:, :), topsw0_inca(:, :)
+  REAL(kind = 8), INTENT(OUT) :: solsw_inca(:, :), solsw0_inca(:, :)
 
   CALL lmdz_inca_wrapper_abort
@@ -304,10 +304,10 @@
 
   IMPLICIT NONE
-  INTEGER, INTENT(in) :: iim
-  INTEGER, INTENT(in) :: jjm
-  REAL, INTENT(in) :: rlonu_l(:)
-  REAL, INTENT(in) :: rlatu_l(:)
-  REAL, INTENT(in) :: rlonv_l(:)
-  REAL, INTENT(in) :: rlatv_l(:)
+  INTEGER, INTENT(IN) :: iim
+  INTEGER, INTENT(IN) :: jjm
+  REAL, INTENT(IN) :: rlonu_l(:)
+  REAL, INTENT(IN) :: rlatu_l(:)
+  REAL, INTENT(IN) :: rlonv_l(:)
+  REAL, INTENT(IN) :: rlatv_l(:)
 
   CALL lmdz_inca_wrapper_abort
@@ -319,19 +319,19 @@
         area, rlat, rlon, u10m, v10m)
   IMPLICIT NONE
-  REAL, INTENT(in) :: calday
-  REAL, INTENT(in) :: delt                ! [s]
-  REAL, INTENT(in) :: pmid(:, :)     ! [Pa]
-  REAL, INTENT(in) :: pfull(:, :)  ! [Pa]
-  REAL, INTENT(in) :: t_seri(:, :)   ! [K]
-  REAL, INTENT(in) :: flxrst(:, :) ! liquid water flux (stratiform) kgH2O/m2/s
-  REAL, INTENT(in) :: flxrcv(:, :) ! liquid  water flux (convection ) kgH2O/m2/s
-  REAL, INTENT(in) :: flxsst(:, :) ! solid  water flux (stratiform) kgH2O/m2/s
-  REAL, INTENT(in) :: flxscv(:, :) ! solid  water flux (convection) kgH2O/m2/s
-  REAL, INTENT(in) :: pctsrf(:, :)  ! subsurface fraction (0..1)
-  REAL, INTENT(in) :: area(:)          ! surface area of grid box [m2]
-  REAL, INTENT(in) :: rlon(:)          ! longitude
-  REAL, INTENT(in) :: rlat(:)          ! latitude
-  REAL, INTENT(in) :: u10m(:, :)    ! vents a 10m
-  REAL, INTENT(in) :: v10m(:, :)    ! vents a 10m
+  REAL, INTENT(IN) :: calday
+  REAL, INTENT(IN) :: delt                ! [s]
+  REAL, INTENT(IN) :: pmid(:, :)     ! [Pa]
+  REAL, INTENT(IN) :: pfull(:, :)  ! [Pa]
+  REAL, INTENT(IN) :: t_seri(:, :)   ! [K]
+  REAL, INTENT(IN) :: flxrst(:, :) ! liquid water flux (stratiform) kgH2O/m2/s
+  REAL, INTENT(IN) :: flxrcv(:, :) ! liquid  water flux (convection ) kgH2O/m2/s
+  REAL, INTENT(IN) :: flxsst(:, :) ! solid  water flux (stratiform) kgH2O/m2/s
+  REAL, INTENT(IN) :: flxscv(:, :) ! solid  water flux (convection) kgH2O/m2/s
+  REAL, INTENT(IN) :: pctsrf(:, :)  ! subsurface fraction (0..1)
+  REAL, INTENT(IN) :: area(:)          ! surface area of grid box [m2]
+  REAL, INTENT(IN) :: rlon(:)          ! longitude
+  REAL, INTENT(IN) :: rlat(:)          ! latitude
+  REAL, INTENT(IN) :: u10m(:, :)    ! vents a 10m
+  REAL, INTENT(IN) :: v10m(:, :)    ! vents a 10m
 
   CALL lmdz_inca_wrapper_abort
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_interpolation.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_interpolation.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_interpolation.f90	(revision 5117)
@@ -36,5 +36,5 @@
     do while (ju - jl > 1)
       jm = (ju + jl) / 2 ! Compute a midpoint,
-      if (ascnd .eqv. (x >= xx(jm))) THEN
+      IF (ascnd .eqv. (x >= xx(jm))) THEN
         jl = jm ! and replace either the lower limit
       else
@@ -44,12 +44,12 @@
     ! {ju == jl + 1}
 
-    ! {(ascnd .and. xx(jl) <= x < xx(jl+1)) 
+    ! {(ascnd .AND. xx(jl) <= x < xx(jl+1))
     !  .neqv. 
-    !  (.not. ascnd .and. xx(jl+1) <= x < xx(jl))}
+    !  (.NOT. ascnd .AND. xx(jl+1) <= x < xx(jl))}
 
     ! Then set the output, being careful with the endpoints:
-    if (x == xx(1)) THEN
+    IF (x == xx(1)) THEN
       locate = 1
-    else if (x == xx(n)) THEN
+    ELSE IF (x == xx(n)) THEN
       locate = n - 1
     else
@@ -81,5 +81,5 @@
     ascnd = (xx(n) >= xx(1))
     ! (True if ascending order of table, false otherwise.)
-    if (jlo < 0 .or. jlo > n) THEN
+    IF (jlo < 0 .OR. jlo > n) THEN
       ! Input guess not useful. Go immediately to bisection.
       jlo = 0
@@ -87,17 +87,17 @@
     else
       inc = 1 ! Set the hunting increment.
-      if (jlo == 0) THEN
+      IF (jlo == 0) THEN
         hunt_up = .TRUE.
       else
         hunt_up = x >= xx(jlo) .eqv. ascnd
       end if
-      if (hunt_up) then ! Hunt up:
-        do
+      IF (hunt_up) then ! Hunt up:
+        DO
           jhi = jlo + inc
-          if (jhi > n) then ! Done hunting, since off end of table.
+          IF (jhi > n) then ! Done hunting, since off end of table.
             jhi = n + 1
             exit
           else
-            if (x < xx(jhi) .eqv. ascnd) exit
+            IF (x < xx(jhi) .eqv. ascnd) exit
             jlo = jhi ! Not done hunting,
             inc = inc + inc ! so double the increment
@@ -106,11 +106,11 @@
       else ! Hunt down:
         jhi = jlo
-        do
+        DO
           jlo = jhi - inc
-          if (jlo < 1) then ! Done hunting, since off end of table.
+          IF (jlo < 1) then ! Done hunting, since off end of table.
             jlo = 0
             exit
           else
-            if (x >= xx(jlo) .eqv. ascnd) exit
+            IF (x >= xx(jlo) .eqv. ascnd) exit
             jhi = jlo ! Not done hunting,
             inc = inc + inc ! so double the increment
@@ -121,11 +121,11 @@
 
     do ! Hunt is done, so begin the final bisection phase:
-      if (jhi - jlo <= 1) THEN
-        if (x == xx(n)) jlo = n - 1
-        if (x == xx(1)) jlo = 1
+      IF (jhi - jlo <= 1) THEN
+        IF (x == xx(n)) jlo = n - 1
+        IF (x == xx(1)) jlo = 1
         exit
       else
         jm = (jhi + jlo) / 2
-        if (x >= xx(jm) .eqv. ascnd) THEN
+        IF (x >= xx(jm) .eqv. ascnd) THEN
           jlo = jm
         else
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_libmath_pch.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_libmath_pch.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_libmath_pch.f90	(revision 5117)
@@ -222,5 +222,5 @@
     !       (Error return if  INCFD.LT.1 .)
     !
-    ! SKIP -- (input/output) logical variable which should be set to
+    ! SKIP -- (input/output) LOGICAL variable which should be set to
     !       .TRUE. if the user wishes to skip checks for validity of
     !       preceding parameters, or to .FALSE. otherwise.
@@ -489,16 +489,16 @@
     ! the points  XE.
 
-    use lmdz_assert_eq, ONLY: assert_eq
-
-    REAL, intent(in) :: X(:) ! real array of independent variable values
+    USE lmdz_assert_eq, ONLY: assert_eq
+
+    REAL, INTENT(IN) :: X(:) ! real array of independent variable values
     ! The elements of X must be strictly increasing.
 
-    REAL, intent(in) :: F(:) ! real array of function values
+    REAL, INTENT(IN) :: F(:) ! real array of function values
     ! F(I) is the value corresponding to X(I).
 
-    REAL, intent(in) :: D(:) ! real array of derivative values
+    REAL, INTENT(IN) :: D(:) ! real array of derivative values
     ! D(I) is the value corresponding to X(I).
 
-    LOGICAL, intent(inout) :: SKIP
+    LOGICAL, INTENT(INOUT) :: SKIP
     ! request to skip checks for validity of "x"
     ! If "skip" is false then "pchfe" will check that size(x) >= 2 and
@@ -508,5 +508,5 @@
     ! "SKIP" will be set to TRUE on normal return.
 
-    real, intent(in) :: XE(:) ! points at which the function is to be evaluated
+    REAL, INTENT(IN) :: XE(:) ! points at which the function is to be evaluated
     ! NOTES:
     ! 1. The evaluation will be most efficient if the elements of XE
@@ -518,8 +518,8 @@
     ! error is returned.
 
-    real, intent(out) :: FE(:) ! values of the cubic Hermite function
+    REAL, INTENT(OUT) :: FE(:) ! values of the cubic Hermite function
     ! defined by X, F, D at the points XE
 
-    integer, intent(out) :: IERR ! error flag
+    INTEGER, INTENT(OUT) :: IERR ! error flag
     ! Normal return:
     ! IERR = 0  no error
@@ -572,7 +572,7 @@
     ! 2001, pages 43-47
 
-    use lmdz_assert_eq, ONLY: assert_eq
-
-    real, intent(in) :: x(:)
+    USE lmdz_assert_eq, ONLY: assert_eq
+
+    REAL, INTENT(IN) :: x(:)
     ! independent variable values
     ! The elements of X must be strictly increasing:
@@ -581,9 +581,9 @@
     ! (error if size(x) < 2)
 
-    real, intent(in) :: f(:)
+    REAL, INTENT(IN) :: f(:)
     !     dependent variable values to be interpolated
     !  F(I) is value corresponding to X(I).
 
-    INTEGER, intent(in) :: ibeg
+    INTEGER, INTENT(IN) :: ibeg
     !     desired boundary condition at beginning of data
 
@@ -604,5 +604,5 @@
     !              VC_BEG=0.
 
-    INTEGER, intent(in) :: iend
+    INTEGER, INTENT(IN) :: iend
     !           IC(2) = IEND, desired condition at end of data.
     !  IEND may take on the same values as IBEG, but applied to
@@ -614,13 +614,13 @@
     !              VC_END=0.
 
-    REAL, intent(in), optional :: vc_beg
+    REAL, INTENT(IN), optional :: vc_beg
     ! desired boundary value, as indicated above.
     !           VC_BEG need be set only if IBEG = 1 or 2 .
 
-    REAL, intent(in), optional :: vc_end
+    REAL, INTENT(IN), optional :: vc_end
     ! desired boundary value, as indicated above.
     !           VC_END need be set only if Iend = 1 or 2 .
 
-    real pchsp_95(size(x))
+    REAL pchsp_95(size(x))
     ! derivative values at the data points
     !           These values will determine the cubic spline interpolant
@@ -630,25 +630,25 @@
 
     ! LOCAL VARIABLES:
-    real wk(2, size(x)) ! real array of working storage
+    REAL wk(2, size(x)) ! real array of working storage
     INTEGER n ! number of data points
-    integer ierr, ic(2)
-    real vc(2)
+    INTEGER ierr, ic(2)
+    REAL vc(2)
 
     !-------------------------------------------------------------------
 
     n = assert_eq(size(x), size(f), "pchsp_95 n")
-    if ((ibeg == 1 .or. ibeg == 2) .and. .not. present(vc_beg)) THEN
+    IF ((ibeg == 1 .OR. ibeg == 2) .AND. .NOT. present(vc_beg)) THEN
       print *, "vc_beg required for IBEG = 1 or 2"
       stop 1
     end if
-    if ((iend == 1 .or. iend == 2) .and. .not. present(vc_end)) THEN
+    IF ((iend == 1 .OR. iend == 2) .AND. .NOT. present(vc_end)) THEN
       print *, "vc_end required for IEND = 1 or 2"
       stop 1
     end if
     ic = (/ibeg, iend/)
-    if (present(vc_beg)) vc(1) = vc_beg
-    if (present(vc_end)) vc(2) = vc_end
+    IF (present(vc_beg)) vc(1) = vc_beg
+    IF (present(vc_end)) vc(2) = vc_end
     CALL PCHSP(IC, VC, N, X, F, pchsp_95, 1, WK, size(WK), IERR)
-    if (ierr /= 0) stop 1
+    IF (ierr /= 0) stop 1
 
   END FUNCTION pchsp_95
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_new_unit.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_new_unit.f90	(revision 5117)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_new_unit.f90	(revision 5117)
@@ -0,0 +1,22 @@
+module lmdz_new_unit
+
+  IMPLICIT NONE
+
+contains
+
+  ! Returns an existing unit id that isn't already opened
+  SUBROUTINE new_unit(unit)
+    INTEGER, INTENT(OUT):: unit
+
+    LOGICAL opened, exist
+
+    unit = 0
+    DO
+       INQUIRE(unit=unit, opened=opened, exist=exist)
+       IF (exist .AND. .NOT. opened) RETURN
+       unit = unit + 1
+    END DO
+
+  END SUBROUTINE  new_unit
+
+end module lmdz_new_unit
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_physical_constants.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_physical_constants.f90	(revision 5117)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_physical_constants.f90	(revision 5117)
@@ -0,0 +1,22 @@
+MODULE lmdz_physical_constants
+
+  IMPLICIT NONE
+
+  INTEGER, parameter :: k8 = selected_real_kind(13)
+
+  ! Frequently used mathematical constants (with precision to spare):
+
+  REAL, PARAMETER :: PI = 3.141592653589793238462643383279502884197
+  REAL, PARAMETER :: PIO2 = 1.57079632679489661923132169163975144209858
+  REAL, PARAMETER :: TWOPI = 6.283185307179586476925286766559005768394
+  REAL, PARAMETER :: SQRT2 = 1.41421356237309504880168872420969807856967
+  REAL, PARAMETER :: EULER = 0.5772156649015328606065120900824024310422
+
+  REAL(K8), PARAMETER :: &
+          PI_D = 3.141592653589793238462643383279502884197_k8
+  REAL(K8), PARAMETER :: &
+          PIO2_D = 1.57079632679489661923132169163975144209858_k8
+  REAL(K8), PARAMETER :: &
+          TWOPI_D = 6.283185307179586476925286766559005768394_k8
+
+END MODULE lmdz_physical_constants
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_pres2lev.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_pres2lev.f90	(revision 5117)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_pres2lev.f90	(revision 5117)
@@ -0,0 +1,81 @@
+! $Id: pres2lev.F 1179 2009-06-11 14:18:47Z jghattas $
+
+MODULE lmdz_pres2lev
+  IMPLICIT NONE; PRIVATE
+  PUBLIC pres2lev
+
+CONTAINS
+
+  !******************************************************
+  SUBROUTINE pres2lev(varo, varn, lmo, lmn, po, pn, ni, nj, ok_invertp)
+
+    ! interpolation lineaire pour passer
+    ! a une nouvelle discretisation verticale pour
+    ! les variables de GCM
+    ! Francois Forget (01/1995)
+    ! MOdif remy roca 12/97 pour passer de pres2sig
+    ! Modif F.Codron 07/08 po en 3D
+    !**********************************************************
+
+    IMPLICIT NONE
+
+    !   Declarations:
+    ! ==============
+
+    !  ARGUMENTS
+    !  """""""""
+    LOGICAL, INTENT(IN) :: ok_invertp
+    INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches
+    INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
+
+    INTEGER, INTENT(IN) :: ni, nj ! nombre de point horizontal
+    REAL, INTENT(IN) :: po(ni * nj, lmo) ! niveau de pression ancienne grille
+    REAL, INTENT(IN) :: pn(ni * nj, lmn) ! niveau de pression nouvelle grille
+
+    REAL, INTENT(IN) :: varo(ni * nj, lmo) ! var dans l'ancienne grille
+    REAL, INTENT(OUT) :: varn(ni * nj, lmn) ! var dans la nouvelle grille
+
+    REAL :: zvaro(ni * nj, lmo), zpo(ni * nj, lmo)
+
+    ! Autres variables
+    ! """"""""""""""""
+    INTEGER :: ln, lo, k
+    REAL :: coef
+
+
+    ! Inversion de l'ordre des niveaux verticaux
+    IF (ok_invertp) THEN
+      DO lo = 1, lmo
+        DO k = 1, ni * nj
+          zpo(k, lo) = po(k, lmo + 1 - lo)
+          zvaro(k, lo) = varo(k, lmo + 1 - lo)
+        ENDDO
+      ENDDO
+    ELSE
+      DO lo = 1, lmo
+        DO k = 1, ni * nj
+          zpo(k, lo) = po(k, lo)
+          zvaro(k, lo) = varo(k, lo)
+        ENDDO
+      ENDDO
+    ENDIF
+
+    DO ln = 1, lmn
+      DO lo = 1, lmo - 1
+        DO k = 1, ni * nj
+          IF (pn(k, ln) >= zpo(k, 1)) THEN
+            varn(k, ln) = zvaro(k, 1)
+          ELSE IF (pn(k, ln) <= zpo(k, lmo)) THEN
+            varn(k, ln) = zvaro(k, lmo)
+          ELSE IF (pn(k, ln) <= zpo(k, lo) .AND. pn(k, ln) > zpo(k, lo + 1)) THEN
+            coef = (pn(k, ln) - zpo(k, lo)) / (zpo(k, lo + 1) - zpo(k, lo))
+            varn(k, ln) = zvaro(k, lo) + coef * (zvaro(k, lo + 1) - zvaro(k, lo))
+          ENDIF
+
+        ENDDO
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE pres2lev
+
+END MODULE lmdz_pres2lev
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_q_sat.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_q_sat.f90	(revision 5117)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_q_sat.f90	(revision 5117)
@@ -0,0 +1,70 @@
+! $Header$
+
+MODULE lmdz_q_sat
+  IMPLICIT NONE; PRIVATE
+  PUBLIC q_sat
+CONTAINS
+  SUBROUTINE q_sat(np, temp, pres, qsat)
+
+    IMPLICIT NONE
+    !======================================================================
+    ! Autheur(s): Z.X. Li (LMD/CNRS)
+    !  reecriture vectorisee par F. Hourdin.
+    ! Objet: calculer la vapeur d'eau saturante (formule Centre Euro.)
+    !======================================================================
+    ! Arguments:
+    ! kelvin---input-R: temperature en Kelvin
+    ! millibar--input-R: pression en mb
+
+    ! q_sat----output-R: vapeur d'eau saturante en kg/kg
+    !======================================================================
+
+    INTEGER :: np
+    REAL :: temp(np), pres(np), qsat(np)
+
+    REAL :: r2es
+    PARAMETER (r2es = 611.14 * 18.0153 / 28.9644)
+
+    REAL :: r3les, r3ies, r3es
+    PARAMETER (R3LES = 17.269)
+    PARAMETER (R3IES = 21.875)
+
+    REAL :: r4les, r4ies, r4es
+    PARAMETER (R4LES = 35.86)
+    PARAMETER (R4IES = 7.66)
+
+    REAL :: rtt
+    PARAMETER (rtt = 273.16)
+
+    REAL :: retv
+    PARAMETER (retv = 28.9644 / 18.0153 - 1.0)
+
+    REAL :: zqsat
+    INTEGER :: ip
+
+    ! ------------------------------------------------------------------
+
+    do ip = 1, np
+
+      ! WRITE(*,*)'kelvin,millibar=',kelvin,millibar
+      !  WRITE(*,*)'temp,pres=',temp(ip),pres(ip)
+
+      IF (temp(ip) <= rtt) THEN
+        r3es = r3ies
+        r4es = r4ies
+      ELSE
+        r3es = r3les
+        r4es = r4les
+      END IF
+
+      zqsat = r2es / pres(ip) * EXP(r3es * (temp(ip) - rtt) / (temp(ip) - r4es))
+      zqsat = MIN(0.5, ZQSAT)
+      zqsat = zqsat / (1. - retv * zqsat)
+
+      qsat(ip) = zqsat
+      ! WRITE(*,*)'qsat=',qsat(ip)
+
+    END DO
+
+  END SUBROUTINE q_sat
+END MODULE lmdz_q_sat
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_ran1.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_ran1.f90	(revision 5117)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_ran1.f90	(revision 5117)
@@ -0,0 +1,43 @@
+! $Id$
+
+MODULE lmdz_ran1
+  IMPLICIT NONE; PRIVATE
+  PUBLIC ran1
+CONTAINS
+
+  FUNCTION RAN1(IDUM)
+    IMPLICIT NONE
+    REAL :: RAN1
+    REAL, SAVE :: R(97)
+    REAL, PARAMETER :: RM1 = 3.8580247E-6, RM2 = 7.4373773E-6
+    INTEGER, SAVE :: IFF = 0
+    INTEGER, save :: ix1, ix2, ix3
+    INTEGER, PARAMETER :: M1 = 259200, IA1 = 7141, IC1 = 54773
+    INTEGER, PARAMETER :: M2 = 134456, IA2 = 8121, IC2 = 28411
+    INTEGER, PARAMETER :: M3 = 243000, IA3 = 4561, IC3 = 51349
+    INTEGER :: IDUM, J
+
+    IF (IDUM<0.OR.IFF==0) THEN
+      IFF = 1
+      IX1 = MOD(IC1 - IDUM, M1)
+      IX1 = MOD(IA1 * IX1 + IC1, M1)
+      IX2 = MOD(IX1, M2)
+      IX1 = MOD(IA1 * IX1 + IC1, M1)
+      IX3 = MOD(IX1, M3)
+      DO J = 1, 97
+        IX1 = MOD(IA1 * IX1 + IC1, M1)
+        IX2 = MOD(IA2 * IX2 + IC2, M2)
+        R(J) = (REAL(IX1) + REAL(IX2) * RM2) * RM1
+      END DO
+      IDUM = 1
+    ENDIF
+    IX1 = MOD(IA1 * IX1 + IC1, M1)
+    IX2 = MOD(IA2 * IX2 + IC2, M2)
+    IX3 = MOD(IA3 * IX3 + IC3, M3)
+    J = 1 + (97 * IX3) / M3
+    IF(J>97.OR.J<1) stop 1
+    RAN1 = R(J)
+    R(J) = (REAL(IX1) + REAL(IX2) * RM2) * RM1
+
+  END FUNCTION RAN1
+END MODULE lmdz_ran1
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_readTracFiles.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_readTracFiles.f90	(revision 5117)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_readTracFiles.f90	(revision 5117)
@@ -0,0 +1,2802 @@
+MODULE lmdz_readTracFiles
+
+  USE lmdz_strings, ONLY: msg, find, get_in, dispTable, strHead, strReduce, strFind, strStack, strIdx, &
+          removeComment, cat, fmsg, maxlen, checkList, strParse, strReplace, strTail, strCount, reduceExpr, &
+          int2str, str2int, real2str, str2real, bool2str, str2bool
+
+  IMPLICIT NONE; PRIVATE
+
+  PUBLIC :: maxlen                                              !--- PARAMETER FOR CASUAL STRING LENGTH
+  PUBLIC :: trac_type, tracers, setGeneration, indexUpdate      !--- TRACERS  DESCRIPTION DATABASE + ASSOCIATED TOOLS
+  PUBLIC :: testTracersFiles, readTracersFiles                  !--- TRACERS FILES READING ROUTINES
+  PUBLIC :: getKeysDBase, setKeysDBase                          !--- TOOLS TO GET/SET THE DATABASE (tracers & isotopes)
+  PUBLIC :: addTracer, delTracer                                !--- ADD/REMOVE A TRACER FROM
+  PUBLIC :: addKey, delKey, getKey, keys_type          !--- TOOLS TO SET/DEL/GET KEYS FROM/TO  tracers & isotopes
+  PUBLIC :: addPhase, delPhase, getPhase, getiPhase, &      !--- FUNCTIONS RELATED TO THE PHASES
+          nphases, old_phases, phases_sep, known_phases, phases_names  !--- + ASSOCIATED VARIABLES
+
+  PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O        !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def)
+  PUBLIC :: oldHNO3, newHNO3                                  !--- HNO3 REPRO   BACKWARD COMPATIBILITY (OLD start.nc)
+
+  PUBLIC :: tran0                                               !--- TRANSPORTING FLUID (USUALLY air)
+
+  !=== FOR ISOTOPES: GENERAL
+  PUBLIC :: isot_type, processIsotopes, isoSelect, ixIso, nbIso !--- PROCESS [AND READ] & SELECT ISOTOPES + CLASS IDX & NUMBER
+
+  !=== FOR ISOTOPES: H2O FAMILY ONLY
+  PUBLIC :: iH2O
+
+  !=== FOR ISOTOPES: DEPENDING ON THE SELECTED ISOTOPES CLASS
+  PUBLIC :: isotope, isoKeys                                    !--- SELECTED ISOTOPES DATABASE + ASSOCIATED KEYS
+  PUBLIC :: isoName, isoZone, isoPhas                           !--- ISOTOPES AND TAGGING ZONES NAMES AND PHASES
+  PUBLIC :: niso, nzone, nphas, ntiso                    !---  " " NUMBERS + ISOTOPES AND TAGGING TRACERS NUMBERS
+  PUBLIC :: itZonIso                                            !--- Idx IN isoName(1:niso) = f(tagging idx, isotope idx)
+  PUBLIC :: iqIsoPha                                            !--- Idx IN qx(1:nqtot)     = f(isotope idx,   phase idx)
+  PUBLIC :: iqWIsoPha                                           !--- Idx IN qx(1:nqtot)     = f(isotope idx,   phase idx) but with normal water first
+  PUBLIC :: isoCheck                                            !--- FLAG TO RUN ISOTOPES CHECKING ROUTINES
+
+  PUBLIC :: maxTableWidth
+  !------------------------------------------------------------------------------------------------------------------------------
+  TYPE :: keys_type                                             !=== TYPE FOR A SET OF KEYS ASSOCIATED TO AN ELEMENT
+    CHARACTER(LEN = maxlen) :: name                  !--- Tracer name
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: key(:)                !--- Keys string list
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: val(:)                !--- Corresponding values string list
+  END TYPE keys_type
+  !------------------------------------------------------------------------------------------------------------------------------
+  TYPE :: trac_type                                             !=== TYPE FOR A SINGLE TRACER NAMED "name"
+    CHARACTER(LEN = maxlen) :: name = ''                   !--- Name of the tracer
+    TYPE(keys_type) :: keys                               !--- <key>=<val> pairs vector
+    CHARACTER(LEN = maxlen) :: gen0Name = ''                   !--- First generation ancestor name
+    CHARACTER(LEN = maxlen) :: parent = ''                   !--- Parent name
+    CHARACTER(LEN = maxlen) :: longName = ''                   !--- Long name (with advection scheme suffix)
+    CHARACTER(LEN = maxlen) :: type = 'tracer'             !--- Type  (so far: 'tracer' / 'tag')
+    CHARACTER(LEN = maxlen) :: phase = 'g'                  !--- Phase ('g'as / 'l'iquid / 's'olid)
+    CHARACTER(LEN = maxlen) :: component = ''                   !--- Coma-separated list of components (Ex: lmdz,inca)
+    INTEGER :: iGeneration = -1                   !--- Generation number (>=0)
+    INTEGER :: iqParent = 0                    !--- Parent index
+    INTEGER, ALLOCATABLE :: iqDescen(:)                        !--- Descendants index (in growing generation order)
+    INTEGER :: nqDescen = 0                    !--- Number of descendants (all generations)
+    INTEGER :: nqChildren = 0                    !--- Number of children  (first generation)
+    INTEGER :: iadv = 10                   !--- Advection scheme used
+    LOGICAL :: isAdvected = .FALSE.              !--- "true" tracers: iadv > 0.   COUNT(isAdvected )=nqtrue
+    LOGICAL :: isInPhysics = .TRUE.               !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr
+    INTEGER :: iso_iGroup = 0                    !--- Isotopes group index in isotopes(:)
+    INTEGER :: iso_iName = 0                    !--- Isotope  name  index in isotopes(iso_iGroup)%trac(:)
+    INTEGER :: iso_iZone = 0                    !--- Isotope  zone  index in isotopes(iso_iGroup)%zone(:)
+    INTEGER :: iso_iPhase = 0                    !--- Isotope  phase index in isotopes(iso_iGroup)%phase
+  END TYPE trac_type
+  !------------------------------------------------------------------------------------------------------------------------------
+  TYPE :: isot_type                                             !=== TYPE FOR AN ISOTOPES FAMILY DESCENDING ON TRACER "parent"
+    CHARACTER(LEN = maxlen) :: parent                !--- Isotopes family name (parent tracer name ; ex: H2O)
+    TYPE(keys_type), ALLOCATABLE :: keys(:)               !--- Isotopes keys/values pairs list     (length: niso)
+    LOGICAL :: check = .FALSE.         !--- Flag for checking routines triggering
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: trac(:)               !--- Isotopes + tagging tracers list     (length: ntiso)
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: zone(:)               !--- Geographic tagging zones names list (length: nzone)
+    CHARACTER(LEN = maxlen) :: phase = 'g'           !--- Phases list: [g][l][s]              (length: nphas)
+    INTEGER :: niso = 0             !--- Number of isotopes, excluding tagging tracers
+    INTEGER :: ntiso = 0             !--- Number of isotopes, including tagging tracers
+    INTEGER :: nzone = 0             !--- Number of geographic tagging zones
+    INTEGER :: nphas = 0             !--- Number of phases
+    INTEGER, ALLOCATABLE :: iqIsoPha(:, :)         !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso),phas)
+    !---        (former name: "iqiso"
+    INTEGER, ALLOCATABLE :: iqWIsoPha(:, :)        !--- Idx in "tracers(1:nqtot)" = f([H2O,name(1:ntiso)],phas)
+    INTEGER, ALLOCATABLE :: itZonIso(:, :)         !--- Idx in "trac(1:ntiso)" = f(zone, name(1:niso))
+  END TYPE isot_type                                            !---        (former name: "index_trac")
+  !------------------------------------------------------------------------------------------------------------------------------
+  TYPE :: dataBase_type                                         !=== TYPE FOR TRACERS SECTION
+    CHARACTER(LEN = maxlen) :: name                               !--- Section name
+    TYPE(trac_type), ALLOCATABLE :: trac(:)                     !--- Tracers descriptors
+  END TYPE dataBase_type
+  !------------------------------------------------------------------------------------------------------------------------------
+  INTERFACE getKey
+    MODULE PROCEDURE &
+            getKeyByIndex_s111, getKeyByIndex_sm11, getKeyByIndex_s1m1, getKeyByIndex_smm1, getKeyByIndex_s1mm, getKeyByIndex_smmm, &
+            getKeyByIndex_i111, getKeyByIndex_im11, getKeyByIndex_i1m1, getKeyByIndex_imm1, getKeyByIndex_i1mm, getKeyByIndex_immm, &
+            getKeyByIndex_r111, getKeyByIndex_rm11, getKeyByIndex_r1m1, getKeyByIndex_rmm1, getKeyByIndex_r1mm, getKeyByIndex_rmmm, &
+            getKeyByIndex_l111, getKeyByIndex_lm11, getKeyByIndex_l1m1, getKeyByIndex_lmm1, getKeyByIndex_l1mm, getKeyByIndex_lmmm, &
+            getKeyByName_s111, getKeyByName_sm11, getKeyByName_s1m1, getKeyByName_smm1, getKeyByName_s1mm, getKeyByName_smmm, &
+            getKeyByName_i111, getKeyByName_im11, getKeyByName_i1m1, getKeyByName_imm1, getKeyByName_i1mm, getKeyByName_immm, &
+            getKeyByName_r111, getKeyByName_rm11, getKeyByName_r1m1, getKeyByName_rmm1, getKeyByName_r1mm, getKeyByName_rmmm, &
+            getKeyByName_l111, getKeyByName_lm11, getKeyByName_l1m1, getKeyByName_lmm1, getKeyByName_l1mm, getKeyByName_lmmm
+  END INTERFACE getKey
+  !------------------------------------------------------------------------------------------------------------------------------
+  INTERFACE addKey
+    MODULE PROCEDURE addKey_s11, addKey_s1m, addKey_smm, addKey_i11, addKey_i1m, addKey_imm, &
+            addKey_r11, addKey_r1m, addKey_rmm, addKey_l11, addKey_l1m, addKey_lmm
+  END INTERFACE addKey
+  !------------------------------------------------------------------------------------------------------------------------------
+  INTERFACE     isoSelect; MODULE PROCEDURE  isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect
+  INTERFACE    old2newH2O; MODULE PROCEDURE  old2newH2O_1, old2newH2O_m;        END INTERFACE old2newH2O
+  INTERFACE    new2oldH2O; MODULE PROCEDURE  new2oldH2O_1, new2oldH2O_m;        END INTERFACE new2oldH2O
+  INTERFACE     addTracer; MODULE PROCEDURE   addTracer_1, addTracer_1def;       END INTERFACE addTracer
+  INTERFACE     delTracer; MODULE PROCEDURE   delTracer_1, delTracer_1def;       END INTERFACE delTracer
+  INTERFACE      addPhase; MODULE PROCEDURE   addPhase_s1, addPhase_sm, addPhase_i1, addPhase_im; END INTERFACE addPhase
+  INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx, trSubset_Name, trSubset_gen0Name; END INTERFACE tracersSubset
+  !------------------------------------------------------------------------------------------------------------------------------
+
+  !=== MAIN DATABASE: files sections descriptors
+  TYPE(dataBase_type), SAVE, ALLOCATABLE, TARGET :: dBase(:)
+
+  !--- SOME PARAMETERS THAT ARE NOT LIKELY TO CHANGE OFTEN
+  CHARACTER(LEN = maxlen), SAVE :: tran0 = 'air'      !--- Default transporting fluid
+  CHARACTER(LEN = maxlen), PARAMETER :: old_phases = 'vlirb'    !--- Old phases for water (no separator)
+  CHARACTER(LEN = maxlen), PARAMETER :: known_phases = 'glsrb'    !--- Known phases initials
+  INTEGER, PARAMETER :: nphases = LEN_TRIM(known_phases)        !--- Number of phases
+  CHARACTER(LEN = maxlen), SAVE :: phases_names(nphases) &   !--- Known phases names
+          = ['gaseous  ', 'liquid   ', 'solid    ', 'cloud    ', 'blownSnow']
+  CHARACTER(LEN = 1), SAVE :: phases_sep = '_'             !--- Phase separator
+  CHARACTER(LEN = maxlen), SAVE :: isoFile = 'isotopes_params.def'!--- Name of the isotopes parameters file
+
+  !--- CORRESPONDANCE BETWEEN OLD AND NEW WATER NAMES
+  CHARACTER(LEN = maxlen), SAVE :: oldH2OIso(5) = ['eau', 'HDO', 'O18', 'O17', 'HTO'  ]
+  CHARACTER(LEN = maxlen), SAVE :: newH2OIso(5) = ['H216O', 'HDO  ', 'H218O', 'H217O', 'HTO  ']
+
+  !--- CORRESPONDANCE BETWEEN OLD AND NEW HNO3 RELATED SPECIES NAMES (FOR REPROBUS)
+  CHARACTER(LEN = maxlen), SAVE :: oldHNO3(2) = ['HNO3_g ', 'HNO3   ']
+  CHARACTER(LEN = maxlen), SAVE :: newHNO3(2) = ['HNO3   ', 'HNO3tot']
+
+  !=== TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey
+  TYPE(trac_type), ALLOCATABLE, TARGET, SAVE :: tracers(:)
+  TYPE(isot_type), ALLOCATABLE, TARGET, SAVE :: isotopes(:)
+
+  !=== ALIASES OF VARIABLES FROM SELECTED ISOTOPES FAMILY EMBEDDED IN "isotope" (isotopes(ixIso))
+  TYPE(isot_type), SAVE, POINTER :: isotope             !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
+  INTEGER, SAVE :: ixIso, iH2O = 0       !--- Index of the selected isotopes family and H2O family
+  INTEGER, SAVE :: nbIso               !--- Number of isotopes classes
+  LOGICAL, SAVE :: isoCheck            !--- Flag to trigger the checking routines
+  TYPE(keys_type), SAVE, POINTER :: isoKeys(:)          !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
+  CHARACTER(LEN = maxlen), SAVE, POINTER :: isoName(:), &     !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
+          isoZone(:), &     !--- TAGGING ZONES  FOR THE CURRENTLY SELECTED FAMILY
+          isoPhas             !--- USED PHASES    FOR THE CURRENTLY SELECTED FAMILY
+  INTEGER, SAVE :: niso, nzone, &     !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
+          nphas, ntiso        !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
+  INTEGER, SAVE, POINTER :: itZonIso(:, :), &     !--- INDEX IN "isoTrac" AS f(tagging zone idx,  isotope idx)
+          iqIsoPha(:, :), &     !--- INDEX IN "qx" AS f(isotopic tracer idx, phase idx)
+          iqWIsoPha(:, :)       !--- INDEX IN "qx" AS f(H2O + isotopic tracer idx, phase idx)
+
+  !=== PARAMETERS FOR DEFAULT BEHAVIOUR
+  LOGICAL, PARAMETER :: lTracsMerge = .FALSE.                   !--- Merge/stack tracers lists
+  LOGICAL, PARAMETER :: lSortByGen = .TRUE.                    !--- Sort by growing generation
+
+  INTEGER, PARAMETER :: maxTableWidth = 192                  !--- Maximum width of a table displayed with "dispTable"
+  CHARACTER(LEN = maxlen) :: modname
+
+CONTAINS
+
+  !==============================================================================================================================
+  !==============================================================================================================================
+  !=== READ ONE OR SEVERAL TRACER FILES AND FILL A "tr" TRACERS DESCRIPTOR DERIVED TYPE.
+  !=== THE RETURNED VALUE fType DEPENDS ON WHAT IS FOUND:
+  !===  0: NO ADEQUATE FILE FOUND ; DEFAULT VALUES MUST BE USED
+  !===  1: AN "OLD STYLE" TRACERS FILE "traceur.def":
+  !===    First line: <nb tracers>     Other lines: <hadv> <vadv> <tracer name> [<parent name>]
+  !===  2: A  "NEW STYLE" TRACERS FILE  "tracer.def" WITH SEVERAL SECTIONS.
+  !===  3: SEVERAL  "  "  TRACERS FILES "tracer_<component>.def" WITH A SINGLE SECTION IN EACH.
+  !=== REMARKS:
+  !===  * EACH SECTION BEGINS WITH A "&<section name> LINE
+  !===  * DEFAULT VALUES FOR ALL THE SECTIONS OF THE FILE ARE DEFINED IN THE SPECIAL SECTION "&default"
+  !===  * EACH SECTION LINE HAS THE STRUCTURE:  <name(s)>  <key1>=<value1> <key2>=<value2> ...
+  !===  * SO FAR, THE DEFINED KEYS ARE: parent, phases, hadv, vadv, type
+  !===  * <name> AND <parent> CAN BE LISTS OF COMA-SEPARATED TRACERS ; THE ROUTINE EXPAND THESE FACTORIZATIONS.
+  !=== FUNCTION RETURN VALUE "lerr" IS FALSE IN CASE SOMETHING WENT WRONG.
+  !=== ABOUT THE KEYS:
+  !     * The "keys" component (of type keys_type) is in principle enough to store everything we could need.
+  !     But some variables are stored as direct-access keys to make the code more readable and because they are used often.
+  !     * Most of the direct-access keys are set in this module, but some are not (longName, iadv, isAdvected for now).
+  !     * Some of the direct-access keys must be updated (using the routine "setDirectKeys") is a subset of "tracers(:)"
+  !     is extracted: the indexes are no longer valid for a subset (examples: iqParent, iqDescen).
+  !     * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys".
+  !==============================================================================================================================
+  LOGICAL FUNCTION readTracersFiles(type_trac, tracs, lRepr) RESULT(lerr)
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = *), INTENT(IN) :: type_trac     !--- List of components used
+    TYPE(trac_type), ALLOCATABLE, TARGET, OPTIONAL, INTENT(OUT) :: tracs(:)      !--- Tracers descriptor for external storage
+    LOGICAL, OPTIONAL, INTENT(IN) :: lRepr         !--- Activate the HNO3 exceptions for REPROBUS
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: s(:), sections(:), trac_files(:)
+    CHARACTER(LEN = maxlen) :: str, fname, tname, pname, cname
+    INTEGER :: nsec, ierr, it, ntrac, ns, ip, ix, fType
+    INTEGER, ALLOCATABLE :: iGen(:)
+    LOGICAL :: lRep
+    TYPE(keys_type), POINTER :: k
+    !------------------------------------------------------------------------------------------------------------------------------
+    lerr = .FALSE.
+    modname = 'readTracersFiles'
+    IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
+    lRep = .FALSE.; IF(PRESENT(lRepr)) lRep = lRepr
+
+    !--- Required sections + corresponding files names (new style single section case) for tests
+    lerr = testTracersFiles(modname, type_trac, fType, .FALSE., trac_files, sections); IF(lerr) RETURN
+    nsec = SIZE(sections)
+
+    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    SELECT CASE(fType)                         !--- Set name, component, parent, phase, iGeneration, gen0Name, type
+      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    CASE(1)                                                          !=== OLD FORMAT "traceur.def"
+      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+      !--- OPEN THE "traceur.def" FILE
+      OPEN(90, FILE = "traceur.def", FORM = 'formatted', STATUS = 'old', POSITION = 'REWIND', IOSTAT = ierr)
+
+      !--- GET THE TRACERS NUMBER
+      READ(90, '(i3)', IOSTAT = ierr)ntrac                               !--- Number of lines/tracers
+      lerr = ierr/=0; IF(fmsg('Invalid format for "' // TRIM(fname) // '"', modname, lerr)) RETURN
+
+      !--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>]
+      ALLOCATE(tracers(ntrac))
+      DO it = 1, ntrac                                               !=== READ RAW DATA: loop on the line/tracer number
+        READ(90, '(a)', IOSTAT = ierr) str
+        lerr = ierr>0; IF(fmsg('Invalid format for "' // TRIM(fname) // '"', modname, lerr)) RETURN
+        lerr = ierr<0; IF(fmsg('Not enough lines in "' // TRIM(fname) // '"', modname, lerr)) RETURN
+        lerr = strParse(str, ' ', s, ns)
+        CALL msg('This file is for air tracers only', modname, ns == 3 .AND. it == 1)
+        CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1)
+        k => tracers(it)%keys
+
+        !=== NAME OF THE TRACER
+        tname = old2newH2O(s(3), ip)
+        ix = strIdx(oldHNO3, s(3))
+        IF(ix /= 0 .AND. lRep) tname = newHNO3(ix)                   !--- Exception for HNO3 (REPROBUS ONLY)
+        tracers(it)%name = tname                                     !--- Set the name of the tracer
+        CALL addKey('name', tname, k)                                !--- Set the name of the tracer
+        tracers(it)%keys%name = tname                                !--- Copy tracers names in keys components
+
+        !=== NAME OF THE COMPONENT
+        cname = type_trac                                            !--- Name of the model component
+        IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz'
+        tracers(it)%component = cname                                !--- Set component
+        CALL addKey('component', cname, k)                           !--- Set the name of the model component
+
+        !=== NAME OF THE PARENT
+        pname = tran0                                                !--- Default name: default transporting fluid (air)
+        IF(ns == 4) THEN
+          pname = old2newH2O(s(4))
+          ix = strIdx(oldHNO3, s(4))
+          IF(ix /= 0 .AND. lRep) pname = newHNO3(ix)                 !--- Exception for HNO3 (REPROBUS ONLY)
+        END IF
+        tracers(it)%parent = pname                                   !--- Set the parent name
+        CALL addKey('parent', pname, k)
+
+        !=== PHASE AND ADVECTION SCHEMES NUMBERS
+        tracers(it)%phase = known_phases(ip:ip)                      !--- Set the phase of the tracer (default: "g"azeous)
+        CALL addKey('phase', known_phases(ip:ip), k)                 !--- Set the phase of the tracer (default: "g"azeous)
+        CALL addKey('hadv', s(1), k)                                !--- Set the horizontal advection schemes number
+        CALL addKey('vadv', s(2), k)                                !--- Set the vertical   advection schemes number
+      END DO
+      CLOSE(90)
+      lerr = setGeneration(tracers); IF(lerr) RETURN                 !--- Set iGeneration and gen0Name
+      lerr = getKey('iGeneration', iGen, tracers(:)%keys)            !--- Generation number
+      WHERE(iGen == 2) tracers(:)%type = 'tag'                       !--- Set type:      'tracer' or 'tag'
+      DO it = 1, ntrac
+        CALL addKey('type', tracers(it)%type, tracers(it)%keys)      !--- Set the type of tracer
+      END DO
+      lerr = checkTracers(tracers, fname, fname); IF(lerr) RETURN    !--- Detect orphans and check phases
+      lerr = checkUnique (tracers, fname, fname); IF(lerr) RETURN    !--- Detect repeated tracers
+      CALL sortTracers   (tracers)                                   !--- Sort the tracers
+      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    CASE(2); lerr = feedDBase(["tracer.def"], [type_trac], modname); IF(lerr) RETURN  !=== SINGLE   FILE, MULTIPLE SECTIONS
+    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    CASE(3); lerr = feedDBase(trac_files, sections, modname); IF(lerr) RETURN  !=== MULTIPLE FILES, SINGLE  SECTION
+    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    END SELECT
+    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    IF(ALL([2, 3] /= fType)) RETURN
+    IF(nsec == 1) tracers = dBase(1)%trac
+    IF(nsec /= 1) THEN
+      CALL msg('Multiple sections are MERGED', modname, lTracsMerge)
+      CALL msg('Multiple sections are CUMULATED', modname, .NOT.lTracsMerge)
+      IF(lTracsMerge) lerr = cumulTracers(dBase, tracers)
+      IF(.NOT.lTracsMerge) lerr = cumulTracers(dBase, tracers)
+      IF(lerr) RETURN
+    END IF
+    lerr = indexUpdate(tracers); IF(lerr) RETURN                       !--- Set iqParent, iqDescen, nqDescen, nqChildren
+    IF(PRESENT(tracs)) CALL MOVE_ALLOC(FROM = tracers, TO = tracs)
+  END FUNCTION readTracersFiles
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  LOGICAL FUNCTION testTracersFiles(modname, type_trac, fType, lDisp, tracf, sects) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: modname, type_trac
+    INTEGER, INTENT(OUT) :: fType
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    CHARACTER(LEN = maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: tracf(:), sects(:)
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: trac_files(:), sections(:)
+    LOGICAL, ALLOCATABLE :: ll(:)
+    LOGICAL :: lD, lFound
+    INTEGER :: is, nsec
+    lD = .FALSE.; IF(PRESENT(lDisp)) lD = lDisp
+    lerr = .FALSE.
+
+    !--- PARSE "type_trac" LIST AND DETERMINE THE TRACERS FILES NAMES (FOR CASE 3: MULTIPLE FILES, SINGLE SECTION PER FILE)
+    !--- If type_trac is a scalar (case 1), "sections" and "trac_files" are not usable, but are meaningless for case 1 anyway.
+    lerr = strParse(type_trac, '|', sections, n = nsec); IF(lerr) RETURN !--- Parse "type_trac" list
+    IF(PRESENT(sects)) sects = sections
+    ALLOCATE(trac_files(nsec), ll(nsec))
+    DO is = 1, nsec
+      trac_files(is) = 'tracer_' // TRIM(sections(is)) // '.def'
+      INQUIRE(FILE = TRIM(trac_files(is)), EXIST = ll(is))
+    END DO
+    IF(PRESENT(tracf)) tracf = trac_files
+    fType = 0
+    INQUIRE(FILE = 'traceur.def', EXIST = lFound); IF(lFound)  fType = 1   !--- OLD STYLE FILE
+    INQUIRE(FILE = 'tracer.def', EXIST = lFound); IF(lFound)  fType = 2   !--- NEW STYLE ; SINGLE  FILE, SEVERAL SECTIONS
+    IF(ALL(ll)) fType = 3   !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
+    IF(.NOT.lD) RETURN                                                 !--- NO CHECKING/DISPLAY NEEDED: JUST GET type_trac,fType
+    IF(ANY(ll) .AND. fType/=3) THEN                                    !--- MISSING FILES
+      lerr = checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'); IF(lerr) RETURN
+    END IF
+
+    !--- TELLS WHAT WAS IS ABOUT TO BE USED
+    CALL msg('Trying to read old-style tracers description file "traceur.def"', modname, fType==1)
+    CALL msg('Trying to read the new style multi-sections tracers description file "tracer.def"', modname, fType==2)
+    CALL msg('Trying to read the new style single section tracers description files "tracer_*.def"', modname, fType==3)
+  END FUNCTION testTracersFiles
+  !==============================================================================================================================
+
+  !==============================================================================================================================
+  LOGICAL FUNCTION feedDBase(fnames, snames, modname) RESULT(lerr)
+    ! Purpose: Read the sections "snames(is)" (pipe-separated list) from each "fnames(is)"
+    !   file and create the corresponding tracers set descriptors in the database "dBase":
+    ! * dBase(id)%name                : section name
+    ! * dBase(id)%trac(:)%name        : tracers names
+    ! * dBase(id)%trac(it)%keys%key(:): names  of keys associated to tracer dBase(id)%trac(it)%name
+    ! * dBase(id)%trac(it)%keys%val(:): values of keys associated to tracer dBase(id)%trac(it)%name
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = *), INTENT(IN) :: fnames(:)                         !--- Files names
+    CHARACTER(LEN = *), INTENT(IN) :: snames(:)                         !--- Pipe-deparated list of sections (one list each file)
+    CHARACTER(LEN = *), INTENT(IN) :: modname                           !--- Calling routine name
+    INTEGER, ALLOCATABLE :: ndb(:)                                    !--- Number of sections for each file
+    INTEGER, ALLOCATABLE :: ixf(:)                                    !--- File index for each section of the expanded list
+    CHARACTER(LEN = maxlen) :: fnm, snm
+    INTEGER :: idb, i
+    LOGICAL :: ll
+    !------------------------------------------------------------------------------------------------------------------------------
+    !=== READ THE REQUIRED SECTIONS
+    ll = strCount(snames, '|', ndb)                                    !--- Number of sections for each file
+    ALLOCATE(ixf(SUM(ndb)))
+    DO i = 1, SIZE(fnames)                                               !--- Set name, keys
+      lerr = readSections(fnames(i), snames(i), 'default'); IF(lerr) RETURN
+      ixf(1 + SUM(ndb(1:i - 1)):SUM(ndb(1:i))) = i                         !--- File index for each section of the expanded list
+    END DO
+    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    DO idb = 1, SIZE(dBase)                                               !--- LOOP ON THE LOADED SECTIONS
+      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+      fnm = fnames(ixf(idb)); snm = dBase(idb)%name                    !--- FILE AND SECTION NAMES
+      lerr = ANY([(dispTraSection('RAW CONTENT OF SECTION "' // TRIM(snm) // '"', snm, modname), idb = 1, SIZE(dBase))])
+      lerr = expandSection(dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- EXPAND NAMES ;  SET parent, type, component
+      lerr = setGeneration(dBase(idb)%trac);           IF(lerr) RETURN !---                 SET iGeneration,  genOName
+      lerr = checkTracers (dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- CHECK ORPHANS AND PHASES
+      lerr = checkUnique  (dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- CHECK TRACERS UNIQUENESS
+      lerr = expandPhases (dBase(idb)%trac);           IF(lerr) RETURN !--- EXPAND PHASES ; set phase
+      CALL sortTracers    (dBase(idb)%trac)                            !--- SORT TRACERS
+      lerr = ANY([(dispTraSection('EXPANDED CONTENT OF SECTION "' // TRIM(snm) // '"', snm, modname), idb = 1, SIZE(dBase))])
+      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    END DO
+    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  END FUNCTION feedDBase
+  !------------------------------------------------------------------------------------------------------------------------------
+
+  !------------------------------------------------------------------------------------------------------------------------------
+  LOGICAL FUNCTION readSections(fnam, snam, defName) RESULT(lerr)
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = *), INTENT(IN) :: fnam                     !--- File name
+    CHARACTER(LEN = *), INTENT(IN) :: snam                     !--- Pipe-separated sections list
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: defName                  !--- Special section (default values) name
+    !------------------------------------------------------------------------------------------------------------------------------
+    TYPE(dataBase_type), ALLOCATABLE :: tdb(:)
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: sec(:)
+    INTEGER, ALLOCATABLE :: ix(:)
+    INTEGER :: n0, idb, ndb
+    LOGICAL :: ll
+    !------------------------------------------------------------------------------------------------------------------------------
+    n0 = SIZE(dBase) + 1                                               !--- Index for next entry in the database
+    CALL readSections_all()                                            !--- Read all the sections of file "fnam"
+    ndb = SIZE(dBase)                                                   !--- Current number of sections in the database
+    IF(PRESENT(defName)) THEN                                          !--- Add default values to all the tracers
+      DO idb = n0, ndb; CALL addDefault(dBase(idb)%trac, defName);
+      END DO !--- and remove the virtual tracer "defName"
+    END IF
+    ll = strParse(snam, '|', keys = sec)                               !--- Requested sections names
+    ix = strIdx(dBase(:)%name, sec(:))                                 !--- Indexes of requested sections in database
+    lerr = checkList(sec, ix == 0, 'In file "' // TRIM(fnam) // '"', 'section(s)', 'missing'); IF(lerr) RETURN
+    tdb = dBase(:); dBase = [tdb(1:n0 - 1), tdb(PACK(ix, MASK = ix/=0))]    !--- Keep requested sections only
+
+  CONTAINS
+
+    !------------------------------------------------------------------------------------------------------------------------------
+    SUBROUTINE readSections_all()
+      !------------------------------------------------------------------------------------------------------------------------------
+      CHARACTER(LEN = maxlen), ALLOCATABLE :: s(:), v(:)
+      TYPE(trac_type), ALLOCATABLE :: tt(:)
+      TYPE(trac_type) :: tmp
+      CHARACTER(LEN = 1024) :: str, str2
+      CHARACTER(LEN = maxlen) :: secn
+      INTEGER :: ierr, n
+      !------------------------------------------------------------------------------------------------------------------------------
+      IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
+      OPEN(90, FILE = fnam, FORM = 'formatted', POSITION = 'REWIND', STATUS = 'old')
+      DO; str = ''
+      DO
+        READ(90, '(a)', IOSTAT = ierr)str2                                !--- Read a full line
+        str = TRIM(str) // ' ' // TRIM(str2)                                 !--- Append "str" with the current line
+        n = LEN_TRIM(str); IF(n == 0) EXIT                               !--- Empty line (probably end of file)
+        IF(IACHAR(str(n:n))  /= 92) EXIT                               !--- No "\" continuing line symbol found => end of line
+        str = str(1:n - 1)                                               !--- Remove the "\" continuing line symbol
+      END DO
+      str = ADJUSTL(str)                                               !--- Remove the front space
+      IF(ierr    /= 0) EXIT                                           !--- Finished: error or end of file
+      IF(str(1:1)=='#') CYCLE                                          !--- Skip comments lines
+      CALL removeComment(str)                                          !--- Skip comments at the end of a line
+      IF(LEN_TRIM(str) == 0) CYCLE                                     !--- Empty line (probably end of file)
+      IF(str     == '') CYCLE                                          !--- Skip empty line (probably at the end of the file)
+      IF(str(1:1)==
+        '&') THEN                                           !=== SECTION HEADER LINE
+        ndb = SIZE(dBase)                                             !--- Number of sections so far
+        secn = str(2:LEN_TRIM(str)) // ' '                               !--- Current section name
+        IF(ANY(dBase(:)%name == secn)) CYCLE                           !--- Already known section
+        IF(secn(1:7) == 'version')     CYCLE                           !--- Skip the "version" special section
+        ndb = ndb + 1                                                  !--- Extend database
+        ALLOCATE(tdb(ndb))
+        tdb(1:ndb - 1) = dBase
+        tdb(ndb)%name = secn
+        ALLOCATE(tdb(ndb)%trac(0))
+        CALL MOVE_ALLOC(FROM = tdb, TO = dBase)
+      ELSE                                                             !=== TRACER LINE
+        ll = strParse(str, ' ', s, n, v)                                !--- Parse <key>=<val> pairs
+        tt = dBase(ndb)%trac(:)
+        v(1) = s(1); s(1) = 'name'                                     !--- Convert "name" into a regular key
+        tmp%name = v(1); tmp%keys = keys_type(v(1), s(:), v(:))        !--- Set %name and %keys
+        dBase(ndb)%trac = [tt(:), tmp]
+        DEALLOCATE(tt, tmp%keys%key, tmp%keys%val)
+      END IF
+      END DO
+      CLOSE(90)
+
+    END SUBROUTINE readSections_all
+    !------------------------------------------------------------------------------------------------------------------------------
+
+  END FUNCTION readSections
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  SUBROUTINE addDefault(t, defName)
+    !------------------------------------------------------------------------------------------------------------------------------
+    ! Purpose: Add the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
+    !------------------------------------------------------------------------------------------------------------------------------
+    TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
+    CHARACTER(LEN = *), INTENT(IN) :: defName
+    INTEGER :: jd, it, k
+    TYPE(keys_type), POINTER :: ky
+    TYPE(trac_type), ALLOCATABLE :: tt(:)
+    jd = strIdx(t(:)%name, defName)
+    IF(jd == 0) RETURN
+    ky => t(jd)%keys
+    DO k = 1, SIZE(ky%key)                                             !--- Loop on the keys of the tracer named "defName"
+      !   CALL addKey(ky%key(k), ky%val(k), t(:)%keys, .FALSE.)            !--- Add key to all the tracers (no overwriting)
+      DO it = 1, SIZE(t); CALL addKey(ky%key(k), ky%val(k), t(it)%keys, .FALSE.);
+      END DO
+    END DO
+    tt = [t(1:jd - 1), t(jd + 1:SIZE(t))]; CALL MOVE_ALLOC(FROM = tt, TO = t)   !--- Remove the virtual tracer named "defName"
+  END SUBROUTINE addDefault
+  !==============================================================================================================================
+
+  !==============================================================================================================================
+  SUBROUTINE subDefault(t, defName, lSubLocal)
+    !------------------------------------------------------------------------------------------------------------------------------
+    ! Purpose: Substitute the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
+    !          Substitute the keys locally (for the current tracer) if the flag "lSubLocal" is .TRUE.
+    !------------------------------------------------------------------------------------------------------------------------------
+    TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
+    CHARACTER(LEN = *), INTENT(IN) :: defName
+    LOGICAL, INTENT(IN) :: lSubLocal
+    INTEGER :: i0, it, ik
+    TYPE(keys_type), POINTER :: k0, ky
+    TYPE(trac_type), ALLOCATABLE :: tt(:)
+    i0 = strIdx(t(:)%name, defName)
+    IF(i0 == 0) RETURN
+    k0 => t(i0)%keys
+    DO it = 1, SIZE(t); IF(it == i0) CYCLE                             !--- Loop on the tracers
+    ky => t(it)%keys
+
+    !--- Substitute in the values of <key>=<val> pairs the keys defined in the virtual tracer "defName"
+    DO ik = 1, SIZE(k0%key); CALL strReplace(ky%val, k0%key(ik), k0%val(ik), .TRUE.);
+    END DO
+
+    IF(.NOT.lSubLocal) CYCLE
+    !--- Substitute in the values of <key>=<val> pairs the keys defined locally (in the current tracer)
+    DO ik = 1, SIZE(ky%key); CALL strReplace(ky%val, ky%key(ik), ky%val(ik), .TRUE.);
+    END DO
+    END DO
+    tt = [t(1:i0 - 1), t(i0 + 1:SIZE(t))]; CALL MOVE_ALLOC(FROM = tt, TO = t)   !--- Remove the virtual tracer named "defName"
+
+  END SUBROUTINE subDefault
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  LOGICAL FUNCTION expandSection(tr, sname, fname) RESULT(lerr)
+    !------------------------------------------------------------------------------------------------------------------------------
+    ! Purpose: Expand tracers and parents lists in the tracers descriptor "tra".
+    ! Note:  * The following keys are expanded, so are accessible explicitely using "%" operator: "parent" "type".
+    !        * Default values are provided for these keys because they are necessary.
+    !------------------------------------------------------------------------------------------------------------------------------
+    TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:)                 !--- Tracer derived type vector
+    CHARACTER(LEN = *), INTENT(IN) :: sname                 !--- Current section name
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: fname                 !--- Tracers description file name
+    TYPE(trac_type), ALLOCATABLE :: ttr(:)
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: ta(:), pa(:), tname(:), parent(:), dType(:)
+    CHARACTER(LEN = maxlen) :: msg1, modname
+    INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr
+    LOGICAL :: ll
+    modname = 'expandSection'
+    lerr = .FALSE.
+    nt = SIZE(tr)
+    lerr = getKey('name', tname, tr(:)%keys);                 IF(lerr) RETURN
+    lerr = getKey('parent', parent, tr(:)%keys, def = tran0);    IF(lerr) RETURN
+    lerr = getKey('type', dType, tr(:)%keys, def = 'tracer'); IF(lerr) RETURN
+    nq = 0
+    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    DO it = 1, nt    !=== GET TRACERS NB AFTER EXPANSION + NEEDED KEYS (name, parent, type)
+      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+      !--- Extract useful keys: parent name, type, component name
+      tr(it)%component = sname
+      CALL addKey('component', sname, tr(it)%keys)
+
+      !--- Determine the number of tracers and parents ; coherence checking
+      ll = strCount(tname(it), ',', ntr)
+      ll = strCount(parent(it), ',', npr)
+
+      !--- Tagging tracers only can have multiple parents
+      lerr = npr /=1 .AND. TRIM(dType(it)) /= 'tag'
+      IF(lerr) THEN
+        msg1 = 'Check section "' // TRIM(sname) // '"'
+        IF(PRESENT(fname)) msg1 = TRIM(msg1) // ' in file "' // TRIM(fname) // '"'
+        CALL msg(TRIM(msg1) // ': "' // TRIM(tname(it)) // '" has several parents but is not a tag', modname); RETURN
+      END IF
+      nq = nq + ntr * npr
+      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    END DO
+    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+    ALLOCATE(ttr(nq))
+    iq = 1
+    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    DO it = 1, nt                                                      !=== EXPAND TRACERS AND PARENTS NAMES LISTS
+      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+      ll = strParse(tname(it), ',', ta, ntr)                          !--- Number of tracers
+      ll = strParse(parent(it), ',', pa, npr)                          !--- Number of parents
+      DO ipr = 1, npr                                                  !--- Loop on parents list elts
+        DO itr = 1, ntr                                                !--- Loop on tracers list elts
+          ttr(iq)%keys%name = TRIM(ta(itr))
+          ttr(iq)%keys%key = tr(it)%keys%key
+          ttr(iq)%keys%val = tr(it)%keys%val
+          ttr(iq)%name = TRIM(ta(itr))
+          ttr(iq)%parent = TRIM(pa(ipr))
+          ttr(iq)%type = dType(it)
+          ttr(iq)%component = sname
+          CALL addKey('name', ta(itr), ttr(iq)%keys)
+          CALL addKey('parent', pa(ipr), ttr(iq)%keys)
+          CALL addKey('type', dType(it), ttr(iq)%keys)
+          CALL addKey('component', sname, ttr(iq)%keys)
+          iq = iq + 1
+        END DO
+      END DO
+      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    END DO
+    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    DEALLOCATE(ta, pa)
+    CALL MOVE_ALLOC(FROM = ttr, TO = tr)
+
+  END FUNCTION expandSection
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  LOGICAL FUNCTION setGeneration(tr) RESULT(lerr)
+    !------------------------------------------------------------------------------------------------------------------------------
+    ! Purpose: Determine, for each tracer of "tr(:)":
+    !   * iGeneration: the generation number
+    !   * gen0Name:    the generation 0 ancestor name
+    !          Check also for orphan tracers (tracers without parent).
+    !------------------------------------------------------------------------------------------------------------------------------
+    TYPE(trac_type), INTENT(INOUT) :: tr(:)                        !--- Tracer derived type vector
+    INTEGER :: iq, jq, ig
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: parent(:), tname(:)
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: modname
+    modname = 'setGeneration'
+    lerr = getKey('name', tname, ky = tr(:)%keys); IF(lerr) RETURN
+    lerr = getKey('parent', parent, ky = tr(:)%keys); IF(lerr) RETURN
+    DO iq = 1, SIZE(tr)
+      jq = iq; ig = 0
+      DO WHILE(parent(jq) /= tran0)
+        jq = strIdx(tname(:), parent(jq))
+        lerr = jq == 0
+        IF(fmsg('Orphan tracer "' // TRIM(tname(iq)) // '"', modname, lerr)) RETURN
+        ig = ig + 1
+      END DO
+      tr(iq)%gen0Name = tname(jq)
+      tr(iq)%iGeneration = ig
+      CALL addKey('iGeneration', ig, tr(iq)%keys)
+      CALL addKey('gen0Name', tname(jq), tr(iq)%keys)
+    END DO
+  END FUNCTION setGeneration
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  LOGICAL FUNCTION checkTracers(tr, sname, fname) RESULT(lerr)
+    !------------------------------------------------------------------------------------------------------------------------------
+    ! Purpose:
+    !   * check for orphan tracers (without parent)
+    !   * check wether the phases are known or not (elements of "known_phases")
+    !------------------------------------------------------------------------------------------------------------------------------
+    TYPE(trac_type), INTENT(IN) :: tr(:)                    !--- Tracer derived type vector
+    CHARACTER(LEN = *), INTENT(IN) :: sname                    !--- Section name
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: fname                    !--- File name
+    CHARACTER(LEN = 1) :: p
+    CHARACTER(LEN = maxlen) :: mesg
+    CHARACTER(LEN = maxlen) :: bp(SIZE(tr, DIM = 1)), pha                  !--- Bad phases list, phases of current tracer
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: tname(:)
+    INTEGER, ALLOCATABLE :: iGen(:)
+    INTEGER :: ip, np, iq, nq
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: modname
+    modname = 'checkTracers'
+    nq = SIZE(tr, DIM = 1)                                                !--- Number of tracers lines
+    mesg = 'Check section "' // TRIM(sname) // '"'
+    IF(PRESENT(fname)) mesg = TRIM(mesg) // ' in file "' // TRIM(fname) // '"'
+    lerr = getKey('iGeneration', iGen, tr(:)%keys);               IF(lerr) RETURN
+    lerr = getKey('name', tname, tr(:)%keys);               IF(lerr) RETURN
+
+    !=== CHECK FOR ORPHAN TRACERS
+    lerr = checkList(tname, iGen==-1, mesg, 'tracers', 'orphan'); IF(lerr) RETURN
+
+    !=== CHECK PHASES
+    DO iq = 1, nq; IF(iGen(iq) /= 0) CYCLE                             !--- Generation O only is checked
+    IF(getKey(['phases', 'phase '], pha, iq, tr(:)%keys, lDisp = .FALSE.)) pha = 'g'   !--- Phase
+    np = LEN_TRIM(pha); bp(iq) = ' '
+    DO ip = 1, np; p = pha(ip:ip); IF(INDEX(known_phases, p) == 0) bp(iq) = TRIM(bp(iq)) // p;
+    END DO
+    IF(TRIM(bp(iq)) /= '') bp(iq) = TRIM(tname(iq)) // ': ' // TRIM(bp(iq))
+    END DO
+    lerr = checkList(bp, iGen == 0 .AND. bp /= '', mesg, 'tracers phases', 'unknown')
+  END FUNCTION checkTracers
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  LOGICAL FUNCTION checkUnique(tr, sname, fname) RESULT(lerr)
+    !------------------------------------------------------------------------------------------------------------------------------
+    ! Purpose: Make sure that tracers are not repeated.
+    !------------------------------------------------------------------------------------------------------------------------------
+    TYPE(trac_type), INTENT(IN) :: tr(:)                    !--- Tracer derived type vector
+    CHARACTER(LEN = *), INTENT(IN) :: sname                    !--- Section name
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: fname                    !--- File name
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: ip, np, iq, nq, k
+    LOGICAL, ALLOCATABLE :: ll(:)
+    CHARACTER(LEN = maxlen) :: mesg, phase, tdup(SIZE(tr, DIM = 1))
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: tname(:), dType(:)
+    INTEGER, ALLOCATABLE :: iGen(:)
+    CHARACTER(LEN = 1) :: p
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: modname
+    modname = 'checkUnique'
+    mesg = 'Check section "' // TRIM(sname) // '"'
+    IF(PRESENT(fname)) mesg = TRIM(mesg) // ' in file "' // TRIM(fname) // '"'
+    nq = SIZE(tr, DIM = 1); lerr = .FALSE.                                    !--- Number of lines ; error flag
+    tdup(:) = ''
+    lerr = getKey('name', tname, tr%keys); IF(lerr) RETURN
+    lerr = getKey('type', dType, tr%keys); IF(lerr) RETURN
+    lerr = getKey('iGeneration', iGen, tr%keys); IF(lerr) RETURN
+    DO iq = 1, nq
+      IF(dType(iq) == 'tag') CYCLE                                     !--- Tags can be repeated
+      ll = tname==TRIM(tname(iq))                                      !--- Mask for current tracer name
+      IF(COUNT(ll) == 1) CYCLE                                         !--- Tracer is not repeated
+      IF(iGen(iq) > 0) THEN
+        tdup(iq) = tname(iq)                                           !--- gen>0: MUST be unique
+      ELSE
+        DO ip = 1, nphases; p = known_phases(ip:ip)                    !--- Loop on known phases
+        np = 0
+        DO k = 1, nq
+          IF(.NOT.ll(k)) CYCLE                                       !--- Skip tracers different from current one
+          IF(getKey(['phases', 'phase '], phase, k, tr%keys, lDisp = .FALSE.)) phase = 'g'!--- Get current phases
+          IF(INDEX(phase, p) /= 0) np = np + 1                       !--- One more appearance of current tracer with phase "p"
+        END DO
+        IF(np <= 1) CYCLE                                            !--- Regular case: no or a single appearance
+        tdup(iq) = TRIM(tdup(iq)) // TRIM(phases_names(ip))            !--- Repeated phase
+        IF(ANY(tdup(1:iq - 1) == tdup(iq))) tdup(iq) = ''                !--- Avoid repeating same messages
+        END DO
+      END IF
+      IF(tdup(iq) /= '') tdup(iq) = TRIM(tname(iq)) // ' in ' // TRIM(tdup(iq)) // ' phase(s)'
+    END DO
+    lerr = checkList(tdup, tdup/='', mesg, 'tracers', 'duplicated')
+  END FUNCTION checkUnique
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  LOGICAL FUNCTION expandPhases(tr) RESULT(lerr)
+    !------------------------------------------------------------------------------------------------------------------------------
+    ! Purpose: Expand the phases in the tracers descriptor "tr". Phases are not repeated for a tracer, thanks to "checkUnique".
+    !------------------------------------------------------------------------------------------------------------------------------
+    TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:)               !--- Tracer derived type vector
+    !------------------------------------------------------------------------------------------------------------------------------
+    TYPE(trac_type), ALLOCATABLE :: ttr(:)
+    INTEGER, ALLOCATABLE :: i0(:), iGen(:)
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: tname(:), gen0N(:), phase(:), parents(:), dType(:)
+    CHARACTER(LEN = maxlen) :: nam, gen0Nm, pha, parent
+    CHARACTER(LEN = 1) :: p
+    INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n
+    LOGICAL :: lTag, lExt
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: modname
+    modname = 'expandPhases'
+    nq = SIZE(tr, DIM = 1)
+    nt = 0
+    lerr = getKey('name', tname, tr%keys); IF(lerr) RETURN       !--- Names of the tracers
+    lerr = getKey('gen0Name', gen0N, tr%keys); IF(lerr) RETURN       !--- Names of the tracers of first generation
+    lerr = getKey('iGeneration', iGen, tr%keys); IF(lerr) RETURN       !--- Generation number
+    lerr = getKey('phases', phase, tr%keys); IF(lerr) RETURN       !--- Phases names
+    lerr = getKey('parent', parents, tr%keys); IF(lerr) RETURN       !--- Parents names
+    lerr = getKey('type', dType, tr%keys); IF(lerr) RETURN       !--- Tracers types ('tracer' or 'tag')
+    DO iq = 1, nq                                                      !--- GET THE NUMBER OF TRACERS
+      IF(iGen(iq) /= 0) CYCLE                                          !--- Only deal with generation 0 tracers
+      nc = COUNT(gen0N == tname(iq) .AND. iGen /= 0)                   !--- Number of children of tr(iq)
+      np = LEN_TRIM(phase(iq))                                         !--- Number of phases   of tr(iq)
+      nt = nt + (1 + nc) * np                                            !--- Number of tracers after expansion
+    END DO
+    ALLOCATE(ttr(nt))                                                  !--- Version  of "tr" after phases expansion
+    it = 1                                                             !--- Current "ttr(:)" index
+    DO iq = 1, nq                                                      !--- Loop on "tr(:)" indexes
+      lTag = dType(iq)=='tag'                                          !--- Current tracer is a tag
+      i0 = strFind(tname, TRIM(gen0N(iq)), n)                          !--- Indexes of first generation ancestor copies
+      np = SUM([(LEN_TRIM(phase(i0(i))), i = 1, n)], 1)              !--- Number of phases for current tracer tr(iq)
+      lExt = np > 1                                                    !--- Phase suffix only required if phases number is > 1
+      IF(lTag) lExt = lExt .AND. iGen(iq) > 0                          !--- No phase suffix for generation 0 tags
+      DO i = 1, n                                                      !=== LOOP ON GENERATION 0 ANCESTORS
+        jq = i0(i)                                                     !--- tr(jq): ith tracer with same gen 0 ancestor as tr(iq)
+        IF(iGen(iq) == 0) jq = iq                                      !--- Generation 0: count the current tracer phases only
+        pha = phase(jq)                                                !--- Phases list for tr(jq)
+        DO ip = 1, LEN_TRIM(pha)                                       !=== LOOP ON PHASES LISTS
+          p = pha(ip:ip)
+          nam = tname(iq)                                              !--- Tracer name (regular case)
+          IF(lTag) nam = TRIM(parents(iq))                             !--- Parent name (tagging case)
+          IF(lExt) nam = addPhase(nam, p)                             !--- Phase extension needed
+          IF(lTag) nam = TRIM(nam) // '_' // TRIM(tname(iq))               !--- <parent>_<name> for tags
+          ttr(it) = tr(iq)                                             !--- Same <key>=<val> pairs
+          ttr(it)%name = TRIM(nam)                                !--- Name with possibly phase suffix
+          ttr(it)%keys%name = TRIM(nam)                                !--- Name inside the keys decriptor
+          ttr(it)%phase = p                                        !--- Single phase entry
+          CALL addKey('name', nam, ttr(it)%keys)
+          CALL addKey('phase', p, ttr(it)%keys)
+          IF(lExt) THEN
+            parent = parents(iq); IF(iGen(iq) > 0) parent = addPhase(parent, p)
+            gen0Nm = gen0N(iq); IF(iGen(iq) > 0) gen0Nm = addPhase(gen0Nm, p)
+            ttr(it)%parent = parent
+            ttr(it)%gen0Name = gen0Nm
+            CALL addKey('parent', parent, ttr(it)%keys)
+            CALL addKey('gen0Name', gen0Nm, ttr(it)%keys)
+          END IF
+          it = it + 1
+        END DO
+        IF(iGen(iq) == 0) EXIT                                         !--- Break phase loop for gen 0
+      END DO
+    END DO
+    CALL MOVE_ALLOC(FROM = ttr, TO = tr)
+    CALL delKey(['phases'], tr)                                         !--- Remove few keys entries
+
+  END FUNCTION expandPhases
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  SUBROUTINE sortTracers(tr)
+    !------------------------------------------------------------------------------------------------------------------------------
+    ! Purpose: Sort tracers:
+    !  * Put water at the beginning of the vector, in the "known_phases" order.
+    !  * lGrowGen == T: in ascending generations numbers.
+    !  * lGrowGen == F: tracer + its children sorted by growing generation, one after the other.
+    !   TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END
+    !------------------------------------------------------------------------------------------------------------------------------
+    TYPE(trac_type), INTENT(INOUT) :: tr(:)                            !--- Tracer derived type vector
+    !------------------------------------------------------------------------------------------------------------------------------
+    TYPE(trac_type), ALLOCATABLE :: tr2(:)
+    INTEGER, ALLOCATABLE :: iy(:), iz(:)
+    INTEGER, ALLOCATABLE :: iGen(:)
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: tname(:), gen0N(:)
+    INTEGER :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k
+    LOGICAL :: lerr
+    !  tr2 is introduced in order to cope with a bug in gfortran 4.8.5 compiler
+    !------------------------------------------------------------------------------------------------------------------------------
+    lerr = getKey('iGeneration', iGen, tr%keys); IF(lerr) RETURN       !--- Generation number
+    nq = SIZE(tr)
+    DO ip = nphases, 1, -1
+      lerr = getKey('name', tname, tr%keys); IF(lerr) RETURN       !--- Names of the tracers of first generation
+      iq = strIdx(tname, addPhase('H2O', ip))
+      IF(iq == 0) CYCLE
+      tr2 = tr(:)
+      tr = [tr2(iq), tr2(1:iq - 1), tr2(iq + 1:nq)]
+    END DO
+    IF(lSortByGen) THEN
+      iq = 1
+      ng = MAXVAL(iGen, MASK = .TRUE., DIM = 1)                            !--- Number of generations
+      DO ig = 0, ng                                                    !--- Loop on generations
+        iy = PACK([(k, k = 1, nq)], MASK = iGen(:) == ig)                  !--- Generation ig tracers indexes
+        n = SIZE(iy)
+        ix(iq:iq + n - 1) = iy                                             !--- Stack growing generations idxs
+        iq = iq + n
+      END DO
+    ELSE
+      lerr = getKey('gen0Name', gen0N, tr%keys); IF(lerr) RETURN     !--- Names of the tracers    iq = 1
+      DO jq = 1, nq                                                    !--- Loop on generation 0 tracers
+        IF(iGen(jq) /= 0) CYCLE                                        !--- Skip generations /= 0
+        ix(iq) = jq                                                    !--- Generation 0 ancestor index first
+        iq = iq + 1                                                    !--- Next "iq" for next generations tracers
+        iy = strFind(gen0N(:), TRIM(tname(jq)))                        !--- Indices of "tr(jq)" children in "tr(:)"
+        ng = MAXVAL(iGen(iy), MASK = .TRUE., DIM = 1)                      !--- Number of generations of the "tr(jq)" family
+        DO ig = 1, ng                                                  !--- Loop   on generations of the "tr(jq)" family
+          iz = find(iGen(iy), ig, n)                                   !--- Indices of the tracers "tr(iy(:))" of generation "ig"
+          ix(iq:iq + n - 1) = iy(iz)                                       !--- Same indexes in "tr(:)"
+          iq = iq + n
+        END DO
+      END DO
+    END IF
+    tr = tr(ix)                                                        !--- Reorder the tracers
+  END SUBROUTINE sortTracers
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  LOGICAL FUNCTION mergeTracers(sections, tr) RESULT(lerr)
+    TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:)
+    TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tr(:)
+    TYPE(trac_type), POINTER :: t1(:), t2(:)
+    TYPE(keys_type), POINTER :: k1(:), k2(:)
+    INTEGER, ALLOCATABLE :: ixct(:), ixck(:)
+    INTEGER :: is, ik, ik1, ik2, nk2, i1, i2, nt2
+    CHARACTER(LEN = maxlen) :: s1, v1, v2, tnam, knam, modname
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: keys(:), n1(:), n2(:)
+    modname = 'mergeTracers'
+    lerr = .FALSE.
+    keys = ['parent     ', 'type       ', 'iGeneration']               !--- Mandatory keys
+    t1 => sections(1)%trac(:); k1 => t1(:)%keys                        !--- Alias: first tracers section, corresponding keys
+    lerr = getKey('name', n1, k1); IF(lerr) RETURN                     !--- Names of the tracers
+    tr = t1
+    !----------------------------------------------------------------------------------------------------------------------------
+    DO is = 2, SIZE(sections)                                             !=== SEVERAL SECTIONS: MERGE THEM
+      !----------------------------------------------------------------------------------------------------------------------------
+      t2 => sections(is)%trac(:)                                      !--- Alias: current tracers section
+      k2 => t2(:)%keys
+      lerr = getKey('name', n2, k2); IF(lerr) RETURN                   !--- Names of the tracers
+      nt2 = SIZE(t2(:), DIM = 1)                                        !--- Number of tracers in section
+      ixct = strIdx(n1(:), n2(:))                                      !--- Indexes of common tracers
+      tr = [tr, PACK(t2, MASK = ixct==0)]                               !--- Append with new tracers
+      IF(ALL(ixct == 0)) CYCLE                                       !--- No common tracers => done
+      CALL msg('Tracers defined in previous sections and duplicated in "' // TRIM(sections(is)%name) // '":', modname)
+      CALL msg(n1(PACK(ixct, MASK = ixct/=0)), modname, nmax = 128)      !--- Display duplicates (the 128 first at most)
+      !--------------------------------------------------------------------------------------------------------------------------
+      DO i2 = 1, nt2; tnam = TRIM(t2(i2)%name)                            !=== LOOP ON COMMON TRACERS
+      !--------------------------------------------------------------------------------------------------------------------------
+      i1 = ixct(i2); IF(i1 == 0) CYCLE                               !--- Idx in t1(:) ; skip new tracers
+
+      !=== CHECK WETHER ESSENTIAL KEYS ARE IDENTICAL OR NOT
+      s1 = ' of "' // TRIM(tnam) // '" in "' // TRIM(sections(is)%name) // '" not matching previous value'
+      DO ik = 1, SIZE(keys)
+        lerr = getKey(keys(ik), v1, i1, k1)
+        lerr = getKey(keys(ik), v2, i2, k2)
+        lerr = v1 /= v2; IF(fmsg(TRIM(keys(ik)) // TRIM(s1), modname, lerr)) RETURN
+      END DO
+
+      !=== GET THE INDICES IN tr(i2)%keys%key(:) OF THE KEYS ALSO PRESENT IN tr(i1)%keys%key(:)
+      nk2 = SIZE(k2(i2)%key(:))                                   !--- Keys number in current section
+      ixck = strIdx(k1(i1)%key(:), k2(i2)%key(:))                    !--- Common keys indexes
+      !--- APPEND THE NEW KEYS PAIRS IN tr(i1)%keys%key(:)
+      tr(i1)%keys%key = [ tr(i1)%keys%key, PACK(tr(i2)%keys%key, MASK = ixck==0)]
+      tr(i1)%keys%val = [ tr(i1)%keys%val, PACK(tr(i2)%keys%val, MASK = ixck==0)]
+
+      !=== KEEP TRACK OF THE COMPONENTS NAMES: COMA-SEPARATED LIST
+      lerr = getKey('component', v1, i1, k1)
+      lerr = getKey('component', v2, i2, k2)
+      tr(i1)%component = TRIM(v1) // ',' // TRIM(v2)
+      CALL addKey('component', TRIM(v1) // ',' // TRIM(v2), tr(i1)%keys)
+
+      !=== FOR TRACERS COMMON TO PREVIOUS AND CURRENT SECTIONS: CHECK WETHER SOME KEYS HAVE DIFFERENT VALUES ; KEEP OLD ONE
+      DO ik2 = 1, nk2                                                !--- Collect the corresponding indices
+        ik1 = ixck(ik2); IF(ik1 == 0) CYCLE
+        IF(k1(i1)%val(ik1) == k2(i2)%val(ik2)) ixck(ik2) = 0
+      END DO
+      IF(ALL(ixck==0)) CYCLE                                         !--- No identical keys with /=values => nothing to display
+      CALL msg('Key(s)' // TRIM(s1), modname)                          !--- Display the  keys with /=values (names list)
+      DO ik2 = 1, nk2                                                !--- Loop on keys found in both t1(:) and t2(:)
+        knam = k2(i2)%key(ik2)                                       !--- Name of the current key
+        ik1 = ixck(ik2)                                              !--- Corresponding index in t1(:)
+        IF(ik1 == 0) CYCLE                                           !--- New keys are skipped
+        v1 = k1(i1)%val(ik1); v2 = k2(i2)%val(ik2)                   !--- Key values in t1(:) and t2(:)
+        CALL msg(' * ' // TRIM(knam) // '=' // TRIM(v2) // ' ; previous value kept:' // TRIM(v1), modname)
+      END DO
+      !------------------------------------------------------------------------------------------------------------------------
+      END DO
+      !--------------------------------------------------------------------------------------------------------------------------
+    END DO
+    CALL sortTracers(tr)
+
+  END FUNCTION mergeTracers
+  !==============================================================================================================================
+
+  !==============================================================================================================================
+  LOGICAL FUNCTION cumulTracers(sections, tr, lRename) RESULT(lerr)
+    TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:)
+    TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tr(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: lRename               !--- .TRUE.: add a section suffix to identical names
+    CHARACTER(LEN = maxlen) :: tnam_new, modname
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: tname(:), parent(:), comp(:)
+    INTEGER :: iq, jq, is
+    modname = 'cumulTracers'
+    lerr = .FALSE.
+    tr = [(sections(is)%trac(:), is = 1, SIZE(sections))]            !--- Concatenated tracers vector
+    IF(PRESENT(lRename)) THEN; IF(lRename) RETURN;
+    END IF              !--- No renaming: finished
+    lerr = getKey('name', tname, tr%keys); IF(lerr) RETURN         !--- Names
+    lerr = getKey('parent', parent, tr%keys); IF(lerr) RETURN         !--- Parents
+    lerr = getKey('component', comp, tr%keys); IF(lerr) RETURN         !--- Component name
+    !----------------------------------------------------------------------------------------------------------------------------
+    DO iq = 1, SIZE(tr); IF(COUNT(tname == tname(iq)) == 1) CYCLE      !=== LOOP ON TRACERS
+    !----------------------------------------------------------------------------------------------------------------------------
+    tnam_new = TRIM(tname(iq)) // '_' // TRIM(comp(iq))                  !--- Same with section extension
+    CALL addKey('name', tnam_new, tr(iq)%keys)                       !--- Modify tracer name
+    tr(iq)%name = TRIM(tnam_new)                                     !--- Modify tracer name
+    !--------------------------------------------------------------------------------------------------------------------------
+    DO jq = 1, SIZE(tr); IF(parent(jq) /= tname(iq)) CYCLE           !=== LOOP ON TRACERS PARENTS
+    !--------------------------------------------------------------------------------------------------------------------------
+    CALL addKey('parent', tnam_new, tr(jq)%keys)                   !--- Modify tracer name
+    tr(jq)%parent = TRIM(tnam_new)                                 !--- Modify tracer name
+    !--------------------------------------------------------------------------------------------------------------------------
+    END DO
+    !----------------------------------------------------------------------------------------------------------------------------
+    END DO
+    !----------------------------------------------------------------------------------------------------------------------------
+    CALL sortTracers(tr)
+  END FUNCTION cumulTracers
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  LOGICAL  FUNCTION  dispTraSection(message, sname, modname) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: message, sname, modname
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: s(:, :), n(:), tmp(:)
+    CHARACTER(LEN = maxlen) :: p
+    INTEGER :: idb, iq, nq
+    idb = strIdx(dBase(:)%name, sname); IF(idb == 0) RETURN
+    nq = SIZE(dBase(idb)%trac)
+    p = ''
+    CALL append(['iq'], .TRUE.); IF(lerr) RETURN
+    CALL append(['name'], .TRUE.); IF(lerr) RETURN
+    CALL append(['phases', 'phase '], .FALSE., 'pha'); IF(lerr) RETURN
+    CALL append(['hadv'], .TRUE.); IF(lerr) RETURN
+    CALL append(['vadv'], .TRUE.); IF(lerr) RETURN
+    CALL append(['parent'], .FALSE.); IF(lerr) RETURN
+    CALL append(['iGen'], .FALSE.); IF(lerr) RETURN
+    CALL msg(TRIM(message) // ':', modname)
+    lerr = dispTable(p, n, s, nColMax = maxTableWidth, nHead = 2, sub = modname); IF(lerr) RETURN
+
+  CONTAINS
+
+    SUBROUTINE append(nam, lMandatory, snam)
+      ! Test whether key named "nam(:)" is available.
+      !  * yes: - get its value for all species in "tmp(:)" and append table "s(:,:)" with it
+      !         - append titles list with "nam(1)" (or, if specified, "snam", usually a short name).
+      !  * no:  return to calling routine with an error flag if the required key is mandatory
+      CHARACTER(LEN = *), INTENT(IN) :: nam(:)
+      LOGICAL, INTENT(IN) :: lMandatory
+      CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: snam
+      INTEGER :: m
+      CHARACTER(LEN = maxlen), ALLOCATABLE :: n0(:)
+      CHARACTER(LEN = maxlen) :: nm
+      lerr = .FALSE.
+      IF(nam(1) == 'iq') THEN
+        tmp = int2str([(iq, iq = 1, nq)])
+      ELSE
+        lerr = getKey(nam, tmp, dBase(idb)%trac(:)%keys, lDisp = lMandatory)
+      END IF
+      IF(lerr) THEN; lerr = lMandatory; RETURN;
+      END IF
+      nm = nam(1); IF(PRESENT(snam)) nm = snam
+      p = TRIM(p) // 's'
+      IF(ALLOCATED(s)) THEN; s = cat(s, tmp);
+      ELSE; ALLOCATE(s(nq, 1)); s(:, 1) = tmp;
+      END IF
+      IF(ALLOCATED(n)) THEN; m = SIZE(n); ALLOCATE(n0(m + 1)); n0(1:m) = n; n0(m + 1) = nm; CALL MOVE_ALLOC(FROM = n0, TO = n)
+      ELSE; n = nam(1:1);
+      END IF
+    END SUBROUTINE append
+
+  END FUNCTION dispTraSection
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  !=== CREATE TRACER(S) ALIAS: SCALAR/VECTOR FROM NAME(S) OR INDICE(S) ==========================================================
+  !==============================================================================================================================
+  LOGICAL FUNCTION aliasTracer(tname, trac, alias) RESULT(lerr)                  !=== TRACER NAMED "tname" - SCALAR
+    CHARACTER(LEN = *), INTENT(IN) :: tname
+    TYPE(trac_type), TARGET, INTENT(IN) :: trac(:)
+    TYPE(trac_type), POINTER, INTENT(OUT) :: alias
+    INTEGER :: it
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: tnames(:)
+    alias => NULL()
+    lerr = getKey('name', tnames, trac(:)%keys)
+    it = strIdx(tnames, tname)
+    lerr = it /= 0; IF(.NOT.lerr) alias => trac(it)
+  END FUNCTION aliasTracer
+  !==============================================================================================================================
+  LOGICAL FUNCTION trSubset_Indx(trac, idx, alias) RESULT(lerr)                  !=== TRACERS WITH INDICES "idx(:)" - VECTOR
+    TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
+    INTEGER, INTENT(IN) :: idx(:)
+    TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
+    alias = trac(idx)
+    lerr = indexUpdate(alias)
+  END FUNCTION trSubset_Indx
+  !------------------------------------------------------------------------------------------------------------------------------
+  LOGICAL FUNCTION trSubset_Name(trac, tname, alias) RESULT(lerr)                !=== TRACERS NAMED "tname(:)" - VECTOR
+    TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
+    CHARACTER(LEN = *), INTENT(IN) :: tname(:)
+    TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: tnames(:)
+    lerr = getKey('name', tnames, trac(:)%keys)
+    alias = trac(strIdx(tnames, tname))
+    lerr = indexUpdate(alias)
+  END FUNCTION trSubset_Name
+  !==============================================================================================================================
+  LOGICAL FUNCTION trSubset_gen0Name(trac, gen0Nm, alias) RESULT(lerr)           !=== TRACERS OF COMMON 1st GENERATION ANCESTOR
+    TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
+    CHARACTER(LEN = *), INTENT(IN) :: gen0Nm
+    TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: gen0N(:)
+    lerr = getKey('gen0Name', gen0N, trac(:)%keys)
+    alias = trac(strFind(delPhase(gen0N), gen0Nm))
+    lerr = indexUpdate(alias)
+  END FUNCTION trSubset_gen0Name
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  !=== UPDATE THE INDEXES iqParent, iqDescend AND iGeneration IN THE TRACERS DESCRIPTOR LIST "tr" (USEFULL FOR SUBSETS) =========
+  !==============================================================================================================================
+  LOGICAL FUNCTION indexUpdate(tr) RESULT(lerr)
+    TYPE(trac_type), INTENT(INOUT) :: tr(:)
+    INTEGER :: iq, jq, nq, ig, nGen
+    INTEGER, ALLOCATABLE :: iqDescen(:), ix(:), iy(:)
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: tnames(:), parent(:)
+    INTEGER, DIMENSION(SIZE(tr)) :: iqParent, iGen
+    lerr = getKey('name', tnames, tr%keys); IF(lerr) RETURN          !--- Names
+    lerr = getKey('parent', parent, tr%keys); IF(lerr) RETURN          !--- Parents
+    nq = SIZE(tr)
+
+    !=== iqParent, iGeneration
+    DO iq = 1, nq; iGen(iq) = 0; jq = iq
+    iqParent(iq) = strIdx(tnames, parent(iq))
+    DO; jq = strIdx(tnames, parent(jq)); IF(jq == 0) EXIT; iGen(iq) = iGen(iq) + 1;
+    END DO
+    CALL addKey('iqParent', parent(iq), tr(iq)%keys)
+    CALL addKey('iqGeneration', iGen(iq), tr(iq)%keys)
+    END DO
+
+    !=== nqChildren, iqDescen, nqDescen
+    nGen = MAXVAL(iGen, MASK = .TRUE.)
+    DO iq = 1, nq
+      ix = [iq]; ALLOCATE(iqDescen(0))
+      DO ig = iGen(iq) + 1, nGen
+        iy = find(iqParent, ix); iqDescen = [iqDescen, iy]; ix = iy
+        IF(ig /= iGen(iq) + 1) CYCLE
+        CALL addKey('nqChildren', SIZE(iqDescen), tr(iq)%keys)
+        tr(iq)%nqChildren = SIZE(iqDescen)
+      END DO
+      CALL addKey('iqDescen', strStack(int2str(iqDescen)), tr(iq)%keys)
+      CALL addKey('nqDescen', SIZE(iqDescen), tr(iq)%keys)
+      tr(iq)%iqDescen = iqDescen
+      tr(iq)%nqDescen = SIZE(iqDescen)
+      DEALLOCATE(iqDescen)
+    END DO
+  END FUNCTION indexUpdate
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  !=== READ FILE "fnam" TO APPEND THE "dBase" TRACERS DATABASE WITH AS MUCH SECTIONS AS PARENTS NAMES IN "isot(:)%parent":   ====
+  !===  * Each section dBase(i)%name contains the isotopes "dBase(i)%trac(:)" descending on "dBase(i)%name"="iso(i)%parent"  ====
+  !===  * For each isotopes class, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot"        ====
+  !=== NOTES:                                                                                                                ====
+  !===  * Most of the "isot" components have been defined in the calling routine (processIsotopes):                          ====
+  !===      parent,  nzone, zone(:),  niso, keys(:)%name,  ntiso, trac(:),  nphas, phas,  iqIsoPha(:,:),  itZonPhi(:,:)      ====
+  !===  * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes       ====
+  !===  * Each tracers section can contain a "params" virtual isotope line of isotopes parameters default values             ====
+  !===  * In case keys are found both in the "params" section and the "*.def" file, the later value is retained              ====
+  !===  * On each isotope line, defined keys can be used for other keys defintions (single level depth substitution)         ====
+  !===  * The routine gives an error if a required isotope is not available in the database stored in "fnam"                 ====
+  !==============================================================================================================================
+  LOGICAL FUNCTION readIsotopesFile(fnam, isot) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: fnam                     !--- Input file name
+    TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:)                  !--- Isotopes descriptors (field %parent must be defined!)
+    LOGICAL :: lFound
+    INTEGER :: is, iis, it, idb, ndb, nb0
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: vals(:)
+    CHARACTER(LEN = maxlen) :: modname
+    TYPE(trac_type), POINTER :: tt(:), t
+    TYPE(dataBase_type), ALLOCATABLE :: tdb(:)
+    modname = 'readIsotopesFile'
+
+    !--- THE INPUT FILE MUST BE PRESENT
+    INQUIRE(FILE = TRIM(fnam), EXIST = lFound); lerr = .NOT.lFound
+    IF(fmsg('Missing isotopes parameters file "' // TRIM(fnam) // '"', modname, lerr)) RETURN
+
+    !--- READ THE FILE SECTIONS, ONE EACH PARENT TRACER
+    nb0 = SIZE(dBase, DIM = 1) + 1                                         !--- Next database element index
+    lerr = readSections(fnam, strStack(isot(:)%parent, '|')); IF(lerr) RETURN !--- Read sections, one each parent tracer
+    ndb = SIZE(dBase, DIM = 1)                                           !--- Current database size
+    DO idb = nb0, ndb
+      iis = idb - nb0 + 1
+
+      !--- GET FEW GLOBAL KEYS FROM "def" FILES AND ADD THEM TO THE 'params' SECTION
+      CALL addKeysFromDef(dBase(idb)%trac, 'params')
+
+      !--- SUBSTITUTE THE KEYS DEFINED IN THE 'params' VIRTUAL TRACER ; SUBSTITUTE LOCAL KEYS ; REMOVE 'params' VIRTUAL TRACER
+      CALL subDefault(dBase(idb)%trac, 'params', .TRUE.)
+
+      tt => dBase(idb)%trac
+
+      !--- REDUCE THE EXPRESSIONS TO OBTAIN SCALARS AND TRANSFER THEM TO THE "isot" ISOTOPES DESCRIPTORS VECTOR
+      DO it = 1, SIZE(dBase(idb)%trac)
+        t => dBase(idb)%trac(it)
+        is = strIdx(isot(iis)%keys(:)%name, t%name)                    !--- Index in "isot(iis)%keys(:)%name" of isotope "t%name"
+        IF(is == 0) CYCLE
+        lerr = ANY(reduceExpr(t%keys%val, vals)); IF(lerr) RETURN      !--- Reduce expressions ; detect non-numerical elements
+        isot(iis)%keys(is)%key = t%keys%key
+        isot(iis)%keys(is)%val = vals
+      END DO
+
+      !--- CHECK FOR MISSING ISOTOPES (NO KEYS ALLOCATED)
+      lerr = checkList(isot(iis)%keys(:)%name, .NOT.[(ALLOCATED(isot(iis)%keys(is)%key), is = 1, SIZE(isot(iis)%keys))], &
+              'Check file "' // TRIM(fnam) // '" in section "' // TRIM(dBase(idb)%name) // '"', 'isotopes', 'missing')
+      IF(lerr) RETURN
+    END DO
+
+    !--- CLEAN THE DATABASE ENTRIES
+    IF(nb0 == 1) THEN
+      DEALLOCATE(dBase); ALLOCATE(dBase(0))
+    ELSE
+      ALLOCATE(tdb(nb0 - 1)); tdb(1:nb0 - 1) = dBase(1:nb0 - 1); CALL MOVE_ALLOC(FROM = tdb, TO = dBase)
+    END IF
+
+    !--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
+    CALL get_in('ok_iso_verif', isot(strIdx(isot%parent, 'H2O'))%check, .FALSE.)
+
+    lerr = dispIsotopes()
+
+  CONTAINS
+
+    !------------------------------------------------------------------------------------------------------------------------------
+    LOGICAL FUNCTION dispIsotopes() RESULT(lerr)
+      INTEGER :: ik, nk, ip, it, nt
+      CHARACTER(LEN = maxlen) :: prf
+      CHARACTER(LEN = maxlen), ALLOCATABLE :: ttl(:), val(:, :)
+      CALL msg('Isotopes parameters read from file "' // TRIM(fnam) // '":', modname)
+      DO ip = 1, SIZE(isot)                                              !--- Loop on parents tracers
+        nk = SIZE(isot(ip)%keys(1)%key)                                  !--- Same keys for each isotope
+        nt = SIZE(isot(ip)%keys)                                         !--- Number of isotopes
+        prf = 'i' // REPEAT('s', nk + 1)                                      !--- Profile for table printing
+        ALLOCATE(ttl(nk + 2), val(nt, nk + 1))
+        ttl(1:2) = ['it  ', 'name']; ttl(3:nk + 2) = isot(ip)%keys(1)%key(:)!--- Titles line with keys names
+        val(:, 1) = isot(ip)%keys(:)%name                                 !--- Values table 1st column: isotopes names
+        DO ik = 1, nk
+          DO it = 1, nt
+            val(it, ik + 1) = isot(ip)%keys(it)%val(ik)                     !--- Other columns: keys values
+          END DO
+        END DO
+        lerr = dispTable(prf, ttl, val, cat([(it, it = 1, nt)]), rFmt = '(EN8.4)', nColMax = maxTableWidth, nHead = 2, sub = modname)
+        IF(fmsg('Problem with the table content', modname, lerr)) RETURN
+        DEALLOCATE(ttl, val)
+      END DO
+    END FUNCTION dispIsotopes
+    !------------------------------------------------------------------------------------------------------------------------------
+
+  END FUNCTION readIsotopesFile
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  !=== IF ISOTOPES (2ND GENERATION TRACERS) ARE DETECTED:                                                                     ===
+  !===    * COMPUTE MOST OF THE RELATED QUANTITIES ("isot" COMPONENTS).                                                       ===
+  !===    * COMPUTE FEW ISOTOPES-DEDICATED "trac" COMPONENTS                                                                  ===
+  !===    * CALL readIsotopesFile TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS)                                              ===
+  !===      NOTE: THIS IS DONE HERE (IN A ROUTINE CALLED BY THE DYNAMIC), BECAUSE THE DYNAMIC NEEDS FEW PHYSICAL PARAMETERS.  ===
+  !==============================================================================================================================
+  LOGICAL FUNCTION processIsotopes(iNames) RESULT(lerr)
+    CHARACTER(LEN = maxlen), TARGET, OPTIONAL, INTENT(IN) :: iNames(:)
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: p(:), str(:)                 !--- Temporary storage
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: tname(:), parent(:), dType(:), phase(:), gen0N(:)
+    CHARACTER(LEN = maxlen) :: iName, modname
+    CHARACTER(LEN = 1) :: ph                                           !--- Phase
+    INTEGER, ALLOCATABLE :: iGen(:)
+    INTEGER :: ic, ip, iq, it, iz
+    LOGICAL, ALLOCATABLE :: ll(:)                                      !--- Mask
+    TYPE(trac_type), POINTER :: t(:), t1
+    TYPE(isot_type), POINTER :: i
+
+    lerr = .FALSE.
+    modname = 'readIsotopesFile'
+
+    t => tracers
+
+    lerr = getKey('name', tname, t%keys); IF(lerr) RETURN       !--- Names
+    lerr = getKey('parent', parent, t%keys); IF(lerr) RETURN       !--- Parents
+    lerr = getKey('type', dType, t%keys); IF(lerr) RETURN       !--- Tracer type
+    lerr = getKey('phase', phase, t%keys); IF(lerr) RETURN       !--- Phase
+    lerr = getKey('gen0Name', gen0N, t%keys); IF(lerr) RETURN       !--- 1st generation ancestor name
+    lerr = getKey('iGeneration', iGen, t%keys); IF(lerr) RETURN       !--- Generation number
+
+    !--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES
+    p = PACK(delPhase(parent), MASK = dType=='tracer' .AND. iGen==1)
+    CALL strReduce(p, nbIso)
+
+    !--- CHECK WHETHER NEEDED ISOTOPES CLASSES "iNames" ARE AVAILABLE OR NOT
+    IF(PRESENT(iNames)) THEN
+      DO it = 1, SIZE(iNames)
+        lerr = ALL(p /= iNames(it))
+        IF(fmsg('No isotopes class "' // TRIM(iNames(it)) // '" found among tracers', modname, lerr)) RETURN
+      END DO
+      p = iNames; nbIso = SIZE(p)
+    END IF
+    IF(ALLOCATED(isotopes)) DEALLOCATE(isotopes)
+    ALLOCATE(isotopes(nbIso))
+
+    IF(nbIso==0) RETURN                                                !=== NO ISOTOPES: FINISHED
+
+    !--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES
+    isotopes(:)%parent = p
+    DO ic = 1, SIZE(p)                                                 !--- Loop on isotopes classes
+      i => isotopes(ic)
+      iname = i%parent                                                 !--- Current isotopes class name (parent tracer name)
+
+      !=== Isotopes children of tracer "iname": mask, names, number (same for each phase of "iname")
+      ll = dType=='tracer' .AND. delPhase(parent) == iname .AND. phase == 'g'
+      str = PACK(delPhase(tname), MASK = ll)                           !--- Effectively found isotopes of "iname"
+      i%niso = SIZE(str)                                               !--- Number of "effectively found isotopes of "iname"
+      ALLOCATE(i%keys(i%niso))
+      FORALL(it = 1:i%niso) i%keys(it)%name = str(it)
+
+      !=== Geographic tagging tracers descending on tracer "iname": mask, names, number
+      ll = dType=='tag'    .AND. delPhase(gen0N) == iname .AND. iGen == 2
+      i%zone = PACK(strTail(tname, '_', .TRUE.), MASK = ll)              !--- Tagging zones names  for isotopes category "iname"
+      CALL strReduce(i%zone)
+      i%nzone = SIZE(i%zone)                                           !--- Tagging zones number for isotopes category "iname"
+
+      !=== Geographic tracers of the isotopes children of tracer "iname" (same for each phase of "iname")
+      !    NOTE: One might like to create a similar variable for 2nd generation tagging tracers (tagging the gen1 tracers)
+      str = PACK(delPhase(tname), MASK = ll)
+      CALL strReduce(str)
+      i%ntiso = i%niso + SIZE(str)                                     !--- Number of isotopes + their geographic tracers [ntiso]
+      ALLOCATE(i%trac(i%ntiso))
+      FORALL(it = 1:i%niso) i%trac(it) = i%keys(it)%name
+      FORALL(it = i%niso + 1:i%ntiso) i%trac(it) = str(it - i%niso)
+
+      !=== Phases for tracer "iname"
+      i%phase = ''
+      DO ip = 1, nphases; ph = known_phases(ip:ip); IF(strIdx(t%name, addPhase(iname, ph)) /= 0) i%phase = TRIM(i%phase) // ph;
+      END DO
+      i%nphas = LEN_TRIM(i%phase)                                       !--- Equal to "nqo" for water
+
+      !=== Tables giving the index in a table of effectively found items for each dynamical tracer (1<=iq<=nqtot)
+      DO iq = 1, SIZE(t)
+        t1 => tracers(iq)
+        IF(delPhase(t1%gen0Name)/=iname .OR. t1%iGeneration==0) CYCLE  !--- Only deal with tracers descending on "iname"
+        t1%iso_iGroup = ic                                             !--- Isotopes family       idx in list "isotopes(:)%parent"
+        t1%iso_iName = strIdx(i%trac, strHead(delPhase(t1%name), '_', .TRUE.)) !--- Current isotope       idx in effective isotopes list
+        t1%iso_iZone = strIdx(i%zone, strTail(t1%name, '_', .TRUE.)) !--- Current isotope zone  idx in effective zones    list
+        t1%iso_iPhase = INDEX(i%phase, TRIM(t1%phase))                 !--- Current isotope phase idx in effective phases   list
+        IF(t1%iGeneration /= 2) t1%iso_iZone = 0                       !--- Skip possible generation 1 tagging tracers
+      END DO
+
+      !=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
+      !    (including tagging tracers) is sorted this way:  iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
+      i%iqIsoPha = RESHAPE([((strIdx(t%name, addPhase(i%trac(it), i%phase(ip:ip))), it = 1, i%ntiso), ip = 1, i%nphas)], &
+              [i%ntiso, i%nphas])
+      !=== Table used to get iq (index in dyn array, size nqtot) from the water and isotope and phase indexes ; the full isotopes list
+      !    (including tagging tracers) is sorted this way:  iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
+      i%iqWIsoPha = RESHAPE([([strIdx(t%name, addPhase('H2O', i%phase(ip:ip))), i%iqIsoPha(:, ip)], ip = 1, i%nphas)], &
+              [1 + i%ntiso, i%nphas])
+      !=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes
+      i%itZonIso = RESHAPE([((strIdx(i%trac(:), TRIM(i%trac(it)) // '_' // TRIM(i%zone(iz))), iz = 1, i%nzone), it = 1, i%niso)], &
+              [i%nzone, i%niso])
+    END DO
+
+    !=== READ PHYSICAL PARAMETERS FROM isoFile FILE
+    !  lerr = readIsotopesFile(isoFile, isotopes); IF(lerr) RETURN! on commente pour ne pas chercher isotopes_params.def
+
+    !--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
+    CALL get_in('ok_iso_verif', isoCheck, .TRUE.)
+
+    !=== CHECK CONSISTENCY
+    lerr = testIsotopes(); IF(lerr) RETURN
+
+    !=== SELECT WATER ISOTOPES CLASS OR, IF UNFOUND, THE FIRST ISOTOPES CLASS
+    IF(isoSelect('H2O', .TRUE.)) THEN; iH2O = ixIso;
+    ELSE; lerr = isoSelect(1, .TRUE.);
+    END IF
+
+  CONTAINS
+
+    !------------------------------------------------------------------------------------------------------------------------------
+    LOGICAL FUNCTION testIsotopes() RESULT(lerr)     !--- MAKE SURE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES
+      !------------------------------------------------------------------------------------------------------------------------------
+      INTEGER :: ix, it, ip, np, iz, nz, npha, nzon
+      TYPE(isot_type), POINTER :: i
+      DO ix = 1, nbIso
+        i => isotopes(ix)
+        !--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases
+        DO it = 1, i%ntiso; npha = i%nphas
+        np = SUM([(COUNT(tracers(:)%name == addPhase(i%trac(it), i%phase(ip:ip))), ip = 1, npha)])
+        lerr = np /= npha
+        CALL msg(TRIM(int2str(np)) // ' phases instead of ' // TRIM(int2str(npha)) // ' for ' // TRIM(i%trac(it)), modname, lerr)
+        IF(lerr) RETURN
+        END DO
+        DO it = 1, i%niso; nzon = i%nzone
+        nz = SUM([(COUNT(i%trac == TRIM(i%trac(it)) // '_' // i%zone(iz)), iz = 1, nzon)])
+        lerr = nz /= nzon
+        CALL msg(TRIM(int2str(nz)) // ' tagging zones instead of ' // TRIM(int2str(nzon)) // ' for ' // TRIM(i%trac(it)), modname, lerr)
+        IF(lerr) RETURN
+        END DO
+      END DO
+    END FUNCTION testIsotopes
+    !------------------------------------------------------------------------------------------------------------------------------
+
+  END FUNCTION processIsotopes
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  !=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
+  !     Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call).
+  !==============================================================================================================================
+  LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
+    IMPLICIT NONE
+    CHARACTER(LEN = *), INTENT(IN) :: iName
+    LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
+    INTEGER :: iIso
+    LOGICAL :: lV
+    lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
+    iIso = strIdx(isotopes(:)%parent, iName)
+    lerr = iIso == 0
+    IF(lerr) THEN
+      niso = 0; ntiso = 0; nzone = 0; nphas = 0; isoCheck = .FALSE.
+      CALL msg('no isotope family named "' // TRIM(iName) // '"', ll = lV)
+      RETURN
+    END IF
+    lerr = isoSelectByIndex(iIso, lV)
+  END FUNCTION isoSelectByName
+  !==============================================================================================================================
+  LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
+    IMPLICIT NONE
+    INTEGER, INTENT(IN) :: iIso
+    LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
+    LOGICAL :: lV
+    lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
+    lerr = .FALSE.
+    IF(iIso == ixIso) RETURN                                          !--- Nothing to do if the index is already OK
+    lerr = iIso<=0 .OR. iIso>SIZE(isotopes)
+    CALL msg('Inconsistent isotopes family index ' // TRIM(int2str(iIso)) // ': should be > 0 and <= '&
+            // TRIM(int2str(SIZE(isotopes))) // '"', ll = lerr .AND. lV)
+    IF(lerr) RETURN
+    ixIso = iIso                                                      !--- Update currently selected family index
+    isotope => isotopes(ixIso)                                       !--- Select corresponding component
+    isoKeys => isotope%keys;     niso = isotope%niso
+    isoName => isotope%trac;     ntiso = isotope%ntiso
+    isoZone => isotope%zone;     nzone = isotope%nzone
+    isoPhas => isotope%phase;    nphas = isotope%nphas
+    itZonIso => isotope%itZonIso; isoCheck = isotope%check
+    iqIsoPha => isotope%iqIsoPha
+    iqWIsoPha => isotope%iqWIsoPha
+  END FUNCTION isoSelectByIndex
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  !=== ADD THE <key>=<val> PAIR TO THE "ky[(:)]" KEY[S] DESCRIPTOR[S] OR THE <key>=<val(:)> PAIRS TO THE "ky(:)" KEYS DESCRIPTORS
+  !==============================================================================================================================
+  SUBROUTINE addKey_s11(key, sval, ky, lOverWrite)
+    CHARACTER(LEN = *), INTENT(IN) :: key, sval
+    TYPE(keys_type), INTENT(INOUT) :: ky
+    LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: k(:), v(:)
+    INTEGER :: iky, nky
+    LOGICAL :: lo
+    lo = .TRUE.; IF(PRESENT(lOverWrite)) lo = lOverWrite
+    IF(.NOT.ALLOCATED(ky%key)) THEN
+      ALLOCATE(ky%key(1)); ky%key(1) = key
+      ALLOCATE(ky%val(1)); ky%val(1) = sval
+      RETURN
+    END IF
+    iky = strIdx(ky%key, key)
+    IF(iky == 0) THEN
+      nky = SIZE(ky%key)
+      ALLOCATE(k(nky + 1)); k(1:nky) = ky%key; k(nky + 1) = key;  ky%key = k
+      ALLOCATE(v(nky + 1)); v(1:nky) = ky%val; v(nky + 1) = sval; ky%val = v
+    ELSE IF(lo) THEN
+      ky%key(iky) = key; ky%val(iky) = sval
+    END IF
+  END SUBROUTINE addKey_s11
+  !==============================================================================================================================
+  SUBROUTINE addKey_i11(key, ival, ky, lOverWrite)
+    CHARACTER(LEN = *), INTENT(IN) :: key
+    INTEGER, INTENT(IN) :: ival
+    TYPE(keys_type), INTENT(INOUT) :: ky
+    LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
+    !------------------------------------------------------------------------------------------------------------------------------
+    CALL addKey_s11(key, int2str(ival), ky, lOverWrite)
+  END SUBROUTINE addKey_i11
+  !==============================================================================================================================
+  SUBROUTINE addKey_r11(key, rval, ky, lOverWrite)
+    CHARACTER(LEN = *), INTENT(IN) :: key
+    REAL, INTENT(IN) :: rval
+    TYPE(keys_type), INTENT(INOUT) :: ky
+    LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
+    !------------------------------------------------------------------------------------------------------------------------------
+    CALL addKey_s11(key, real2str(rval), ky, lOverWrite)
+  END SUBROUTINE addKey_r11
+  !==============================================================================================================================
+  SUBROUTINE addKey_l11(key, lval, ky, lOverWrite)
+    CHARACTER(LEN = *), INTENT(IN) :: key
+    LOGICAL, INTENT(IN) :: lval
+    TYPE(keys_type), INTENT(INOUT) :: ky
+    LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
+    !------------------------------------------------------------------------------------------------------------------------------
+    CALL addKey_s11(key, bool2str(lval), ky, lOverWrite)
+  END SUBROUTINE addKey_l11
+  !==============================================================================================================================
+  !==============================================================================================================================
+  SUBROUTINE addKey_s1m(key, sval, ky, lOverWrite)
+    CHARACTER(LEN = *), INTENT(IN) :: key, sval
+    TYPE(keys_type), INTENT(INOUT) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: itr
+    DO itr = 1, SIZE(ky); CALL addKey_s11(key, sval, ky(itr), lOverWrite);
+    END DO
+  END SUBROUTINE addKey_s1m
+  !==============================================================================================================================
+  SUBROUTINE addKey_i1m(key, ival, ky, lOverWrite)
+    CHARACTER(LEN = *), INTENT(IN) :: key
+    INTEGER, INTENT(IN) :: ival
+    TYPE(keys_type), INTENT(INOUT) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: itr
+    DO itr = 1, SIZE(ky); CALL addKey_s11(key, int2str(ival), ky(itr), lOverWrite);
+    END DO
+  END SUBROUTINE addKey_i1m
+  !==============================================================================================================================
+  SUBROUTINE addKey_r1m(key, rval, ky, lOverWrite)
+    CHARACTER(LEN = *), INTENT(IN) :: key
+    REAL, INTENT(IN) :: rval
+    TYPE(keys_type), INTENT(INOUT) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: itr
+    DO itr = 1, SIZE(ky); CALL addKey_s11(key, real2str(rval), ky(itr), lOverWrite);
+    END DO
+  END SUBROUTINE addKey_r1m
+  !==============================================================================================================================
+  SUBROUTINE addKey_l1m(key, lval, ky, lOverWrite)
+    CHARACTER(LEN = *), INTENT(IN) :: key
+    LOGICAL, INTENT(IN) :: lval
+    TYPE(keys_type), INTENT(INOUT) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: itr
+    DO itr = 1, SIZE(ky); CALL addKey_s11(key, bool2str(lval), ky(itr), lOverWrite);
+    END DO
+  END SUBROUTINE addKey_l1m
+  !==============================================================================================================================
+  !==============================================================================================================================
+  SUBROUTINE addKey_smm(key, sval, ky, lOverWrite)
+    CHARACTER(LEN = *), INTENT(IN) :: key, sval(:)
+    TYPE(keys_type), INTENT(INOUT) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: itr
+    DO itr = 1, SIZE(ky); CALL addKey_s11(key, sval(itr), ky(itr), lOverWrite);
+    END DO
+  END SUBROUTINE addKey_smm
+  !==============================================================================================================================
+  SUBROUTINE addKey_imm(key, ival, ky, lOverWrite)
+    CHARACTER(LEN = *), INTENT(IN) :: key
+    INTEGER, INTENT(IN) :: ival(:)
+    TYPE(keys_type), INTENT(INOUT) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: itr
+    DO itr = 1, SIZE(ky); CALL addKey_s11(key, int2str(ival(itr)), ky(itr), lOverWrite);
+    END DO
+  END SUBROUTINE addKey_imm
+  !==============================================================================================================================
+  SUBROUTINE addKey_rmm(key, rval, ky, lOverWrite)
+    CHARACTER(LEN = *), INTENT(IN) :: key
+    REAL, INTENT(IN) :: rval(:)
+    TYPE(keys_type), INTENT(INOUT) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: itr
+    DO itr = 1, SIZE(ky); CALL addKey_s11(key, real2str(rval(itr)), ky(itr), lOverWrite);
+    END DO
+  END SUBROUTINE addKey_rmm
+  !==============================================================================================================================
+  SUBROUTINE addKey_lmm(key, lval, ky, lOverWrite)
+    CHARACTER(LEN = *), INTENT(IN) :: key
+    LOGICAL, INTENT(IN) :: lval(:)
+    TYPE(keys_type), INTENT(INOUT) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: itr
+    DO itr = 1, SIZE(ky); CALL addKey_s11(key, bool2str(lval(itr)), ky(itr), lOverWrite);
+    END DO
+  END SUBROUTINE addKey_lmm
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  !=== OVERWRITE THE KEYS OF THE TRACER NAMED "tr0" WITH THE VALUES FOUND IN THE *.def FILES, IF ANY. ===========================
+  !==============================================================================================================================
+  SUBROUTINE addKeysFromDef(t, tr0)
+    TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: t(:)
+    CHARACTER(LEN = *), INTENT(IN) :: tr0
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: val
+    INTEGER :: ik, jd
+    jd = strIdx(t%name, tr0)
+    IF(jd == 0) RETURN
+    DO ik = 1, SIZE(t(jd)%keys%key)
+      CALL get_in(t(jd)%keys%key(ik), val, '*none*')
+      IF(val /= '*none*') CALL addKey(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.)
+    END DO
+  END SUBROUTINE addKeysFromDef
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  !=== REMOVE THE KEYS NAMED "keyn(:)" FROM EITHER THE "itr"th OR ALL THE KEYS DESCRIPTORS OF "ky(:)" ===========================
+  !==============================================================================================================================
+  SUBROUTINE delKey_1(itr, keyn, ky)
+    INTEGER, INTENT(IN) :: itr
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
+    TYPE(trac_type), INTENT(INOUT) :: ky(:)
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: k(:), v(:)
+    LOGICAL, ALLOCATABLE :: ll(:)
+    INTEGER :: iky
+    IF(itr<=0 .OR. itr>SIZE(ky, DIM = 1)) RETURN                          !--- Index is out of range
+    ll = [(ALL(keyn/=ky(itr)%keys%key(iky)), iky = 1, SIZE(ky(itr)%keys%key))]
+    k = PACK(ky(itr)%keys%key, MASK = ll); CALL MOVE_ALLOC(FROM = k, TO = ky(itr)%keys%key)
+    v = PACK(ky(itr)%keys%val, MASK = ll); CALL MOVE_ALLOC(FROM = v, TO = ky(itr)%keys%val)
+  END SUBROUTINE delKey_1
+  !==============================================================================================================================
+  SUBROUTINE delKey(keyn, ky)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
+    TYPE(trac_type), INTENT(INOUT) :: ky(:)
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: iky
+    DO iky = 1, SIZE(ky); CALL delKey_1(iky, keyn, ky);
+    END DO
+  END SUBROUTINE delKey
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  !===   INTERNAL FUNCTION: GET THE VALUE OF A KEY FOR "itr"th TRACER FROM A "keys_type" DERIVED TYPE AND RETURN THE RESULT   ===
+  !===   IF keyn CONTAINS SEVERAL ELEMENTS, TRY WITH EACH ELEMENT ONE AFTER THE OTHER                                         ===
+  !==============================================================================================================================
+  CHARACTER(LEN = maxlen) FUNCTION fgetKeyIdx(itr, keyn, ky, lerr) RESULT(val)
+    INTEGER, INTENT(IN) :: itr
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
+    TYPE(keys_type), INTENT(IN) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(OUT) :: lerr
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: ik
+    LOGICAL :: ler
+    ler = .TRUE.
+    DO ik = 1, SIZE(keyn)
+      CALL getKeyIdx(keyn(ik)); IF(.NOT.ler) EXIT
+    END DO
+    IF(PRESENT(lerr)) lerr = ler
+
+  CONTAINS
+
+    SUBROUTINE getKeyIdx(keyn)
+      CHARACTER(LEN = *), INTENT(IN) :: keyn
+      !------------------------------------------------------------------------------------------------------------------------------
+      INTEGER :: iky
+      iky = 0; val = ''
+      ler = itr <= 0 .OR. itr > SIZE(ky); IF(ler) RETURN
+      iky = strIdx(ky(itr)%key(:), keyn)
+      ler = iky == 0;                     IF(ler) RETURN
+      val = ky(itr)%val(iky)
+    END SUBROUTINE getKeyIdx
+
+  END FUNCTION fgetKeyIdx
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  !===                                          GET KEYS VALUES FROM TRACERS INDICES                                          ===
+  !==============================================================================================================================
+  !=== TRY TO GET THE KEY NAMED "key" FOR THE "itr"th TRACER IN:                                                              ===
+  !===  * ARGUMENT "ky" DATABASE IF SPECIFIED ; OTHERWISE:                                                                    ===
+  !===  * IN INTERNAL TRACERS DATABASE "tracers(:)%keys" (IF UNFOUND, IN INTERNAL ISOTOPES DATABASE "isotope%keys(:)")        ===
+  !=== THE RETURNED VALUE (STRING, AN INTEGER, A REAL OR A LOGICAL) CAN BE EITHER:                                            ===
+  !===  * A SCALAR                                                                                                            ===
+  !===  * A VECTOR, WHICH IS THE FOUND VALUE PARSED WITH THE SEPARATOR ","                                                    ===
+  !===                                                                                                                        ===
+  !=== SYNTAX:       lerr = getKeyByIndex_{sirl}{1m}{1m}1(keyn[(:)], val[(:)], itr[, ky(:)]          [, def][, lDisp])        ===
+  !==============================================================================================================================
+  !=== IF "itr" IS NOT PRESENT, VALUES FOR ALL THE TRACERS OF THE SELECTED DATABASE ARE STORED IN THE VECTOR "val(:)"         ===
+  !=== THE NAME OF THE TRACERS FOUND IN THE EFFECTIVELY USED DATABASE CAN BE RETURNED OPTIONALLY IN "nam(:)"                  ===
+  !=== SYNTAX        lerr = getKeyByIndex_{sirl}{1m}mm   (keyn[(:)], val (:)      [, ky(:)][, nam(:)][, def][, lDisp])        ===
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_s111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn
+    CHARACTER(LEN = maxlen), INTENT(OUT) :: val
+    INTEGER, INTENT(IN) :: itr
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    lerr = getKeyByIndex_sm11([keyn], val, itr, ky, def, lDisp)
+  END FUNCTION getKeyByIndex_s111
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_i111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn
+    INTEGER, INTENT(OUT) :: val
+    INTEGER, INTENT(IN) :: itr
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    INTEGER, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    lerr = getKeyByIndex_im11([keyn], val, itr, ky, def, lDisp)
+  END FUNCTION getKeyByIndex_i111
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_r111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn
+    REAL, INTENT(OUT) :: val
+    INTEGER, INTENT(IN) :: itr
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    REAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    lerr = getKeyByIndex_rm11([keyn], val, itr, ky, def, lDisp)
+  END FUNCTION getKeyByIndex_r111
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_l111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn
+    LOGICAL, INTENT(OUT) :: val
+    INTEGER, INTENT(IN) :: itr
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    lerr = getKeyByIndex_lm11([keyn], val, itr, ky, def, lDisp)
+  END FUNCTION getKeyByIndex_l111
+  !==============================================================================================================================
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_sm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
+    CHARACTER(LEN = maxlen), INTENT(OUT) :: val
+    INTEGER, INTENT(IN) :: itr
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: s
+    LOGICAL :: lD
+    lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" for tracer nr. ' // TRIM(int2str(itr))
+    lerr = .TRUE.
+    IF(lerr .AND. PRESENT(ky))         val = fgetKey(ky)                                   !--- "ky"
+    IF(lerr .AND. ALLOCATED (tracers)) val = fgetKey(tracers(:)%keys)                      !--- "tracers"
+    IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:))                      !--- "isotope"
+    IF(lerr .AND. PRESENT(def)) THEN
+      val = def; lerr = .NOT.PRESENT(def)
+      CALL msg('Using defaut value of ' // TRIM(s) // ': ' // TRIM(def), modname, lD)
+    END IF
+    CALL msg('No ' // TRIM(s) // ' or out of bounds index', modname, lD .AND. lerr)
+
+  CONTAINS
+
+    CHARACTER(LEN = maxlen) FUNCTION fgetKey(ky) RESULT(val)
+      TYPE(keys_type), INTENT(IN) :: ky(:)
+      lerr = SIZE(ky) == 0; IF(lerr) RETURN
+      val = fgetKeyIdx(itr, keyn(:), ky, lerr)
+    END FUNCTION fgetKey
+
+  END FUNCTION getKeyByIndex_sm11
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_im11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
+    INTEGER, INTENT(OUT) :: val
+    INTEGER, INTENT(IN) :: itr
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    INTEGER, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    IF(PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, int2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    val = str2int(sval)
+    lerr = val == -HUGE(1)
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
+    CALL msg(TRIM(s) // ' an integer: ' // TRIM(sval), modname, lerr)
+  END FUNCTION getKeyByIndex_im11
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_rm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
+    REAL, INTENT(OUT) :: val
+    INTEGER, INTENT(IN) :: itr
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    REAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    IF(PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, real2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    val = str2real(sval)
+    lerr = val == -HUGE(1.)
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
+    CALL msg(TRIM(s) // ' a real: ' // TRIM(sval), modname, lerr)
+  END FUNCTION getKeyByIndex_rm11
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_lm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
+    LOGICAL, INTENT(OUT) :: val
+    INTEGER, INTENT(IN) :: itr
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    INTEGER :: ival
+    IF(PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, bool2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    ival = str2bool(sval)
+    lerr = ival == -1
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
+    CALL msg(TRIM(s) // ' a boolean: ' // TRIM(sval), modname, lerr)
+    IF(.NOT.lerr) val = ival == 1
+  END FUNCTION getKeyByIndex_lm11
+  !==============================================================================================================================
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_s1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn
+    CHARACTER(LEN = maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
+    INTEGER, INTENT(IN) :: itr
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval
+    lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, def, lDisp); IF(lerr) RETURN
+    lerr = strParse(sval, ',', val)
+    IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
+  END FUNCTION getKeyByIndex_s1m1
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_i1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn
+    INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
+    INTEGER, INTENT(IN) :: itr
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    INTEGER, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
+    IF(PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, int2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    lerr = strParse(sval, ',', svals)
+    IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
+    val = str2int(svals)
+    lerr = ANY(val == -HUGE(1))
+    s = 'key "' // TRIM(keyn) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
+    CALL msg(TRIM(s) // ' an integer: ' // TRIM(sval), modname, lerr)
+  END FUNCTION getKeyByIndex_i1m1
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_r1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn
+    REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
+    INTEGER, INTENT(IN) :: itr
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    REAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
+    IF(PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, real2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp = lDisp)
+    lerr = strParse(sval, ',', svals)
+    IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
+    val = str2real(svals)
+    lerr = ANY(val == -HUGE(1.))
+    s = 'key "' // TRIM(keyn) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
+    CALL msg(TRIM(s) // ' a real: ' // TRIM(sval), modname, lerr)
+  END FUNCTION getKeyByIndex_r1m1
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_l1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn
+    LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
+    INTEGER, INTENT(IN) :: itr
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
+    INTEGER, ALLOCATABLE :: ivals(:)
+    IF(PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, bool2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp = lDisp)
+    lerr = strParse(sval, ',', svals)
+    IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
+    ivals = str2bool(svals)
+    lerr = ANY(ivals == -1)
+    s = 'key "' // TRIM(keyn) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
+    CALL msg(TRIM(s) // ' a boolean: ' // TRIM(sval), modname, lerr)
+    IF(.NOT.lerr) val = ivals == 1
+  END FUNCTION getKeyByIndex_l1m1
+  !==============================================================================================================================
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_smm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
+    CHARACTER(LEN = maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
+    INTEGER, INTENT(IN) :: itr
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval
+    lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, def, lDisp); IF(lerr) RETURN
+    lerr = strParse(sval, ',', val)
+    IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
+  END FUNCTION getKeyByIndex_smm1
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_imm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
+    INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
+    INTEGER, INTENT(IN) :: itr
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    INTEGER, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
+    IF(PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, int2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    lerr = strParse(sval, ',', svals)
+    IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
+    val = str2int(svals)
+    lerr = ANY(val == -HUGE(1))
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
+    CALL msg(TRIM(s) // ' an integer: ' // TRIM(sval), modname, lerr)
+  END FUNCTION getKeyByIndex_imm1
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_rmm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
+    REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
+    INTEGER, INTENT(IN) :: itr
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    REAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
+    IF(PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, real2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    lerr = strParse(sval, ',', svals)
+    IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
+    val = str2real(svals)
+    lerr = ANY(val == -HUGE(1.))
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
+    CALL msg(TRIM(s) // ' a real: ' // TRIM(sval), modname, lerr)
+  END FUNCTION getKeyByIndex_rmm1
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_lmm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
+    LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
+    INTEGER, INTENT(IN) :: itr
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
+    INTEGER, ALLOCATABLE :: ivals(:)
+    IF(PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, bool2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    lerr = strParse(sval, ',', svals)
+    IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
+    ivals = str2bool(svals)
+    lerr = ANY(ivals == -1)
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of tracer nr. ' // TRIM(int2str(itr)) // ' is not'
+    CALL msg(TRIM(s) // ' a boolean: ' // TRIM(sval), modname, lerr)
+    IF(.NOT.lerr) val = ivals == 1
+  END FUNCTION getKeyByIndex_lmm1
+  !==============================================================================================================================
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_s1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn
+    CHARACTER(LEN = maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    lerr = getKeyByIndex_smmm([keyn], val, ky, nam, def, lDisp)
+  END FUNCTION getKeyByIndex_s1mm
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_i1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn
+    INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
+    INTEGER, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    lerr = getKeyByIndex_immm([keyn], val, ky, nam, def, lDisp)
+  END FUNCTION getKeyByIndex_i1mm
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_r1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn
+    REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
+    REAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    lerr = getKeyByIndex_rmmm([keyn], val, ky, nam, def, lDisp)
+  END FUNCTION getKeyByIndex_r1mm
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_l1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn
+    LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    lerr = getKeyByIndex_lmmm([keyn], val, ky, nam, def, lDisp)
+  END FUNCTION getKeyByIndex_l1mm
+  !==============================================================================================================================
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_smmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
+    CHARACTER(LEN = maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: tname(:)
+    INTEGER :: iq, nq(3), k
+    LOGICAL :: lD, l(3)
+    lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '"'
+    lerr = .TRUE.
+    IF(PRESENT(ky)) THEN;                 val = fgetKey(ky)                                !--- "ky"
+    ELSE IF(ALLOCATED(tracers)) THEN;     val = fgetKey(tracers(:)%keys)                   !--- "tracers"
+    IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:))                   !--- "isotope"
+    END IF
+    IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN;
+    END IF
+    IF(.NOT.PRESENT(def)) THEN; CALL msg('No ' // TRIM(s) // ' found', modname, lD); RETURN;
+    END IF
+
+    !--- DEFAULT VALUE
+    l = [PRESENT(ky), ALLOCATED(tracers), ASSOCIATED(isotope)]; nq(:) = 0
+    IF(l(1)) nq(1) = SIZE(ky)
+    IF(l(2)) nq(2) = SIZE(tracers)
+    IF(l(3)) nq(3) = SIZE(isotope%keys)
+    DO k = 1, 3; IF(l(k) .AND. nq(k) /= 0) THEN; val = [(def, iq = 1, nq(k))]; EXIT;
+    END IF;
+    END DO
+    lerr = k == 4
+    CALL msg('Using defaut value for ' // TRIM(s) // ': ' // TRIM(def), modname, lD .AND. .NOT.lerr)
+    CALL msg('No ' // TRIM(s), modname, lD .AND. lerr)
+
+  CONTAINS
+
+    FUNCTION fgetKey(ky) RESULT(val)
+      CHARACTER(LEN = maxlen), ALLOCATABLE :: val(:)
+      TYPE(keys_type), INTENT(IN) :: ky(:)
+      LOGICAL :: ler(SIZE(ky))
+      INTEGER :: iq
+      lerr = SIZE(ky) == 0; IF(lerr) RETURN
+      tname = ky%name
+      val = [(fgetKeyIdx(iq, keyn(:), ky, ler(iq)), iq = 1, SIZE(ky))]
+      lerr = ANY(ler)
+    END FUNCTION fgetKey
+
+  END FUNCTION getKeyByIndex_smmm
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_immm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
+    INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
+    INTEGER, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:), tname(:)
+    LOGICAL, ALLOCATABLE :: ll(:)
+    IF(PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, int2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp = lDisp)
+    IF(lerr) RETURN
+    val = str2int(svals)
+    ll = val == -HUGE(1)
+    lerr = ANY(ll); IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN;
+    END IF
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(strStack(PACK(tname, MASK = ll))) // ' is not'
+    CALL msg(TRIM(s) // ' an integer: ' // TRIM(strStack(svals, MASK = ll)), modname, lerr)
+    IF(.NOT.lerr .AND. PRESENT(nam)) nam = tname
+  END FUNCTION getKeyByIndex_immm
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_rmmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
+    REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
+    REAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:), tname(:)
+    LOGICAL, ALLOCATABLE :: ll(:)
+    IF(PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, real2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp = lDisp)
+    IF(lerr) RETURN
+    val = str2real(svals)
+    ll = val == -HUGE(1.)
+    lerr = ANY(ll); IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN;
+    END IF
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(strStack(PACK(tname, MASK = ll))) // ' is not a'
+    CALL msg(TRIM(s) // ' a real: ' // TRIM(strStack(svals, MASK = ll)), modname)
+  END FUNCTION getKeyByIndex_rmmm
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByIndex_lmmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:)
+    LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:), tname(:)
+    LOGICAL, ALLOCATABLE :: ll(:)
+    INTEGER, ALLOCATABLE :: ivals(:)
+    IF(PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, bool2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp = lDisp)
+    IF(lerr) RETURN
+    ivals = str2bool(svals)
+    ll = ivals == -1
+    lerr = ANY(ll); IF(.NOT.lerr) THEN; val = ivals == 1; IF(PRESENT(nam)) nam = tname; RETURN;
+    END IF
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(strStack(tname, MASK = ll)) // ' is not'
+    CALL msg(TRIM(s) // ' a boolean: ' // TRIM(strStack(svals, MASK = ll)), modname)
+  END FUNCTION getKeyByIndex_lmmm
+  !==============================================================================================================================
+
+
+
+  !==============================================================================================================================
+  !===                                           GET KEYS VALUES FROM TRACERS NAMES                                           ===
+  !==============================================================================================================================
+  !=== TRY TO GET THE KEY NAMED "key" FOR THE TRACER NAMED "tname" IN:                                                        ===
+  !===  * ARGUMENT "ky" DATABASE IF SPECIFIED ; OTHERWISE:                                                                    ===
+  !===  * IN INTERNAL TRACERS DATABASE "tracers(:)%keys" (IF UNFOUND, IN INTERNAL ISOTOPES DATABASE "isotope%keys(:)")        ===
+  !=== THE RETURNED VALUE (STRING, AN INTEGER, A REAL OR A LOGICAL) CAN BE EITHER:                                            ===
+  !===  * A SCALAR                                                                                                            ===
+  !===  * A VECTOR, WHICH IS THE FOUND VALUE PARSED WITH THE SEPARATOR ","                                                    ===
+  !===                                                                                                                        ===
+  !=== SYNTAX:       lerr = getKeyByName_{sirl}{1m}{1m}1(keyn[(:)], val[(:)], tname  [, ky(:)][, def][, lDisp])               ===
+  !==============================================================================================================================
+  !=== IF "tname(:)" IS A VECTOR, THE RETURNED VALUES (ONE EACH "tname(:)" ELEMENT) ARE STORED IN THE VECTOR "val(:)"         ===
+  !===                                                                                                                        ===
+  !=== SYNTAX        lerr = getKeyByName_{sirl}{1m}mm   (keyn[(:)], val (:), tname(:)[, ky(:)][, def][, lDisp])               ===
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_s111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn, tname
+    CHARACTER(LEN = maxlen), INTENT(OUT) :: val
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    lerr = getKeyByName_sm11([keyn], val, tname, ky, def, lDisp)
+  END FUNCTION getKeyByName_s111
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_i111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn, tname
+    INTEGER, INTENT(OUT) :: val
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    INTEGER, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    lerr = getKeyByName_im11([keyn], val, tname, ky, def, lDisp)
+  END FUNCTION getKeyByName_i111
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_r111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn, tname
+    REAL, INTENT(OUT) :: val
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    REAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    lerr = getKeyByName_rm11([keyn], val, tname, ky, def, lDisp)
+  END FUNCTION getKeyByName_r111
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_l111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn, tname
+    LOGICAL, INTENT(OUT) :: val
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    lerr = getKeyByName_lm11([keyn], val, tname, ky, def, lDisp)
+  END FUNCTION getKeyByName_l111
+  !==============================================================================================================================
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_sm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname
+    CHARACTER(LEN = maxlen), INTENT(OUT) :: val
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: s, tnam
+    LOGICAL :: lD
+    lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" for "' // TRIM(tname) // '"'
+    lerr = .TRUE.
+    tnam = strHead(delPhase(tname), '_', .TRUE.)                                             !--- Remove phase and tag
+    IF(lerr .AND. PRESENT(ky))         val = fgetKey(ky)                                   !--- "ky"
+    IF(lerr .AND. ALLOCATED (tracers)) val = fgetKey(tracers(:)%keys)                      !--- "tracers"
+    IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:))                      !--- "isotope"
+    IF(lerr .AND. PRESENT(def)) THEN
+      val = def; lerr = .NOT.PRESENT(def)
+      CALL msg('Using defaut value of ' // TRIM(s) // ': ' // TRIM(def), modname, lD)
+    END IF
+    CALL msg('No ' // TRIM(s) // ' or out of bounds index', modname, lD .AND. lerr)
+
+  CONTAINS
+
+    CHARACTER(LEN = maxlen) FUNCTION fgetKey(ky) RESULT(val)
+      TYPE(keys_type), INTENT(IN) :: ky(:)
+      lerr = SIZE(ky) == 0
+      IF(lerr) RETURN
+      val = fgetKeyIdx(strIdx(ky%name, tname), [keyn], ky, lerr)
+      IF(lerr) val = fgetKeyIdx(strIdx(ky%name, tnam), [keyn], ky, lerr)
+
+    END FUNCTION fgetKey
+
+  END FUNCTION getKeyByName_sm11
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_im11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname
+    INTEGER, INTENT(OUT) :: val
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    INTEGER, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    IF(PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, int2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    val = str2int(sval)
+    lerr = val == -HUGE(1)
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(tname) // ' is not'
+    CALL msg(TRIM(s) // ' an integer: ' // TRIM(sval), modname, lerr)
+  END FUNCTION getKeyByName_im11
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_rm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname
+    REAL, INTENT(OUT) :: val
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    REAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    IF(PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, real2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    val = str2real(sval)
+    lerr = val == -HUGE(1.)
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(tname) // ' is not'
+    CALL msg(TRIM(s) // ' a real: ' // TRIM(sval), modname, lerr)
+  END FUNCTION getKeyByName_rm11
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_lm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname
+    LOGICAL, INTENT(OUT) :: val
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    INTEGER :: ival
+    IF(PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, bool2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    ival = str2bool(sval)
+    lerr = ival == -1
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(tname) // ' is not'
+    CALL msg(TRIM(s) // ' a boolean: ' // TRIM(sval), modname, lerr)
+    IF(.NOT.lerr) val = ival == 1
+  END FUNCTION getKeyByName_lm11
+  !==============================================================================================================================
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_s1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn, tname
+    CHARACTER(LEN = maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval
+    lerr = getKeyByName_sm11([keyn], sval, tname, ky, def, lDisp); IF(lerr) RETURN
+    lerr = strParse(sval, ',', val)
+    IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
+  END FUNCTION getKeyByName_s1m1
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_i1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn, tname
+    INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    INTEGER, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
+    IF(PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, int2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    lerr = strParse(sval, ',', svals)
+    IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
+    val = str2int(svals)
+    lerr = ANY(val == -HUGE(1))
+    s = 'key "' // TRIM(keyn) // '" of ' // TRIM(tname) // ' is not'
+    CALL msg(TRIM(s) // ' an integer: ' // TRIM(sval), modname, lerr)
+  END FUNCTION getKeyByName_i1m1
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_r1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn, tname
+    REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    REAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
+    IF(PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, real2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    lerr = strParse(sval, ',', svals)
+    IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
+    val = str2real(svals)
+    lerr = ANY(val == -HUGE(1.))
+    s = 'key "' // TRIM(keyn) // '" of ' // TRIM(tname) // ' is not'
+    CALL msg(TRIM(s) // ' a real: ' // TRIM(sval), modname, lerr)
+  END FUNCTION getKeyByName_r1m1
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_l1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn, tname
+    LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
+    INTEGER, ALLOCATABLE :: ivals(:)
+    IF(PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, bool2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    lerr = strParse(sval, ',', svals)
+    IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
+    ivals = str2bool(svals)
+    lerr = ANY(ivals == -1)
+    s = 'key "' // TRIM(keyn) // '" of ' // TRIM(tname) // ' is not'
+    CALL msg(TRIM(s) // ' a boolean: ' // TRIM(sval), modname, lerr)
+    IF(.NOT.lerr) val = ivals == 1
+  END FUNCTION getKeyByName_l1m1
+  !==============================================================================================================================
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_smm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname
+    CHARACTER(LEN = maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval
+    lerr = getKeyByName_sm11(keyn, sval, tname, ky, def, lDisp); IF(lerr) RETURN
+    lerr = strParse(sval, ',', val)
+    IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
+  END FUNCTION getKeyByName_smm1
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_imm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname
+    INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    INTEGER, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
+    IF(PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, int2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    lerr = strParse(sval, ',', svals)
+    IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
+    val = str2int(svals)
+    lerr = ANY(val == -HUGE(1))
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(tname) // ' is not'
+    CALL msg(TRIM(s) // ' an integer: ' // TRIM(sval), modname, lerr)
+  END FUNCTION getKeyByName_imm1
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_rmm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname
+    REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    REAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
+    IF(PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, real2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    lerr = strParse(sval, ',', svals)
+    IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
+    val = str2real(svals)
+    lerr = ANY(val == -HUGE(1.))
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(tname) // ' is not'
+    CALL msg(TRIM(s) // ' a real: ' // TRIM(sval), modname, lerr)
+  END FUNCTION getKeyByName_rmm1
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_lmm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname
+    LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: sval, s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
+    INTEGER, ALLOCATABLE :: ivals(:)
+    IF(PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, bool2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    lerr = strParse(sval, ',', svals)
+    IF(fmsg('can''t parse ' // TRIM(sval), modname, lerr)) RETURN
+    ivals = str2bool(svals)
+    lerr = ANY(ivals == -1)
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(tname) // ' is not'
+    CALL msg(TRIM(s) // ' a boolean: ' // TRIM(sval), modname, lerr)
+    IF(.NOT.lerr) val = ivals == 1
+  END FUNCTION getKeyByName_lmm1
+  !==============================================================================================================================
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_s1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn, tname(:)
+    CHARACTER(LEN = maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    lerr = getKeyByName_smmm([keyn], val, tname, ky, def, lDisp)
+  END FUNCTION getKeyByName_s1mm
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_i1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn, tname(:)
+    INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    INTEGER, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    lerr = getKeyByName_immm([keyn], val, tname, ky, def, lDisp)
+  END FUNCTION getKeyByName_i1mm
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_r1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn, tname(:)
+    REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    REAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    lerr = getKeyByName_rmmm([keyn], val, tname, ky, def, lDisp)
+  END FUNCTION getKeyByName_r1mm
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_l1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn, tname(:)
+    LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    lerr = getKeyByName_lmmm([keyn], val, tname, ky, def, lDisp)
+  END FUNCTION getKeyByName_l1mm
+  !==============================================================================================================================
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_smmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname(:)
+    CHARACTER(LEN = maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: s
+    INTEGER :: iq, nq
+    LOGICAL :: lD
+    nq = SIZE(tname); ALLOCATE(val(nq))
+    lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '"'
+    lerr = .TRUE.
+    IF(PRESENT(ky)) THEN;                 val = fgetKey(ky)                                !--- "ky"
+    ELSE IF(ALLOCATED(tracers)) THEN;     val = fgetKey(tracers(:)%keys)                   !--- "tracers"
+    IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:))                   !--- "isotope"
+    END IF
+    IF(.NOT.PRESENT(def)) THEN; CALL msg('No ' // TRIM(s) // ' found', modname, lD); RETURN;
+    END IF
+
+    !--- DEFAULT VALUE
+    val = [(def, iq = 1, SIZE(tname))]
+    CALL msg('Using defaut value for ' // TRIM(s) // ': ' // TRIM(def), modname, lD)
+
+  CONTAINS
+
+    FUNCTION fgetKey(ky) RESULT(val)
+      CHARACTER(LEN = maxlen), ALLOCATABLE :: val(:)
+      TYPE(keys_type), INTENT(IN) :: ky(:)
+      LOGICAL, ALLOCATABLE :: ler(:)
+      lerr = SIZE(ky) == 0; IF(lerr) RETURN
+      ALLOCATE(ler(SIZE(tname)))
+      val = [(fgetKeyIdx(strIdx(ky(:)%name, tname(iq)), keyn, ky, ler(iq)), iq = 1, SIZE(tname))]
+      lerr = ANY(ler)
+    END FUNCTION fgetKey
+
+  END FUNCTION getKeyByName_smmm
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_immm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname(:)
+    INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    INTEGER, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
+    LOGICAL, ALLOCATABLE :: ll(:)
+    IF(PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, int2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    val = str2int(svals)
+    ll = val == -HUGE(1)
+    lerr = ANY(ll); IF(.NOT.lerr) RETURN
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(strStack(tname, MASK = ll)) // ' is not'
+    CALL msg(TRIM(s) // ' an integer: ' // TRIM(strStack(svals, MASK = ll)), modname)
+  END FUNCTION getKeyByName_immm
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_rmmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname(:)
+    REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    REAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
+    LOGICAL, ALLOCATABLE :: ll(:)
+    IF(PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, real2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    val = str2real(svals)
+    ll = val == -HUGE(1.)
+    lerr = ANY(ll); IF(.NOT.lerr) RETURN
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(strStack(tname, MASK = ll)) // ' is not'
+    CALL msg(TRIM(s) // ' a real: ' // TRIM(strStack(svals, MASK = ll)), modname)
+  END FUNCTION getKeyByName_rmmm
+  !==============================================================================================================================
+  LOGICAL FUNCTION getKeyByName_lmmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: keyn(:), tname(:)
+    LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
+    TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
+    LOGICAL, OPTIONAL, INTENT(IN) :: def
+    LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: s
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: svals(:)
+    LOGICAL, ALLOCATABLE :: ll(:)
+    INTEGER, ALLOCATABLE :: ivals(:)
+    IF(PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, bool2str(def), lDisp)
+    IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp = lDisp)
+    IF(lerr) RETURN
+    ivals = str2bool(svals)
+    ll = ivals == -1
+    lerr = ANY(ll); IF(.NOT.lerr) THEN; val = ivals == 1; RETURN;
+    END IF
+    s = 'key "' // TRIM(strStack(keyn, '/')) // '" of ' // TRIM(strStack(tname, MASK = ll)) // ' is not'
+    CALL msg(TRIM(s) // ' a boolean: ' // TRIM(strStack(svals, MASK = ll)), modname)
+  END FUNCTION getKeyByName_lmmm
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  !=== ROUTINES TO GET OR PUT TRACERS AND ISOTOPES DATABASES, SINCE tracers AND isotopes ARE PRIVATE VARIABLES ==================
+  !==============================================================================================================================
+  SUBROUTINE setKeysDBase(tracers_, isotopes_, isotope_)
+    TYPE(trac_type), OPTIONAL, INTENT(IN) :: tracers_(:)
+    TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotopes_(:)
+    TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotope_
+    !------------------------------------------------------------------------------------------------------------------------------
+    TYPE(isot_type), ALLOCATABLE :: iso(:)
+    INTEGER :: ix, nbIso
+    IF(PRESENT(tracers_)) THEN;  tracers = tracers_;
+    ELSE; ALLOCATE(tracers(0));
+    END IF
+    IF(PRESENT(isotopes_)) THEN; isotopes = isotopes_;
+    ELSE; ALLOCATE(isotopes(0));
+    END IF
+    IF(PRESENT(isotope_)) THEN
+      ix = strIdx(isotopes(:)%parent, isotope_%parent)
+      IF(ix /= 0) THEN
+        isotopes(ix) = isotope_
+      ELSE
+        nbIso = SIZE(isotopes); ALLOCATE(iso(nbIso + 1)); iso(1:nbIso) = isotopes; iso(nbIso + 1) = isotope_
+        CALL MOVE_ALLOC(FROM = iso, TO = isotopes)
+      END IF
+    END IF
+  END SUBROUTINE setKeysDBase
+  !==============================================================================================================================
+  SUBROUTINE getKeysDBase(tracers_, isotopes_, isotope_)
+    TYPE(trac_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: tracers_(:)
+    TYPE(isot_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: isotopes_(:)
+    TYPE(isot_type), OPTIONAL, INTENT(OUT) :: isotope_
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: ix
+    IF(PRESENT(tracers_)) THEN;  tracers_ = tracers;
+    ELSE; ALLOCATE(tracers_(0));
+    END IF
+    IF(PRESENT(isotopes_)) THEN; isotopes_ = isotopes;
+    ELSE; ALLOCATE(isotopes_(0));
+    END IF
+    IF(PRESENT(isotope_)) THEN; ix = strIdx(isotopes(:)%parent, isotope%parent); IF(ix /= 0) isotope_ = isotopes(ix);
+    END IF
+  END SUBROUTINE getKeysDBase
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  !=== REMOVE, IF ANY, OR ADD THE PHASE SUFFIX OF THE TRACER NAMED "s" ==========================================================
+  !==============================================================================================================================
+  ELEMENTAL CHARACTER(LEN = maxlen) FUNCTION delPhase(s) RESULT(OUT)
+    CHARACTER(LEN = *), INTENT(IN) :: s
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: ix, ip, ns
+    out = s; ns = LEN_TRIM(s)
+    IF(s == '' .OR. ns<=2) RETURN                                                !--- Empty string or LEN(name)<=2: nothing to DO
+    IF(s(1:3)=='H2O' .AND. INDEX(old_phases, s(4:4))/=0 .AND. (ns==4 .OR. s(5:5)=='_')) THEN
+      out = 'H2O' // s(5:ns)                                                         !--- H2O<phase>[_<iso>][_<tag>]
+    ELSE IF(s(ns - 1:ns - 1)==phases_sep .AND. INDEX(known_phases, s(ns:ns))/=0) THEN
+      out = s(1:ns - 2); RETURN                                                    !--- <var><phase_sep><phase>
+    ELSE; DO ip = 1, nphases; ix = INDEX(s, phases_sep // known_phases(ip:ip) // '_'); IF(ix /= 0) EXIT;
+    END DO
+    IF(ip /= nphases + 1) out = s(1:ix - 1) // s(ix + 2:ns)                            !--- <var><phase_sep><phase>_<tag>
+    END IF
+  END FUNCTION delPhase
+  !==============================================================================================================================
+  CHARACTER(LEN = maxlen) FUNCTION addPhase_s1(s, pha) RESULT(OUT)
+    CHARACTER(LEN = *), INTENT(IN) :: s
+    CHARACTER(LEN = 1), INTENT(IN) :: pha
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: l, i
+    out = s
+    IF(s == '') RETURN                                                           !--- Empty string: nothing to DO
+    i = INDEX(s, '_')                                                            !--- /=0 for <var>_<tag> tracers names
+    l = LEN_TRIM(s)
+    IF(i == 0) out = TRIM(s) // phases_sep // pha                                   !--- <var>       => return <var><sep><pha>
+    IF(i /= 0) out = s(1:i - 1) // phases_sep // pha // '_' // s(i + 1:l)                    !--- <var>_<tag> => return <var><sep><pha>_<tag>
+  END FUNCTION addPhase_s1
+  !==============================================================================================================================
+  FUNCTION addPhase_sm(s, pha) RESULT(OUT)
+    CHARACTER(LEN = *), INTENT(IN) :: s(:)
+    CHARACTER(LEN = 1), INTENT(IN) :: pha
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: out(:)
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: k
+    out = [(addPhase_s1(s(k), pha), k = 1, SIZE(s))]
+  END FUNCTION addPhase_sm
+  !==============================================================================================================================
+  CHARACTER(LEN = maxlen) FUNCTION addPhase_i1(s, ipha, phases) RESULT(OUT)
+    CHARACTER(LEN = *), INTENT(IN) :: s
+    INTEGER, INTENT(IN) :: ipha
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: phases
+    !------------------------------------------------------------------------------------------------------------------------------
+    out = s
+    IF(s == '') RETURN                                                           !--- Empty string: nothing to DO
+    IF(ipha == 0 .OR. ipha > nphases) RETURN                                     !--- Absurd index: no phase to add
+    IF(PRESENT(phases)) out = addPhase_s1(s, phases(ipha:ipha))
+    IF(.NOT.PRESENT(phases)) out = addPhase_s1(s, known_phases(ipha:ipha))
+  END FUNCTION addPhase_i1
+  !==============================================================================================================================
+  FUNCTION addPhase_im(s, ipha, phases) RESULT(OUT)
+    CHARACTER(LEN = *), INTENT(IN) :: s(:)
+    INTEGER, INTENT(IN) :: ipha
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: phases
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: out(:)
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: k
+    IF(PRESENT(phases)) out = [(addPhase_i1(s(k), ipha, phases), k = 1, SIZE(s))]
+    IF(.NOT.PRESENT(phases)) out = [(addPhase_i1(s(k), ipha, known_phases), k = 1, SIZE(s))]
+  END FUNCTION addPhase_im
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  !=== APPEND TRACERS DATABASE "tracs" WITH TRACERS/KEYS "tname"/"keys" ; SAME FOR INTERNAL DATABASE "tracers" ==================
+  !==============================================================================================================================
+  LOGICAL FUNCTION addTracer_1(tname, keys, tracs) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: tname
+    TYPE(keys_type), INTENT(IN) :: keys
+    TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tracs(:)
+    TYPE(trac_type), ALLOCATABLE :: tr(:)
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: tnames(:)
+    INTEGER :: nt, ix
+    IF(ALLOCATED(tracs)) THEN
+      lerr = getKey('name', tnames, ky = tracs(:)%keys); IF(lerr) RETURN
+      nt = SIZE(tracs)
+      ix = strIdx(tnames, tname)
+      CALL msg('Modifying existing tracer "' // TRIM(tname) // '"', modname, ix /= 0)
+      CALL msg('Appending with tracer "' // TRIM(tname) // '"', modname, ix == 0)
+      IF(ix == 0) THEN
+        ix = nt + 1; ALLOCATE(tr(nt + 1)); tr(1:nt) = tracs(1:nt); CALL MOVE_ALLOC(FROM = tr, TO = tracs)
+      END IF
+    ELSE
+      CALL msg('Creating a tracer descriptor with tracer "' // TRIM(tname) // '"', modname)
+      ix = 1; ALLOCATE(tracs(1))
+    END IF
+    CALL addKey('name', tname, tracs(ix)%keys)
+    tracs(ix)%name = tname
+    tracs(ix)%keys = keys
+
+  END FUNCTION addTracer_1
+  !==============================================================================================================================
+  LOGICAL FUNCTION addTracer_1def(tname, keys) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: tname
+    TYPE(keys_type), INTENT(IN) :: keys
+    lerr = addTracer_1(tname, keys, tracers)
+  END FUNCTION addTracer_1def
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  LOGICAL FUNCTION delTracer_1(tname, tracs) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: tname
+    TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: tracs(:)
+    TYPE(trac_type), ALLOCATABLE :: tr(:)
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: tnames(:)
+    INTEGER :: nt, ix
+    lerr = .NOT.ALLOCATED(tracs)
+    IF(fmsg('Can''t remove tracer "' // TRIM(tname) // '" from an empty tracers descriptor', modname, lerr)) RETURN
+    nt = SIZE(tracs)
+    lerr = getKey('name', tnames, ky = tracs(:)%keys); IF(lerr) RETURN
+    ix = strIdx(tnames, tname)
+    CALL msg('Removing tracer "' // TRIM(tname) // '"', modname, ix /= 0)
+    CALL msg('Can''t remove unknown tracer "' // TRIM(tname) // '"', modname, ix == 0)
+    IF(ix /= 0) THEN
+      ALLOCATE(tr(nt - 1)); tr(1:ix - 1) = tracs(1:ix - 1); tr(ix:nt - 1) = tracs(ix + 1:nt); CALL MOVE_ALLOC(FROM = tr, TO = tracs)
+    END IF
+  END FUNCTION delTracer_1
+  !==============================================================================================================================
+  LOGICAL FUNCTION delTracer_1def(tname) RESULT(lerr)
+    CHARACTER(LEN = *), INTENT(IN) :: tname
+    lerr = delTracer(tname, tracers)
+  END FUNCTION delTracer_1def
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  !=== GET PHASE INDEX IN THE POSSIBLE PHASES LIST OR IN A SPECIFIED LIST ("phases") ============================================
+  !==============================================================================================================================
+  INTEGER FUNCTION getiPhase(tname, phases) RESULT(iPhase)
+    CHARACTER(LEN = *), INTENT(IN) :: tname
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: phases
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen) :: phase
+    IF(PRESENT(phases)) phase = getPhase(tname, phases, iPhase)
+    IF(.NOT.PRESENT(phases)) phase = getPhase(tname, known_phases, iPhase)
+  END FUNCTION getiPhase
+  !==============================================================================================================================
+  CHARACTER(LEN = 1) FUNCTION getPhase(tname, phases, iPhase) RESULT(phase)
+    CHARACTER(LEN = *), INTENT(IN) :: tname
+    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: phases
+    INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: ip
+    phase = TRIM(strHead(strTail(tname, phases_sep), '_', .TRUE.))     !--- <nam><sep><pha>[_<tag>] -> <pha>[_<tag>] -> <pha>
+    IF(PRESENT(phases)) ip = INDEX(phases, phase)
+    IF(.NOT.PRESENT(phases)) ip = INDEX(known_phases, phase)
+    IF(ip == 0) phase = 'g'
+    IF(PRESENT(iPhase)) iPhase = ip
+  END FUNCTION getPhase
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  !============ CONVERT WATER-DERIVED NAMES FROM FORMER TO CURRENT CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
+  !======= NAMES STRUCTURE: H2O[<phase>][_<isotope>][_<tag>] (<phase> from "old_phases", <isotope> from "oldH2OIso") ============
+  !==============================================================================================================================
+  CHARACTER(LEN = maxlen) FUNCTION old2newH2O_1(oldName, iPhase) RESULT(newName)
+    CHARACTER(LEN = *), INTENT(IN) :: oldName
+    INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
+    !------------------------------------------------------------------------------------------------------------------------------
+    CHARACTER(LEN = maxlen), ALLOCATABLE :: tmp(:)
+    INTEGER :: ix, ip, nt
+    LOGICAL :: lerr
+    newName = oldName
+    IF(PRESENT(iPhase)) iPhase = 1                                               !--- Default: gaseous phase
+    lerr = strParse(oldName, '_', tmp, nt)                                       !--- Parsing: 1 up to 3 elements.
+    ip = strIdx([('H2O' // old_phases(ix:ix), ix = 1, nphases)], tmp(1))           !--- Phase index
+    IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip                                !--- Returning phase index
+    IF(ip == 0 .AND. tmp(1) /= 'H2O')   RETURN                                   !--- Not an old-style water-related species
+    IF(nt == 1) THEN
+      newName = addPhase('H2O', ip)                                               !=== WATER WITH OR WITHOUT PHASE
+    ELSE
+      ix = strIdx(oldH2OIso, tmp(2))                                             !--- Index in the known isotopes list
+      IF(ix /= 0) newName = newH2OIso(ix)                                        !--- Move to new isotope name
+      IF(ip /= 0) newName = addPhase(newName, ip)                                !--- Add phase to isotope name
+      IF(nt == 3) newName = TRIM(newName) // '_' // TRIM(tmp(3))                     !=== WATER ISOTOPE OR TAGGING TRACER
+    END IF
+  END FUNCTION old2newH2O_1
+  !==============================================================================================================================
+  FUNCTION old2newH2O_m(oldName) RESULT(newName)
+    CHARACTER(LEN = *), INTENT(IN) :: oldName(:)
+    CHARACTER(LEN = maxlen) :: newName(SIZE(oldName))
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: i
+    newName = [(old2newH2O_1(oldName(i)), i = 1, SIZE(oldName))]
+  END FUNCTION old2newH2O_m
+  !==============================================================================================================================
+
+
+  !==============================================================================================================================
+  !============ CONVERT WATER-DERIVED NAMES FROM CURRENT TO FORMER CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
+  !==== NAMES STRUCTURE: <var>[<phase_sep><phase>][_<tag>] (<phase> from "known_phases", <var> = 'H2O' or from "newH2OIso") =====
+  !==============================================================================================================================
+  CHARACTER(LEN = maxlen) FUNCTION new2oldH2O_1(newName, iPhase) RESULT(oldName)
+    CHARACTER(LEN = *), INTENT(IN) :: newName
+    INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: ix, ip
+    CHARACTER(LEN = maxlen) :: var
+    oldName = newName
+    ip = getiPhase(newName)                                                      !--- Phase index
+    IF(PRESENT(iPhase)) iPhase = MAX(ip, 1)                                      !--- Return phase index ; default: 1 (gazeous)
+    var = TRIM(strHead(newName, phases_sep, .TRUE.))                             !--- Variable without phase and tag
+    ix = strIdx(newH2OIso, var)                                                  !--- Index in the known H2O isotopes list
+    IF(ix == 0 .AND. var /= 'H2O') RETURN                                        !--- Neither H2O nor an H2O isotope => finished
+    oldName = 'H2O'
+    IF(ip /= 0) oldName = TRIM(oldName) // old_phases(ip:ip)                       !--- Add phase if needed
+    IF(ix /= 0) oldName = TRIM(oldName) // '_' // oldH2OIso(ix)                      !--- H2O isotope name
+    IF(newName /= addPhase(var, ip)) &
+            oldName = TRIM(oldName) // strTail(newName, '_', .TRUE.)                     !--- Add the tag suffix
+    IF(ip == 0 .AND. ix /= 0) oldName = strTail(oldName, '_')                    !--- Isotope with no phase: remove 'H2O_' prefix
+  END FUNCTION new2oldH2O_1
+  !==============================================================================================================================
+  FUNCTION new2oldH2O_m(newName) RESULT(oldName)
+    CHARACTER(LEN = *), INTENT(IN) :: newName(:)
+    CHARACTER(LEN = maxlen) :: oldName(SIZE(newName))
+    !------------------------------------------------------------------------------------------------------------------------------
+    INTEGER :: i
+    oldName = [(new2oldH2O_1(newName(i)), i = 1, SIZE(newName))]
+  END FUNCTION new2oldH2O_m
+  !==============================================================================================================================
+
+END MODULE lmdz_readTracFiles
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_regr_conserv.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_regr_conserv.f90	(revision 5117)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_regr_conserv.f90	(revision 5117)
@@ -0,0 +1,388 @@
+MODULE lmdz_regr_conserv
+
+  USE lmdz_assert_eq,   ONLY: assert_eq
+  USE lmdz_assert,      ONLY: assert
+  USE lmdz_interpolation, ONLY: locate
+
+  IMPLICIT NONE
+
+! Purpose: Each procedure regrids a piecewise linear function (not necessarily
+!          continuous) by averaging it. This is a conservative regridding.
+!          The regridding operation is done along dimension "ix" of the input
+!          field "vs". Input are positions of cell edges.
+! Remarks:
+!   * The target grid should be included in the source grid:
+!     no extrapolation is allowed.
+!   * Field on target grid "vt" has same rank, slopes and averages as "vs".
+!   * If optional argument "slope" is not given, 0 is assumed for slopes.
+!     Then the regridding is first order instead of second.
+!   * "vs" and "vt" have the same dimensions except Nr. ix (ns for vs, nt for vt)
+
+! Argument                         Type         Description
+!-------------------------------------------------------------------------------
+!  INTEGER, INTENT(IN)  :: ix      Scalar       dimension regridded <=rank(vs)
+!  REAL,    INTENT(IN)  :: vs(*)   Rank>=1      averages in source grid cells
+!  REAL,    INTENT(IN)  :: xs(:)   Vector(ns+1) edges of source grid, asc. order
+!  REAL,    INTENT(IN)  :: xt(:)   Vector(nt+1) edges of target grid, asc. order
+!  REAL,    INTENT(OUT) :: vt(*)   Rank>=1      regridded field
+! [REAL,    INTENT(IN)  :: slope]  Rank>=1      slopes in source grid cells
+
+  INTERFACE regr_conserv
+    ! The procedures differ only from the rank of the input/output fields.
+    MODULE PROCEDURE regr1_conserv, regr2_conserv, regr3_conserv, &
+                     regr4_conserv, regr5_conserv
+  END INTERFACE
+
+  PRIVATE
+  PUBLIC :: regr_conserv
+
+CONTAINS
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE regr1_conserv(ix, vs, xs, xt, vt, slope)
+
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER,        INTENT(IN)  :: ix
+  REAL,           INTENT(IN)  :: vs(:)
+  REAL,           INTENT(IN)  :: xs(:), xt(:)
+  REAL,           INTENT(OUT) :: vt(:)
+  REAL, OPTIONAL, INTENT(IN)  :: slope(:)
+!-------------------------------------------------------------------------------
+! Local variables:
+  INTEGER :: is, it, ns, nt
+  REAL    :: co, idt
+  LOGICAL :: lslope
+!-------------------------------------------------------------------------------
+  lslope=PRESENT(slope)
+  CALL check_size(ix,SHAPE(vs),SHAPE(vt),xs,xt,ns,nt)
+  is=locate(xs,xt(1))                    !--- 1<= is <= ns (no extrapolation)
+  vt(:)=0.
+  DO it=1, nt; idt=1./(xt(it+1)-xt(it))
+    IF(xt(it+1)<=xs(is+1)) THEN          !--- xs(is)<=xt(it)<=xt(it+1)<=xs(is+1)
+      CALL mean_lin(xt(it),xt(it+1))
+    ELSE
+      CALL mean_lin(xt(it),xs(is+1)); is=is+1
+      DO WHILE(xs(is+1)<xt(it+1))        !--- 1<=is<=ns-1
+      CALL mean_lin(xs(is),xs(is+1)); is=is+1
+      END DO
+      CALL mean_lin(xs(is),xt(it+1))     !--- 1<=is<=ns
+    END IF
+    IF(xs(is+1)==xt(it+1)) is=is+1       !--- 1<=is<=ns .OR. it==nt
+  END DO
+
+CONTAINS
+
+!-------------------------------------------------------------------------------
+SUBROUTINE mean_lin(a,b)  ! mean [a,b] of the linear function in [xs(is),xs(is+1)]
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN)    :: a, b
+!-------------------------------------------------------------------------------
+  IF(lslope.AND.(a/=xs(is).OR.b/=xs(is+1))) THEN; co=0.
+    IF(a==xt(it  )) co=co+xt(it  )-xs(is  )
+    IF(b==xt(it+1)) co=co+xt(it+1)-xs(is+1)
+    vt(it) = vt(it)+idt*(b-a)*(vs(is)+co*slope(is)/2.)
+  ELSE
+    vt(it) = vt(it)+idt*(b-a)* vs(is)
+  END IF
+
+END SUBROUTINE mean_lin
+!-------------------------------------------------------------------------------
+
+END SUBROUTINE regr1_conserv
+
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE regr2_conserv(ix, vs, xs, xt, vt, slope)
+
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER,        INTENT(IN)  :: ix
+  REAL,           INTENT(IN)  :: vs(:,:)
+  REAL,           INTENT(IN)  :: xs(:), xt(:)
+  REAL,           INTENT(OUT) :: vt(:,:)
+  REAL, OPTIONAL, INTENT(IN)  :: slope(:,:)
+!-------------------------------------------------------------------------------
+! Local variables:
+  INTEGER :: is, it, ns, nt
+  REAL    :: co, idt
+  LOGICAL :: lslope
+!-------------------------------------------------------------------------------
+  lslope=PRESENT(slope)
+  CALL check_size(ix,SHAPE(vs),SHAPE(vt),xs,xt,ns,nt)
+  is=locate(xs,xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
+  vt(:,:)=0.
+  DO it=1, nt; idt=1./(xt(it+1)-xt(it))
+    IF(xt(it+1)<=xs(is+1)) THEN          !--- xs(is)<=xt(it)<=xt(it+1)<=xs(is+1)
+      CALL mean_lin(xt(it),xt(it+1))
+    ELSE
+      CALL mean_lin(xt(it),xs(is+1)); is=is+1
+      DO WHILE(xs(is+1)<xt(it+1))        !--- 1<=is<=ns-1
+      CALL mean_lin(xs(is),xs(is+1)); is=is+1
+      END DO
+      CALL mean_lin(xs(is),xt(it+1))     !--- 1<=is<=ns
+    END IF
+    IF(xs(is+1)==xt(it+1)) is=is+1       !--- 1<=is<=ns .OR. it==nt
+  END DO
+
+CONTAINS
+
+!-------------------------------------------------------------------------------
+SUBROUTINE mean_lin(a,b)  ! mean [a,b] of the linear function in [xs(is),xs(is+1)]
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN)    :: a, b
+!-------------------------------------------------------------------------------
+  IF(lslope.AND.(a/=xs(is).OR.b/=xs(is+1))) THEN; co=0.
+    IF(a==xt(it  )) co=co+xt(it  )-xs(is  )
+    IF(b==xt(it+1)) co=co+xt(it+1)-xs(is+1)
+    IF(ix==1) vt(it,:) = vt(it,:)+idt*(b-a)*(vs(is,:)+co*slope(is,:)/2.)
+    IF(ix==2) vt(:,it) = vt(:,it)+idt*(b-a)*(vs(:,is)+co*slope(:,is)/2.)
+  ELSE
+    IF(ix==1) vt(it,:) = vt(it,:)+idt*(b-a)* vs(is,:)
+    IF(ix==2) vt(:,it) = vt(:,it)+idt*(b-a)* vs(:,is)
+  END IF
+
+END SUBROUTINE mean_lin
+!-------------------------------------------------------------------------------
+
+END SUBROUTINE regr2_conserv
+
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE regr3_conserv(ix, vs, xs, xt, vt, slope)
+
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER,        INTENT(IN)  :: ix
+  REAL,           INTENT(IN)  :: vs(:,:,:)
+  REAL,           INTENT(IN)  :: xs(:), xt(:)
+  REAL,           INTENT(OUT) :: vt(:,:,:)
+  REAL, OPTIONAL, INTENT(IN)  :: slope(:,:,:)
+!-------------------------------------------------------------------------------
+! Local variables:
+  INTEGER :: is, it, ns, nt
+  REAL    :: co, idt
+  LOGICAL :: lslope
+!-------------------------------------------------------------------------------
+  lslope=PRESENT(slope)
+  CALL check_size(ix,SHAPE(vs),SHAPE(vt),xs,xt,ns,nt)
+  is=locate(xs,xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
+  vt(:,:,:)=0.
+  DO it=1, nt; idt=1./(xt(it+1)-xt(it))
+    IF(xt(it+1)<=xs(is+1)) THEN          !--- xs(is)<=xt(it)<=xt(it+1)<=xs(is+1)
+      CALL mean_lin(xt(it),xt(it+1))
+    ELSE
+      CALL mean_lin(xt(it),xs(is+1)); is=is+1
+      DO WHILE(xs(is+1)<xt(it+1))        !--- 1<=is<=ns-1
+      CALL mean_lin(xs(is),xs(is+1)); is=is+1
+      END DO
+      CALL mean_lin(xs(is),xt(it+1))     !--- 1<=is<=ns
+    END IF
+    IF(xs(is+1)==xt(it+1)) is=is+1       !--- 1<=is<=ns .OR. it==nt
+  END DO
+
+CONTAINS
+
+!-------------------------------------------------------------------------------
+SUBROUTINE mean_lin(a,b)  ! mean [a,b] of the linear function in [xs(is),xs(is+1)]
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN)    :: a, b
+!-------------------------------------------------------------------------------
+  IF(lslope.AND.(a/=xs(is).OR.b/=xs(is+1))) THEN; co=0.
+    IF(a==xt(it  )) co=co+xt(it  )-xs(is  )
+    IF(b==xt(it+1)) co=co+xt(it+1)-xs(is+1)
+    IF(ix==1) vt(it,:,:) = vt(it,:,:)+idt*(b-a)*(vs(is,:,:)+co*slope(is,:,:)/2.)
+    IF(ix==2) vt(:,it,:) = vt(:,it,:)+idt*(b-a)*(vs(:,is,:)+co*slope(:,is,:)/2.)
+    IF(ix==3) vt(:,:,it) = vt(:,:,it)+idt*(b-a)*(vs(:,:,is)+co*slope(:,:,is)/2.)
+  ELSE
+    IF(ix==1) vt(it,:,:) = vt(it,:,:)+idt*(b-a)* vs(is,:,:)
+    IF(ix==2) vt(:,it,:) = vt(:,it,:)+idt*(b-a)* vs(:,is,:)
+    IF(ix==3) vt(:,:,it) = vt(:,:,it)+idt*(b-a)* vs(:,:,is)
+  END IF
+
+END SUBROUTINE mean_lin
+!-------------------------------------------------------------------------------
+
+END SUBROUTINE regr3_conserv
+
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE regr4_conserv(ix, vs, xs, xt, vt, slope)
+
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER,        INTENT(IN)  :: ix
+  REAL,           INTENT(IN)  :: vs(:,:,:,:)
+  REAL,           INTENT(IN)  :: xs(:), xt(:)
+  REAL,           INTENT(OUT) :: vt(:,:,:,:)
+  REAL, OPTIONAL, INTENT(IN)  :: slope(:,:,:,:)
+!-------------------------------------------------------------------------------
+! Local variables:
+  INTEGER :: is, it, ns, nt
+  REAL    :: co, idt
+  LOGICAL :: lslope
+!-------------------------------------------------------------------------------
+  lslope=PRESENT(slope)
+  CALL check_size(ix,SHAPE(vs),SHAPE(vt),xs,xt,ns,nt)
+  is=locate(xs,xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
+  vt(:,:,:,:)=0.
+  DO it=1, nt; idt=1./(xt(it+1)-xt(it))
+    IF(xt(it+1)<=xs(is+1)) THEN          !--- xs(is)<=xt(it)<=xt(it+1)<=xs(is+1)
+      CALL mean_lin(xt(it),xt(it+1))
+    ELSE
+      CALL mean_lin(xt(it),xs(is+1)); is=is+1
+      DO WHILE(xs(is+1)<xt(it+1))        !--- 1<=is<=ns-1
+      CALL mean_lin(xs(is),xs(is+1)); is=is+1
+      END DO
+      CALL mean_lin(xs(is),xt(it+1))     !--- 1<=is<=ns
+    END IF
+    IF(xs(is+1)==xt(it+1)) is=is+1       !--- 1<=is<=ns .OR. it==nt
+  END DO
+
+CONTAINS
+
+!-------------------------------------------------------------------------------
+SUBROUTINE mean_lin(a,b)  ! mean [a,b] of the linear function in [xs(is),xs(is+1)]
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN) :: a, b
+!-------------------------------------------------------------------------------
+  IF(lslope.AND.(a/=xs(is).OR.b/=xs(is+1))) THEN; co=0.
+    IF(a==xt(it  )) co=co+xt(it  )-xs(is  )
+    IF(b==xt(it+1)) co=co+xt(it+1)-xs(is+1)
+    IF(ix==1) vt(it,:,:,:) = vt(it,:,:,:)+idt*(b-a)*(vs(is,:,:,:)+co*slope(is,:,:,:)/2.)
+    IF(ix==2) vt(:,it,:,:) = vt(:,it,:,:)+idt*(b-a)*(vs(:,is,:,:)+co*slope(:,is,:,:)/2.)
+    IF(ix==3) vt(:,:,it,:) = vt(:,:,it,:)+idt*(b-a)*(vs(:,:,is,:)+co*slope(:,:,is,:)/2.)
+    IF(ix==4) vt(:,:,:,it) = vt(:,:,:,it)+idt*(b-a)*(vs(:,:,:,is)+co*slope(:,:,:,is)/2.)
+  ELSE
+    IF(ix==1) vt(it,:,:,:) = vt(it,:,:,:)+idt*(b-a)* vs(is,:,:,:)
+    IF(ix==2) vt(:,it,:,:) = vt(:,it,:,:)+idt*(b-a)* vs(:,is,:,:)
+    IF(ix==3) vt(:,:,it,:) = vt(:,:,it,:)+idt*(b-a)* vs(:,:,is,:)
+    IF(ix==4) vt(:,:,:,it) = vt(:,:,:,it)+idt*(b-a)* vs(:,:,:,is)
+  END IF
+
+END SUBROUTINE mean_lin
+!-------------------------------------------------------------------------------
+
+END SUBROUTINE regr4_conserv
+
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE regr5_conserv(ix, vs, xs, xt, vt, slope)
+
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER,        INTENT(IN)  :: ix
+  REAL,           INTENT(IN)  :: vs(:,:,:,:,:)
+  REAL,           INTENT(IN)  :: xs(:), xt(:)
+  REAL,           INTENT(OUT) :: vt(:,:,:,:,:)
+  REAL, OPTIONAL, INTENT(IN)  :: slope(:,:,:,:,:)
+!-------------------------------------------------------------------------------
+! Local variables:
+  INTEGER :: is, it, ns, nt
+  REAL    :: co, idt
+  LOGICAL :: lslope
+!-------------------------------------------------------------------------------
+  lslope=PRESENT(slope)
+  CALL check_size(ix,SHAPE(vs),SHAPE(vt),xs,xt,ns,nt)
+  is=locate(xs,xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
+  vt(:,:,:,:,:)=0.
+  DO it=1, nt; idt=1./(xt(it+1)-xt(it))
+    IF(xt(it+1)<=xs(is+1)) THEN          !--- xs(is)<=xt(it)<=xt(it+1)<=xs(is+1)
+      CALL mean_lin(xt(it),xt(it+1))
+    ELSE
+      CALL mean_lin(xt(it),xs(is+1)); is=is+1
+      DO WHILE(xs(is+1)<xt(it+1))        !--- 1<=is<=ns-1
+      CALL mean_lin(xs(is),xs(is+1)); is=is+1
+      END DO
+      CALL mean_lin(xs(is),xt(it+1))     !--- 1<=is<=ns
+    END IF
+    IF(xs(is+1)==xt(it+1)) is=is+1     !--- 1<=is<=ns .OR. it==nt
+  END DO
+
+CONTAINS
+
+!-------------------------------------------------------------------------------
+SUBROUTINE mean_lin(a,b)  ! mean [a,b] of the linear function in [xs(is),xs(is+1)]
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN) :: a, b
+!-------------------------------------------------------------------------------
+  IF(lslope.AND.(a/=xs(is).OR.b/=xs(is+1))) THEN; co=0.
+    IF(a==xt(it  )) co=co+xt(it  )-xs(is  )
+    IF(b==xt(it+1)) co=co+xt(it+1)-xs(is+1)
+    IF(ix==1) vt(it,:,:,:,:) = vt(it,:,:,:,:)+idt*(b-a)*(vs(is,:,:,:,:)+co*slope(is,:,:,:,:)/2.)
+    IF(ix==2) vt(:,it,:,:,:) = vt(:,it,:,:,:)+idt*(b-a)*(vs(:,is,:,:,:)+co*slope(:,is,:,:,:)/2.)
+    IF(ix==3) vt(:,:,it,:,:) = vt(:,:,it,:,:)+idt*(b-a)*(vs(:,:,is,:,:)+co*slope(:,:,is,:,:)/2.)
+    IF(ix==4) vt(:,:,:,it,:) = vt(:,:,:,it,:)+idt*(b-a)*(vs(:,:,:,is,:)+co*slope(:,:,:,is,:)/2.)
+    IF(ix==5) vt(:,:,:,:,it) = vt(:,:,:,:,it)+idt*(b-a)*(vs(:,:,:,:,is)+co*slope(:,:,:,:,is)/2.)
+  ELSE
+    IF(ix==1) vt(it,:,:,:,:) = vt(it,:,:,:,:)+idt*(b-a)* vs(is,:,:,:,:)
+    IF(ix==2) vt(:,it,:,:,:) = vt(:,it,:,:,:)+idt*(b-a)* vs(:,is,:,:,:)
+    IF(ix==3) vt(:,:,it,:,:) = vt(:,:,it,:,:)+idt*(b-a)* vs(:,:,is,:,:)
+    IF(ix==4) vt(:,:,:,it,:) = vt(:,:,:,it,:)+idt*(b-a)* vs(:,:,:,is,:)
+    IF(ix==5) vt(:,:,:,:,it) = vt(:,:,:,:,it)+idt*(b-a)* vs(:,:,:,:,is)
+  END IF
+
+END SUBROUTINE mean_lin
+!-------------------------------------------------------------------------------
+
+END SUBROUTINE regr5_conserv
+
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+
+SUBROUTINE check_size(ix,svs,svt,xs,xt,ns,nt)
+
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER, INTENT(IN)  :: ix, svs(:), svt(:)
+  REAL,    INTENT(IN)  :: xs(:), xt(:)
+  INTEGER, INTENT(OUT) :: ns,    nt
+!-------------------------------------------------------------------------------
+! Local variables:
+  INTEGER :: rk, is, ii, n
+  CHARACTER(LEN=80) :: sub, msg
+!-------------------------------------------------------------------------------
+  WRITE(sub,'(a,2i0,a)')"regr",SIZE(svs),ix,"_conserv"
+  rk=assert_eq(SIZE(svs),SIZE(svt),TRIM(sub)//': inconsistent ranks')
+  WRITE(msg,'(a,2(i0,a))')TRIM(sub)//": ix (",ix,") exceeds field rank (",rk,")"
+  CALL assert(ix>=1.AND.ix<=rk,msg)
+  ii=0
+  DO is=1,rk; IF(is==ix) CYCLE
+    WRITE(msg,'(a,i0)')TRIM(sub)//" n",is
+    n=assert_eq(svs(is),svt(is),msg)
+    ii=ii+1
+  END DO
+  ns=assert_eq(svs(ix),SIZE(xs)-1,TRIM(sub)//" ns")
+  nt=assert_eq(svt(ix),SIZE(xt)-1,TRIM(sub)//" nt")
+
+  !--- Quick check on sort order:
+  CALL assert(xs(1)<xs(2), TRIM(sub)//": xs bad order")
+  CALL assert(xt(1)<xt(2), TRIM(sub)//": xt bad order")
+  CALL assert(xs(1)<=xt(1).AND.xt(nt+1)<=xs(ns+1), TRIM(sub)//": extrapolation")
+
+END SUBROUTINE check_size
+
+!-------------------------------------------------------------------------------
+
+
+END MODULE lmdz_regr_conserv
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_regr_lint.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_regr_lint.f90	(revision 5117)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_regr_lint.f90	(revision 5117)
@@ -0,0 +1,219 @@
+MODULE lmdz_regr_lint
+
+  USE lmdz_assert_eq, ONLY: assert_eq
+  USE lmdz_assert, ONLY: assert
+  USE lmdz_interpolation, ONLY: hunt
+
+  IMPLICIT NONE
+
+  ! Purpose: Each procedure regrids by linear interpolation along dimension "ix"
+  !          the input field "vs" to the output field "vt".
+  ! Remark:
+  !   * "vs" and "vt" have the same dimensions except Nr. ix (ns for vs, nt for vt)
+
+  ! Argument                         Type         Description
+  !-------------------------------------------------------------------------------
+  !  INTEGER, INTENT(IN)  :: ix      Scalar       dimension regridded <=rank(vs)
+  !  REAL,    INTENT(IN)  :: vs(*)   Rank>=1      source grid field values
+  !  REAL,    INTENT(IN)  :: xs(:)   Vector(ns)   centers of source grid, asc. order
+  !  REAL,    INTENT(IN)  :: xt(:)   Vector(nt)   centers of target grid, asc. order
+  !  REAL,    INTENT(OUT) :: vt(*)   Rank>=1      regridded field
+
+  INTERFACE regr_lint
+    ! The procedures differ only from the rank of the input/output fields.
+    MODULE PROCEDURE regr1_lint, regr2_lint, regr3_lint, &
+            regr4_lint, regr5_lint
+  END INTERFACE
+
+  PRIVATE
+  PUBLIC :: regr_lint
+
+CONTAINS
+
+
+  !-------------------------------------------------------------------------------
+
+  SUBROUTINE regr1_lint(ix, vs, xs, xt, vt)
+
+    !-------------------------------------------------------------------------------
+    ! Arguments:
+    INTEGER, INTENT(IN) :: ix
+    REAL, INTENT(IN) :: vs(:)
+    REAL, INTENT(IN) :: xs(:)
+    REAL, INTENT(IN) :: xt(:)
+    REAL, INTENT(OUT) :: vt(:)
+    !-------------------------------------------------------------------------------
+    ! Local variables:
+    INTEGER :: is, it, ns, nt, isb ! "is" bound between 1 and "ns - 1"
+    REAL :: r
+    !-------------------------------------------------------------------------------
+    CALL check_size(ix, SHAPE(vs), SHAPE(vt), SIZE(xs), SIZE(xt), ns, nt)
+    is = -1 ! go immediately to bisection on first CALL to "hunt"
+    DO it = 1, SIZE(xt)
+      CALL hunt(xs, xt(it), is); isb = MIN(MAX(is, 1), ns - 1)
+      r = (xs(isb + 1) - xt(it)) / (xs(isb + 1) - xs(isb))
+      vt(it) = r * vs(isb) + (1. - r) * vs(isb + 1)
+    END DO
+
+  END SUBROUTINE regr1_lint
+
+  !-------------------------------------------------------------------------------
+
+
+  !-------------------------------------------------------------------------------
+
+  SUBROUTINE regr2_lint(ix, vs, xs, xt, vt)
+
+    !-------------------------------------------------------------------------------
+    ! Arguments:
+    INTEGER, INTENT(IN) :: ix
+    REAL, INTENT(IN) :: vs(:, :)
+    REAL, INTENT(IN) :: xs(:)
+    REAL, INTENT(IN) :: xt(:)
+    REAL, INTENT(OUT) :: vt(:, :)
+    !-------------------------------------------------------------------------------
+    ! Local variables:
+    INTEGER :: is, it, ns, nt, isb ! "is" bound between 1 and "ns - 1"
+    REAL :: r
+    !-------------------------------------------------------------------------------
+    CALL check_size(ix, SHAPE(vs), SHAPE(vt), SIZE(xs), SIZE(xt), ns, nt)
+    is = -1 ! go immediately to bisection on first CALL to "hunt"
+    DO it = 1, SIZE(xt)
+      CALL hunt(xs, xt(it), is); isb = MIN(MAX(is, 1), ns - 1)
+      r = (xs(isb + 1) - xt(it)) / (xs(isb + 1) - xs(isb))
+      IF(ix==1) vt(it, :) = r * vs(isb, :) + (1. - r) * vs(isb + 1, :)
+      IF(ix==2) vt(:, it) = r * vs(:, isb) + (1. - r) * vs(:, isb + 1)
+    END DO
+
+  END SUBROUTINE regr2_lint
+
+  !-------------------------------------------------------------------------------
+
+
+  !-------------------------------------------------------------------------------
+
+  SUBROUTINE regr3_lint(ix, vs, xs, xt, vt)
+
+    !-------------------------------------------------------------------------------
+    ! Arguments:
+    INTEGER, INTENT(IN) :: ix
+    REAL, INTENT(IN) :: vs(:, :, :)
+    REAL, INTENT(IN) :: xs(:)
+    REAL, INTENT(IN) :: xt(:)
+    REAL, INTENT(OUT) :: vt(:, :, :)
+    !-------------------------------------------------------------------------------
+    ! Local variables:
+    INTEGER :: is, it, ns, nt, isb ! "is" bound between 1 and "ns - 1"
+    REAL :: r
+    !-------------------------------------------------------------------------------
+    CALL check_size(ix, SHAPE(vs), SHAPE(vt), SIZE(xs), SIZE(xt), ns, nt)
+    is = -1 ! go immediately to bisection on first CALL to "hunt"
+    DO it = 1, SIZE(xt)
+      CALL hunt(xs, xt(it), is); isb = MIN(MAX(is, 1), ns - 1)
+      r = (xs(isb + 1) - xt(it)) / (xs(isb + 1) - xs(isb))
+      IF(ix==1) vt(it, :, :) = r * vs(isb, :, :) + (1. - r) * vs(isb + 1, :, :)
+      IF(ix==2) vt(:, it, :) = r * vs(:, isb, :) + (1. - r) * vs(:, isb + 1, :)
+      IF(ix==3) vt(:, :, it) = r * vs(:, :, isb) + (1. - r) * vs(:, :, isb + 1)
+    END DO
+
+  END SUBROUTINE regr3_lint
+
+  !-------------------------------------------------------------------------------
+
+
+  !-------------------------------------------------------------------------------
+
+  SUBROUTINE regr4_lint(ix, vs, xs, xt, vt)
+
+    !-------------------------------------------------------------------------------
+    ! Arguments:
+    INTEGER, INTENT(IN) :: ix
+    REAL, INTENT(IN) :: vs(:, :, :, :)
+    REAL, INTENT(IN) :: xs(:)
+    REAL, INTENT(IN) :: xt(:)
+    REAL, INTENT(OUT) :: vt(:, :, :, :)
+    !-------------------------------------------------------------------------------
+    ! Local variables:
+    INTEGER :: is, it, ns, nt, isb ! "is" bound between 1 and "ns - 1"
+    REAL :: r
+    !-------------------------------------------------------------------------------
+    CALL check_size(ix, SHAPE(vs), SHAPE(vt), SIZE(xs), SIZE(xt), ns, nt)
+    is = -1 ! go immediately to bisection on first CALL to "hunt"
+    DO it = 1, SIZE(xt)
+      CALL hunt(xs, xt(it), is); isb = MIN(MAX(is, 1), ns - 1)
+      r = (xs(isb + 1) - xt(it)) / (xs(isb + 1) - xs(isb))
+      IF(ix==1) vt(it, :, :, :) = r * vs(isb, :, :, :) + (1. - r) * vs(isb + 1, :, :, :)
+      IF(ix==2) vt(:, it, :, :) = r * vs(:, isb, :, :) + (1. - r) * vs(:, isb + 1, :, :)
+      IF(ix==3) vt(:, :, it, :) = r * vs(:, :, isb, :) + (1. - r) * vs(:, :, isb + 1, :)
+      IF(ix==4) vt(:, :, :, it) = r * vs(:, :, :, isb) + (1. - r) * vs(:, :, :, isb + 1)
+    END DO
+
+  END SUBROUTINE regr4_lint
+
+  !-------------------------------------------------------------------------------
+
+
+  !-------------------------------------------------------------------------------
+
+  SUBROUTINE regr5_lint(ix, vs, xs, xt, vt)
+
+    !-------------------------------------------------------------------------------
+    ! Arguments:
+    INTEGER, INTENT(IN) :: ix
+    REAL, INTENT(IN) :: vs(:, :, :, :, :)
+    REAL, INTENT(IN) :: xs(:)
+    REAL, INTENT(IN) :: xt(:)
+    REAL, INTENT(OUT) :: vt(:, :, :, :, :)
+    !-------------------------------------------------------------------------------
+    ! Local variables:
+    INTEGER :: is, it, ns, nt, isb ! "is" bound between 1 and "ns - 1"
+    REAL :: r
+    !-------------------------------------------------------------------------------
+    CALL check_size(ix, SHAPE(vs), SHAPE(vt), SIZE(xs), SIZE(xt), ns, nt)
+    is = -1 ! go immediately to bisection on first CALL to "hunt"
+    DO it = 1, SIZE(xt)
+      CALL hunt(xs, xt(it), is); isb = MIN(MAX(is, 1), ns - 1)
+      r = (xs(isb + 1) - xt(it)) / (xs(isb + 1) - xs(isb))
+      IF(ix==1) vt(it, :, :, :, :) = r * vs(isb, :, :, :, :) + (1. - r) * vs(isb + 1, :, :, :, :)
+      IF(ix==2) vt(:, it, :, :, :) = r * vs(:, isb, :, :, :) + (1. - r) * vs(:, isb + 1, :, :, :)
+      IF(ix==3) vt(:, :, it, :, :) = r * vs(:, :, isb, :, :) + (1. - r) * vs(:, :, isb + 1, :, :)
+      IF(ix==4) vt(:, :, :, it, :) = r * vs(:, :, :, isb, :) + (1. - r) * vs(:, :, :, isb + 1, :)
+      IF(ix==5) vt(:, :, :, :, it) = r * vs(:, :, :, :, isb) + (1. - r) * vs(:, :, :, :, isb + 1)
+    END DO
+
+  END SUBROUTINE regr5_lint
+
+  !-------------------------------------------------------------------------------
+
+
+  !-------------------------------------------------------------------------------
+
+  SUBROUTINE check_size(ix, svs, svt, nxs, nxt, ns, nt)
+
+    !-------------------------------------------------------------------------------
+    ! Arguments:
+    INTEGER, INTENT(IN) :: ix, svs(:), svt(:), nxs, nxt
+    INTEGER, INTENT(OUT) :: ns, nt
+    !-------------------------------------------------------------------------------
+    ! Local variables:
+    INTEGER :: rk, is
+    CHARACTER(LEN = 80) :: sub, msg
+    !-------------------------------------------------------------------------------
+    rk = SIZE(svs)
+    WRITE(sub, '(a,2i0,a)')"regr", rk, ix, "_lint"
+    CALL assert(ix>=1.AND.ix<=rk, TRIM(sub) // ": ix exceeds fields rank")
+    DO is = 1, rk; IF(is==ix) CYCLE
+    WRITE(msg, '(a,i1)')TRIM(sub) // " n", is
+    CALL assert(svs(is)==svt(is), msg)
+    END DO
+    ns = assert_eq(svs(ix), nxs, TRIM(sub) // " ns")
+    nt = assert_eq(svt(ix), nxt, TRIM(sub) // " nt")
+
+  END SUBROUTINE check_size
+
+  !-------------------------------------------------------------------------------
+
+END MODULE lmdz_regr_lint
+
+!-------------------------------------------------------------------------------
+
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_slopes.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_slopes.f90	(revision 5117)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_slopes.f90	(revision 5117)
@@ -0,0 +1,283 @@
+MODULE lmdz_slopes
+
+  ! Author: Lionel GUEZ
+  ! Extension / factorisation: David CUGNET
+
+  IMPLICIT NONE
+
+  ! Those generic function computes second order slopes with Van
+  ! Leer slope-limiting, given cell averages. Reference: Dukowicz,
+  ! 1987, SIAM Journal on Scientific and Statistical Computing, 8,
+  ! 305.
+
+  ! The only difference between the specific functions is the rank
+  ! of the first argument and the equal rank of the result.
+
+  ! slope(ix,...) acts on ix th dimension.
+
+  ! REAL, INTENT(IN), rank >= 1:: f ! (n, ...) cell averages, n must be >= 1
+  ! REAL, INTENT(IN):: x(:) ! (n + 1) cell edges
+  ! real slopes, same shape as f ! (n, ...)
+  INTERFACE slopes
+     MODULE procedure slopes1, slopes2, slopes3, slopes4, slopes5
+  END INTERFACE
+
+  PRIVATE
+  PUBLIC :: slopes
+
+CONTAINS
+
+!-------------------------------------------------------------------------------
+
+PURE FUNCTION slopes1(ix, f, x)
+
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER, INTENT(IN) :: ix
+  REAL,    INTENT(IN) :: f(:)
+  REAL,    INTENT(IN) :: x(:)
+  REAL :: slopes1(SIZE(f,1))
+!-------------------------------------------------------------------------------
+! Local:
+  INTEGER :: n, i, j, sta(2), sto(2)
+  REAL :: xc(SIZE(f,1))                             ! (n) cell centers
+  REAL :: h(2:SIZE(f,1)-1), delta_xc(2:SIZE(f,1)-1) ! (2:n-1)
+  REAL :: fm, ff, fp, dx
+!-------------------------------------------------------------------------------
+  n=SIZE(f,ix)
+  FORALL(i=1:n) xc(i)=(x(i)+x(i+1))/2.
+  FORALL(i=2:n-1)
+    h(i)=ABS(x(i+1)-xc(i)) ; delta_xc(i)=xc(i+1)-xc(i-1)
+  END FORALL
+  slopes1(:)=0.
+  DO i=2,n-1
+    ff=f(i); fm=f(i-1); fp=f(i+1)
+    IF(ff>=MAX(fm,fp).OR.ff<=MIN(fm,fp)) THEN
+      slopes1(i)=0.; CYCLE           !--- Local extremum
+      !--- 2nd order slope ; (fm, ff, fp) strictly monotonous
+      slopes1(i)=(fp-fm)/delta_xc(i)
+      !--- Slope limitation
+      slopes1(i) = SIGN(MIN(ABS(slopes1(i)), &
+        ABS(fp-ff)/h(i),ABS(ff-fm)/h(i)),slopes1(i) )
+     END IF
+  END DO
+
+END FUNCTION slopes1
+
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+
+PURE FUNCTION slopes2(ix, f, x)
+
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER, INTENT(IN) :: ix
+  REAL,    INTENT(IN) :: f(:, :)
+  REAL,    INTENT(IN) :: x(:)
+  REAL :: slopes2(SIZE(f,1),SIZE(f,2))
+!-------------------------------------------------------------------------------
+! Local:
+  INTEGER :: n, i, j, sta(2), sto(2)
+  REAL, ALLOCATABLE :: xc(:)                        ! (n) cell centers
+  REAL, ALLOCATABLE :: h(:), delta_xc(:)            ! (2:n-1)
+  REAL :: fm, ff, fp, dx
+!-------------------------------------------------------------------------------
+  n=SIZE(f,ix); ALLOCATE(xc(n),h(2:n-1),delta_xc(2:n-1))
+  FORALL(i=1:n) xc(i)=(x(i)+x(i+1))/2.
+  FORALL(i=2:n-1)
+    h(i)=ABS(x(i+1)-xc(i)) ; delta_xc(i)=xc(i+1)-xc(i-1)
+  END FORALL
+  slopes2(:,:)=0.
+  sta=[1,1]; sta(ix)=2
+  sto=SHAPE(f); sto(ix)=n-1
+  DO j=sta(2),sto(2); IF(ix==2) dx=delta_xc(j)
+    DO i=sta(1),sto(1); IF(ix==1) dx=delta_xc(i)
+      ff=f(i,j)
+      SELECT CASE(ix)
+        CASE(1); fm=f(i-1,j); fp=f(i+1,j)
+        CASE(2); fm=f(i,j-1); fp=f(i,j+1)
+      END SELECT
+      IF(ff>=MAX(fm,fp).OR.ff<=MIN(fm,fp)) THEN
+        slopes2(i,j)=0.; CYCLE           !--- Local extremum
+        !--- 2nd order slope ; (fm, ff, fp) strictly monotonous
+        slopes2(i,j)=(fp-fm)/dx
+        !--- Slope limitation
+        slopes2(i,j) = SIGN(MIN(ABS(slopes2(i,j)), &
+          ABS(fp-ff)/h(i),ABS(ff-fm)/h(i)),slopes2(i,j) )
+       END IF
+    END DO
+  END DO
+  DEALLOCATE(xc,h,delta_xc)
+
+END FUNCTION slopes2
+
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+
+PURE FUNCTION slopes3(ix, f, x)
+
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER, INTENT(IN) :: ix
+  REAL,    INTENT(IN) :: f(:, :, :)
+  REAL,    INTENT(IN) :: x(:)
+  REAL :: slopes3(SIZE(f,1),SIZE(f,2),SIZE(f,3))
+!-------------------------------------------------------------------------------
+! Local:
+  INTEGER :: n, i, j, k, sta(3), sto(3)
+  REAL, ALLOCATABLE :: xc(:)                        ! (n) cell centers
+  REAL, ALLOCATABLE :: h(:), delta_xc(:)            ! (2:n-1)
+  REAL :: fm, ff, fp, dx
+!-------------------------------------------------------------------------------
+  n=SIZE(f,ix); ALLOCATE(xc(n),h(2:n-1),delta_xc(2:n-1))
+  FORALL(i=1:n) xc(i)=(x(i)+x(i+1))/2.
+  FORALL(i=2:n-1)
+    h(i)=ABS(x(i+1)-xc(i)) ; delta_xc(i)=xc(i+1)-xc(i-1)
+  END FORALL
+  slopes3(:,:,:)=0.
+  sta=[1,1,1]; sta(ix)=2
+  sto=SHAPE(f); sto(ix)=n-1
+  DO k=sta(3),sto(3); IF(ix==3) dx=delta_xc(k)
+    DO j=sta(2),sto(2); IF(ix==2) dx=delta_xc(j)
+      DO i=sta(1),sto(1); IF(ix==1) dx=delta_xc(i)
+        ff=f(i,j,k)
+        SELECT CASE(ix)
+          CASE(1); fm=f(i-1,j,k); fp=f(i+1,j,k)
+          CASE(2); fm=f(i,j-1,k); fp=f(i,j+1,k)
+          CASE(3); fm=f(i,j,k-1); fp=f(i,j,k+1)
+        END SELECT
+        IF(ff>=MAX(fm,fp).OR.ff<=MIN(fm,fp)) THEN
+          slopes3(i,j,k)=0.; CYCLE           !--- Local extremum
+          !--- 2nd order slope ; (fm, ff, fp) strictly monotonous
+          slopes3(i,j,k)=(fp-fm)/dx
+          !--- Slope limitation
+          slopes3(i,j,k) = SIGN(MIN(ABS(slopes3(i,j,k)), &
+            ABS(fp-ff)/h(i),ABS(ff-fm)/h(i)),slopes3(i,j,k) )
+         END IF
+      END DO
+    END DO
+  END DO
+  DEALLOCATE(xc,h,delta_xc)
+
+END FUNCTION slopes3
+
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+
+PURE FUNCTION slopes4(ix, f, x)
+
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER, INTENT(IN) :: ix
+  REAL,    INTENT(IN) :: f(:, :, :, :)
+  REAL,    INTENT(IN) :: x(:)
+  REAL :: slopes4(SIZE(f,1),SIZE(f,2),SIZE(f,3),SIZE(f,4))
+!-------------------------------------------------------------------------------
+! Local:
+  INTEGER :: n, i, j, k, l, m, sta(4), sto(4)
+  REAL, ALLOCATABLE :: xc(:)                        ! (n) cell centers
+  REAL, ALLOCATABLE :: h(:), delta_xc(:)            ! (2:n-1)
+  REAL :: fm, ff, fp, dx
+!-------------------------------------------------------------------------------
+  n=SIZE(f,ix); ALLOCATE(xc(n),h(2:n-1),delta_xc(2:n-1))
+  FORALL(i=1:n) xc(i)=(x(i)+x(i+1))/2.
+  FORALL(i=2:n-1)
+    h(i)=ABS(x(i+1)-xc(i)) ; delta_xc(i)=xc(i+1)-xc(i-1)
+  END FORALL
+  slopes4(:,:,:,:)=0.
+  sta=[1,1,1,1]; sta(ix)=2
+  sto=SHAPE(f); sto(ix)=n-1
+  DO l=sta(4),sto(4); IF(ix==4) dx=delta_xc(l)
+    DO k=sta(3),sto(3); IF(ix==3) dx=delta_xc(k)
+      DO j=sta(2),sto(2); IF(ix==2) dx=delta_xc(j)
+        DO i=sta(1),sto(1); IF(ix==1) dx=delta_xc(i)
+          ff=f(i,j,k,l)
+          SELECT CASE(ix)
+            CASE(1); fm=f(i-1,j,k,l); fp=f(i+1,j,k,l)
+            CASE(2); fm=f(i,j-1,k,l); fp=f(i,j+1,k,l)
+            CASE(3); fm=f(i,j,k-1,l); fp=f(i,j,k+1,l)
+            CASE(4); fm=f(i,j,k,l-1); fp=f(i,j,k,l+1)
+          END SELECT
+          IF(ff>=MAX(fm,fp).OR.ff<=MIN(fm,fp)) THEN
+            slopes4(i,j,k,l)=0.; CYCLE           !--- Local extremum
+            !--- 2nd order slope ; (fm, ff, fp) strictly monotonous
+            slopes4(i,j,k,l)=(fp-fm)/dx
+            !--- Slope limitation
+            slopes4(i,j,k,l) = SIGN(MIN(ABS(slopes4(i,j,k,l)), &
+              ABS(fp-ff)/h(i),ABS(ff-fm)/h(i)),slopes4(i,j,k,l) )
+           END IF
+        END DO
+      END DO
+    END DO
+  END DO
+  DEALLOCATE(xc,h,delta_xc)
+
+END FUNCTION slopes4
+
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+
+PURE FUNCTION slopes5(ix, f, x)
+
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER, INTENT(IN) :: ix
+  REAL,    INTENT(IN) :: f(:, :, :, :, :)
+  REAL,    INTENT(IN) :: x(:)
+  REAL :: slopes5(SIZE(f,1),SIZE(f,2),SIZE(f,3),SIZE(f,4),SIZE(f,5))
+!-------------------------------------------------------------------------------
+! Local:
+  INTEGER :: n, i, j, k, l, m, sta(5), sto(5)
+  REAL, ALLOCATABLE :: xc(:)                        ! (n) cell centers
+  REAL, ALLOCATABLE :: h(:), delta_xc(:)            ! (2:n-1)
+  REAL :: fm, ff, fp, dx
+!-------------------------------------------------------------------------------
+  n=SIZE(f,ix); ALLOCATE(xc(n),h(2:n-1),delta_xc(2:n-1))
+  FORALL(i=1:n) xc(i)=(x(i)+x(i+1))/2.
+  FORALL(i=2:n-1)
+    h(i)=ABS(x(i+1)-xc(i)) ; delta_xc(i)=xc(i+1)-xc(i-1)
+  END FORALL
+  slopes5(:,:,:,:,:)=0.
+  sta=[1,1,1,1,1]; sta(ix)=2
+  sto=SHAPE(f);    sto(ix)=n-1
+  DO m=sta(5),sto(5); IF(ix==5) dx=delta_xc(m)
+    DO l=sta(4),sto(4); IF(ix==4) dx=delta_xc(l)
+      DO k=sta(3),sto(3); IF(ix==3) dx=delta_xc(k)
+        DO j=sta(2),sto(2); IF(ix==2) dx=delta_xc(j)
+          DO i=sta(1),sto(1); IF(ix==1) dx=delta_xc(i)
+            ff=f(i,j,k,l,m)
+            SELECT CASE(ix)
+              CASE(1); fm=f(i-1,j,k,l,m); fp=f(i+1,j,k,l,m)
+              CASE(2); fm=f(i,j-1,k,l,m); fp=f(i,j+1,k,l,m)
+              CASE(3); fm=f(i,j,k-1,l,m); fp=f(i,j,k+1,l,m)
+              CASE(4); fm=f(i,j,k,l-1,m); fp=f(i,j,k,l+1,m)
+              CASE(5); fm=f(i,j,k,l,m-1); fp=f(i,j,k,l,m+1)
+            END SELECT
+            IF(ff>=MAX(fm,fp).OR.ff<=MIN(fm,fp)) THEN
+              slopes5(i,j,k,l,m)=0.; CYCLE           !--- Local extremum
+              !--- 2nd order slope ; (fm, ff, fp) strictly monotonous
+              slopes5(i,j,k,l,m)=(fp-fm)/dx
+              !--- Slope limitation
+              slopes5(i,j,k,l,m) = SIGN(MIN(ABS(slopes5(i,j,k,l,m)), &
+                ABS(fp-ff)/h(i),ABS(ff-fm)/h(i)),slopes5(i,j,k,l,m) )
+            END IF
+          END DO
+        END DO
+      END DO
+    END DO
+  END DO
+  DEALLOCATE(xc,h,delta_xc)
+
+END FUNCTION slopes5
+
+!-------------------------------------------------------------------------------
+
+END MODULE lmdz_slopes
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_strings.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_strings.f90	(revision 5117)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_strings.f90	(revision 5117)
@@ -0,0 +1,1612 @@
+MODULE lmdz_strings
+  IMPLICIT NONE; PRIVATE
+  PUBLIC :: maxlen, init_printout, msg, fmsg, get_in, lunout, prt_level
+  PUBLIC :: strLower, strHead, strStack,  strCount, strReduce,  strClean, strIdx
+  PUBLIC :: strUpper, strTail, strStackm, strParse, strReplace, strFind, find, cat
+  PUBLIC :: dispTable, dispOutliers, dispNameList
+  PUBLIC :: is_numeric, bool2str, int2str, real2str, dble2str
+  PUBLIC :: reduceExpr, str2bool, str2int, str2real, str2dble
+  PUBLIC :: addQuotes, checkList, removeComment
+
+  INTERFACE get_in;     MODULE PROCEDURE getin_s,  getin_i,  getin_r,  getin_l;  END INTERFACE get_in
+  INTERFACE  msg;       MODULE PROCEDURE        msg_1,                    msg_m; END INTERFACE  msg
+  INTERFACE fmsg;       MODULE PROCEDURE       fmsg_1,                   fmsg_m; END INTERFACE fmsg
+  INTERFACE strHead;    MODULE PROCEDURE    strHead_1,                strHead_m; END INTERFACE strHead
+  INTERFACE strTail;    MODULE PROCEDURE    strTail_1,                strTail_m; END INTERFACE strTail
+  INTERFACE strClean;   MODULE PROCEDURE   strClean_1,               strClean_m; END INTERFACE strClean
+  INTERFACE strReduce;  MODULE PROCEDURE  strReduce_1,              strReduce_2; END INTERFACE strReduce
+  INTERFACE strIdx;     MODULE PROCEDURE     strIdx_1,                 strIdx_m; END INTERFACE strIdx
+  INTERFACE strCount;   MODULE PROCEDURE  strCount_m1, strCount_11, strCount_1m; END INTERFACE strCount
+  INTERFACE strReplace; MODULE PROCEDURE strReplace_1,             strReplace_m; END INTERFACE strReplace
+  INTERFACE cat;        MODULE PROCEDURE  horzcat_s00, horzcat_i00, horzcat_r00,  & !horzcat_d00, &
+                                          horzcat_s10, horzcat_i10, horzcat_r10,  & !horzcat_d10, &
+                                          horzcat_s11, horzcat_i11, horzcat_r11,  & !horzcat_d11, &
+                                          horzcat_s21, horzcat_i21, horzcat_r21; END INTERFACE cat !horzcat_d21
+  INTERFACE strFind;      MODULE PROCEDURE strFind_1, strFind_m;                 END INTERFACE strFind
+  INTERFACE find;         MODULE PROCEDURE strFind_1, strFind_m, intFind_1, intFind_m, booFind; END INTERFACE find
+  INTERFACE dispOutliers; MODULE PROCEDURE dispOutliers_1, dispOutliers_2; END INTERFACE dispOutliers
+  INTERFACE reduceExpr;   MODULE PROCEDURE   reduceExpr_1,   reduceExpr_m; END INTERFACE reduceExpr
+  INTERFACE addQuotes;    MODULE PROCEDURE    addQuotes_1,    addQuotes_m; END INTERFACE addQuotes
+
+  INTEGER, PARAMETER :: maxlen    = 256                    !--- Standard maximum length for strings
+  INTEGER,      SAVE :: lunout    = 6                      !--- Printing unit  (default: 6, ie. on screen)
+  INTEGER,      SAVE :: prt_level = 1                      !--- Printing level (default: 1, ie. print all)
+
+CONTAINS
+
+
+!==============================================================================================================================
+SUBROUTINE init_printout(lunout_, prt_level_)
+    INTEGER, INTENT(IN) :: lunout_, prt_level_
+  lunout    = lunout_
+  prt_level = prt_level_
+END SUBROUTINE init_printout
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== Same as getin ; additional last argument: the default value.
+!==============================================================================================================================
+SUBROUTINE getin_s(nam, val, def)
+  USE IOIPSL, ONLY: getin
+    CHARACTER(LEN=*), INTENT(IN)    :: nam
+  CHARACTER(LEN=*), INTENT(INOUT) :: val
+  CHARACTER(LEN=*), INTENT(IN)    :: def
+  val = def; CALL getin(nam, val)
+  IF(val/=def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(val)
+END SUBROUTINE getin_s
+!==============================================================================================================================
+SUBROUTINE getin_i(nam, val, def)
+  USE IOIPSL, ONLY: getin
+  CHARACTER(LEN=*), INTENT(IN)    :: nam
+  INTEGER,          INTENT(INOUT) :: val
+  INTEGER,          INTENT(IN)    :: def
+  val = def; CALL getin(nam, val)
+  IF(val/=def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(int2str(val))
+END SUBROUTINE getin_i
+!==============================================================================================================================
+SUBROUTINE getin_r(nam, val, def)
+  USE IOIPSL,ONLY: getin
+    CHARACTER(LEN=*), INTENT(IN)    :: nam
+  REAL,             INTENT(INOUT) :: val
+  REAL,             INTENT(IN)    :: def
+  val = def; CALL getin(nam, val)
+  IF(val/=def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(real2str(val))
+END SUBROUTINE getin_r
+!==============================================================================================================================
+SUBROUTINE getin_l(nam, val, def)
+  USE IOIPSL, ONLY: getin
+    CHARACTER(LEN=*), INTENT(IN)    :: nam
+  LOGICAL,          INTENT(INOUT) :: val
+  LOGICAL,          INTENT(IN)    :: def
+  val = def; CALL getin(nam, val)
+  IF(val.NEQV.def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(bool2str(val))
+END SUBROUTINE getin_l
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== Display one or several messages, one each line, starting with the current routine name "modname".
+!==============================================================================================================================
+SUBROUTINE msg_1(str, modname, ll, unit)
+    !--- Display a simple message "str". Optional parameters:
+  !    * "modname": module name, displayed in front of the message (with ": " separator) if present.
+  !    * "ll":      message trigger ; message is displayed only if ll==.TRUE.
+  !    * "unit":    write unit (by default: "lunout")
+  CHARACTER(LEN=*),           INTENT(IN) :: str
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
+  LOGICAL,          OPTIONAL, INTENT(IN) :: ll
+  INTEGER,          OPTIONAL, INTENT(IN) :: unit
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: subn
+  INTEGER :: unt
+  subn = '';    IF(PRESENT(modname)) subn = modname
+  IF(PRESENT(ll)) THEN; IF(.NOT.ll) RETURN; END IF
+  unt = lunout; IF(PRESENT(unit)) unt = unit
+  IF(subn == '') WRITE(unt,'(a)') str                                          !--- Simple message
+  IF(subn /= '') WRITE(unt,'(a)') TRIM(subn)//': '//str                        !--- Routine name provided
+END SUBROUTINE msg_1
+!==============================================================================================================================
+SUBROUTINE msg_m(str, modname, ll, unit, nmax)
+    !--- Same as msg_1 with multiple strings that are stacked (separator: coma) on up to "nmax" full lines.
+  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
+  LOGICAL,          OPTIONAL, INTENT(IN) :: ll
+  INTEGER,          OPTIONAL, INTENT(IN) :: unit
+  INTEGER,          OPTIONAL, INTENT(IN) :: nmax
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)
+  CHARACTER(LEN=maxlen) :: subn
+  INTEGER :: unt, nmx, k
+  LOGICAL :: l
+  subn = '';    IF(PRESENT(modname)) subn = modname
+  l   = .TRUE.; IF(PRESENT(ll))     l = ll
+  unt = lunout; IF(PRESENT(unit)) unt = unit
+  nmx = 128;    IF(PRESENT(nmax)) nmx = nmax
+  s = strStackm(str, ', ', nmx)
+  DO k=1,SIZE(s); CALL msg_1(s(k), subn,  l,   unt); END DO
+END SUBROUTINE msg_m
+!==============================================================================================================================
+LOGICAL FUNCTION fmsg_1(str, modname, ll, unit) RESULT(l)
+    CHARACTER(LEN=*),           INTENT(IN) :: str
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
+  LOGICAL,          OPTIONAL, INTENT(IN) :: ll
+  INTEGER,          OPTIONAL, INTENT(IN) :: unit
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: subn
+  INTEGER :: unt
+  subn = '';    IF(PRESENT(modname)) subn = modname
+  l   = .TRUE.; IF(PRESENT(ll))     l = ll
+  unt = lunout; IF(PRESENT(unit)) unt = unit
+  CALL msg_1(str, subn, l, unt)
+END FUNCTION fmsg_1
+!==============================================================================================================================
+LOGICAL FUNCTION fmsg_m(str, modname, ll, unit, nmax) RESULT(l)
+    CHARACTER(LEN=*),           INTENT(IN)  :: str(:)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
+  LOGICAL,          OPTIONAL, INTENT(IN) :: ll
+  INTEGER,          OPTIONAL, INTENT(IN) :: unit
+  INTEGER,          OPTIONAL, INTENT(IN)  :: nmax
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: subn
+  INTEGER :: unt, nmx
+  subn = '';    IF(PRESENT(modname)) subn = modname
+  l   = .TRUE.; IF(PRESENT(ll))     l = ll
+  unt = lunout; IF(PRESENT(unit)) unt = unit
+  nmx = 128;    IF(PRESENT(nmax)) nmx = nmax
+  CALL msg_m(str, subn, l, unt, nmx)
+END FUNCTION fmsg_m
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== Lower/upper case conversion function. ====================================================================================
+!==============================================================================================================================
+ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strLower(str) RESULT(OUT)
+    CHARACTER(LEN=*), INTENT(IN) :: str
+  INTEGER :: k
+  out = str
+  DO k=1,LEN_TRIM(str)
+    IF(str(k:k)>='A' .AND. str(k:k)<='Z') out(k:k)=ACHAR(IACHAR(str(k:k))+32)
+  END DO
+END FUNCTION strLower
+!==============================================================================================================================
+ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strUpper(str) RESULT(OUT)
+    CHARACTER(LEN=*), INTENT(IN) :: str
+  INTEGER :: k
+  out = str
+  DO k=1,LEN_TRIM(str)
+    IF(str(k:k)>='a' .AND. str(k:k)<='z') out(k:k)=ACHAR(IACHAR(str(k:k))-32)
+  END DO
+END FUNCTION strUpper
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== Extract the substring in front of the first (last if lBackward==TRUE) occurrence of "sep" in "str"        ================
+!=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect:                           ================
+!===    * strHead(..,.FALSE.) = 'a'           ${str%%$sep*}                                                    ================
+!===    * strHead(..,.TRUE.)  = 'a_b'         ${str%$sep*}                                                     ================
+!==============================================================================================================================
+CHARACTER(LEN=maxlen) FUNCTION strHead_1(str, sep, lBackward) RESULT(OUT)
+    CHARACTER(LEN=*),           INTENT(IN) :: str
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
+  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackward
+!------------------------------------------------------------------------------------------------------------------------------
+  IF(PRESENT(sep)) THEN
+    IF(     PRESENT(lBackWard)) out = str(1:INDEX(str,sep,lBackWard)-1)
+    IF(.NOT.PRESENT(lBackWard)) out = str(1:INDEX(str,sep)-1)
+  ELSE
+    IF(     PRESENT(lBackWard)) out = str(1:INDEX(str,'/',lBackWard)-1)
+    IF(.NOT.PRESENT(lBackWard)) out = str(1:INDEX(str,'/')-1)
+  END IF
+  IF(out == '') out = str
+END FUNCTION strHead_1
+!==============================================================================================================================
+FUNCTION strHead_m(str, sep, lBackward) RESULT(OUT)
+    CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
+  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
+  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackward
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: k
+  IF(PRESENT(sep)) THEN
+    IF(     PRESENT(lBackWard)) out = [(strHead_1(str(k), sep, lBackWard), k=1, SIZE(str))]
+    IF(.NOT.PRESENT(lBackWard)) out = [(strHead_1(str(k), sep),            k=1, SIZE(str))]
+  ELSE
+    IF(     PRESENT(lBackWard)) out = [(strHead_1(str(k), '/', lBackWard), k=1, SIZE(str))]
+    IF(.NOT.PRESENT(lBackWard)) out = [(strHead_1(str(k), '/'),            k=1, SIZE(str))]
+  END IF
+END FUNCTION strHead_m
+!==============================================================================================================================
+!=== Extract the substring following the first (last if lBackward==TRUE) occurrence of "sep" in "str"          ================
+!=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect:                           ================
+!===    * strTail(str, '_', .FALSE.) = 'b_c'         ${str#*$sep}                                              ================
+!===    * strTail(str, '_', .TRUE.)  = 'c'           ${str##*$sep}                                             ================
+!==============================================================================================================================
+CHARACTER(LEN=maxlen) FUNCTION strTail_1(str, sep, lBackWard) RESULT(OUT)
+    CHARACTER(LEN=*),           INTENT(IN) :: str
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
+  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackWard
+!------------------------------------------------------------------------------------------------------------------------------
+  IF(PRESENT(sep)) THEN
+    IF(     PRESENT(lBackWard)) out = str(INDEX(str,sep,lBackWard)+LEN(sep):LEN_TRIM(str))
+    IF(.NOT.PRESENT(lBackWard)) out = str(INDEX(str,sep)          +LEN(sep):LEN_TRIM(str))
+  ELSE
+    IF(     PRESENT(lBackWard)) out = str(INDEX(str,'/',lBackWard)+1:LEN_TRIM(str))
+    IF(.NOT.PRESENT(lBackWard)) out = str(INDEX(str,'/')          +1:LEN_TRIM(str))
+  END IF
+  IF(out == '') out = str
+END FUNCTION strTail_1
+!==============================================================================================================================
+FUNCTION strTail_m(str, sep, lBackWard) RESULT(OUT)
+    CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
+  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
+  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackWard
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: k
+  IF(PRESENT(sep)) THEN
+    IF(     PRESENT(lBackWard)) out = [(strTail_1(str(k), sep, lBackWard), k=1, SIZE(str))]
+    IF(.NOT.PRESENT(lBackWard)) out = [(strTail_1(str(k), sep),            k=1, SIZE(str))]
+  ELSE
+    IF(     PRESENT(lBackWard)) out = [(strTail_1(str(k), '/', lBackWard), k=1, SIZE(str))]
+    IF(.NOT.PRESENT(lBackWard)) out = [(strTail_1(str(k), '/'),            k=1, SIZE(str))]
+  END IF
+END FUNCTION strTail_m
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== Concatenates the strings "str(:)" with separator "sep" into a single string using a separator (',' by default). ==========
+!==============================================================================================================================
+FUNCTION strStack(str, sep, mask) RESULT(OUT)
+    CHARACTER(LEN=:),          ALLOCATABLE :: out
+  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
+  LOGICAL,          OPTIONAL, INTENT(IN) :: mask(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=:), ALLOCATABLE :: s
+  INTEGER :: is, i0
+  IF(SIZE(str) == 0) THEN; out = ''; RETURN; END IF
+  ALLOCATE(s, SOURCE=', '); IF(PRESENT(sep)) s=sep
+  IF(PRESENT(mask)) THEN
+    IF(ALL(.NOT.mask)) THEN; out = ''; RETURN; END IF
+    i0 = 0; DO WHILE(.NOT.mask(i0+1)); i0 = i0+1; END DO
+    out = str(i0); DO is=i0+1,SIZE(str, DIM=1); IF(.NOT.mask(is)) CYCLE; out = TRIM(OUT)//s//TRIM(str(is)); END DO
+  ELSE
+    out = str(1); DO is=2,SIZE(str, DIM=1); out = TRIM(OUT)//s//TRIM(str(is)); END DO
+  END IF
+END FUNCTION strStack
+!==============================================================================================================================
+!=== Concatenate the strings "str(:)" with separator "sep" into one or several lines of "nmax" characters max (for display) ===
+!==============================================================================================================================
+FUNCTION strStackm(str, sep, nmax) RESULT(OUT)
+    CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
+  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
+  INTEGER,          OPTIONAL, INTENT(IN) :: nmax
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: t(:)
+  CHARACTER(LEN=maxlen) :: sp
+  INTEGER :: is, ns, no, mx, n
+  IF(SIZE(str) == 0) THEN; out = ['']; RETURN; END IF
+  sp =', '; IF(PRESENT(sep )) sp = sep
+  ns = 2  ; IF(PRESENT(sep )) ns = LEN(sep)
+  mx = 256; IF(PRESENT(nmax)) mx = nmax
+  no = 1; out = ['']
+  DO is = 1, SIZE(str)
+    n = LEN_TRIM(str(is)); IF(out(no)/='') n = n+ns+LEN_TRIM(out(no))          !--- Line length after "str(is)" inclusion
+    IF(out(no) == '') THEN
+      out(no) = str(is)                                                        !--- Empty new line: set to "str(is)"
+    ELSE IF(n <= mx) THEN
+      out(no) = TRIM(out(no))//sp(1:ns)//TRIM(str(is))                         !--- Append "str(is)" to the current line
+    ELSE
+      ALLOCATE(t(no+1)); t(1:no) = out; no=no+1; t(no) = str(is)               !--- Full line: "str(si)" put in next line
+      CALL MOVE_ALLOC(FROM=t, TO=out)
+    END IF
+  END DO
+END FUNCTION strStackm
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== String cleaning: replace tabulation by spaces, remove NULL characters and comments. ======================================
+!==============================================================================================================================
+SUBROUTINE strClean_1(str)
+    CHARACTER(LEN=*), INTENT(INOUT) :: str
+  INTEGER :: k, n, m
+  n = LEN(str)
+  DO k = n, 1, -1
+    m = IACHAR(str(k:k))
+    IF(m==9) str(k:k) = ' '                           !--- Replace the tabulations with spaces
+    IF(m==0) str(k:n) = str(k+1:n)//' '               !--- Remove the NULL characters
+  END DO
+  m = INDEX(str,'!')-1; IF(m==-1) m = LEN_TRIM(str)   !--- Remove end of line comment
+  str = ADJUSTL(str(1:m))
+END SUBROUTINE strClean_1
+!==============================================================================================================================
+SUBROUTINE strClean_m(str)
+    CHARACTER(LEN=*), INTENT(INOUT) :: str(:)
+  INTEGER :: k
+  DO k = 1, SIZE(str); CALL strClean_1(str(k)); END DO
+END SUBROUTINE strClean_m
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== strReduce_1(str1)     : Remove duplicated elements of str1.    ===========================================================
+!=== strReduce_2(str1,str2): Append str1 with new elements of str2. ===========================================================
+!==============================================================================================================================
+SUBROUTINE strReduce_1(str, nb)
+    CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str(:)
+  INTEGER,          OPTIONAL,    INTENT(OUT)   :: nb
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:)
+  INTEGER :: k, n, n1
+  IF(PRESENT(nb)) nb = 0
+  CALL MOVE_ALLOC(FROM=str, TO=s1); CALL strClean(s1)
+  n1 = SIZE(s1, DIM=1)                                     !--- Total nb. of elements in "s1"
+  n  = COUNT( [( ALL(s1(1:k-1)/=s1(k)), k=1, n1 )] )       !--- Nb of unique elements in "s1"
+  ALLOCATE(str(n))
+  IF(n==0) RETURN
+  str(1) = s1(1)
+  n=1; DO k=2,n1; IF(ANY(s1(1:k-1)==s1(k))) CYCLE; n=n+1; str(n)=s1(k); END DO
+  IF(PRESENT(nb)) nb=n
+END SUBROUTINE strReduce_1
+!==============================================================================================================================
+SUBROUTINE strReduce_2(str1, str2)
+    CHARACTER(LEN=*),   ALLOCATABLE, INTENT(INOUT) :: str1(:)
+  CHARACTER(LEN=*),                INTENT(IN)    :: str2(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:), s2(:)
+  INTEGER :: k
+  IF(SIZE(str2)==0) RETURN
+  s2 = str2; CALL strClean(s2)
+  IF(.NOT.ALLOCATED(s2)) RETURN
+  IF(SIZE(s2) == 0) THEN; DEALLOCATE(s2); RETURN; END IF
+  IF(.NOT.ALLOCATED(str1)) THEN
+    str1 = s2
+  ELSE IF(SIZE(str1)==0) THEN
+    str1 = s2
+  ELSE
+    s1 = str1; CALL strClean(s1)
+    str1 = [s1, PACK(s2, MASK= [( ALL(s1(:) /= s2(k)), k=1, SIZE(s2) )] ) ]
+  END IF
+END SUBROUTINE strReduce_2
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== GET THE INDEX OF THE FIRST APPEARANCE IN THE STRING VECTOR "str(:)" OF THE STRING(s) "s[(:)]" ============================
+!=== OPTIONALY: GET THE NUMBER OF FOUND ELEMENTS "n". NB: UNFOUND => INDEX=0                       ============================
+!==============================================================================================================================
+INTEGER FUNCTION strIdx_1(str, s) RESULT(OUT)
+    CHARACTER(LEN=*), INTENT(IN) :: str(:), s
+  DO out = 1, SIZE(str); IF(str(OUT) == s) EXIT; END DO
+  IF(out == 1+SIZE(str) .OR. SIZE(str)==0) out = 0
+END FUNCTION strIdx_1
+!==============================================================================================================================
+FUNCTION strIdx_m(str, s, n) RESULT(OUT)
+    CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s(:)
+  INTEGER, OPTIONAL, INTENT(OUT) :: n
+  INTEGER,           ALLOCATABLE :: out(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: k
+  out = [(strIdx_1(str(:), s(k)), k=1, SIZE(s))]
+  IF(PRESENT(n)) n = COUNT(out(:)/=0)
+END FUNCTION strIdx_m
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== GET THE INDEX LIST OF THE ELEMENTS OF "str(:)" EQUAL TO "s" AND OPTIONALY, ITS LENGTH "n" ================================
+!==============================================================================================================================
+FUNCTION strFind_1(str, s, n) RESULT(OUT)
+    CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s
+  INTEGER, OPTIONAL, INTENT(OUT) :: n
+  INTEGER,           ALLOCATABLE :: out(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: k
+  out = PACK( [(k, k=1, SIZE(str(:), DIM=1))], MASK = str(:) == s )
+  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
+END FUNCTION strFind_1
+!==============================================================================================================================
+FUNCTION strFind_m(str, s, n) RESULT(OUT)
+    CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s(:)
+  INTEGER, OPTIONAL, INTENT(OUT) :: n
+  INTEGER,           ALLOCATABLE :: out(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: k
+  out = [(strFind_1(str, s(k)), k=1, SIZE(s))]
+  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
+END FUNCTION strFind_m
+!==============================================================================================================================
+FUNCTION intFind_1(i,j,n) RESULT(OUT)
+    INTEGER,           INTENT(IN)  :: i(:), j
+  INTEGER, OPTIONAL, INTENT(OUT) :: n
+  INTEGER,           ALLOCATABLE :: out(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: k
+  out = PACK( [(k, k=1, SIZE(i(:), DIM=1))], MASK = i(:) == j )
+  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
+END FUNCTION intFind_1
+!==============================================================================================================================
+FUNCTION intFind_m(i,j,n) RESULT(OUT)
+    INTEGER,           INTENT(IN)  :: i(:), j(:)
+  INTEGER, OPTIONAL, INTENT(OUT) :: n
+  INTEGER,           ALLOCATABLE :: out(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: k
+  out = [(intFind_1(i, j(k)), k=1, SIZE(j))]
+  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
+END FUNCTION intFind_m
+!==============================================================================================================================
+FUNCTION booFind(l,n) RESULT(OUT)
+    LOGICAL,           INTENT(IN)  :: l(:)
+  INTEGER, OPTIONAL, INTENT(OUT) :: n
+  INTEGER,           ALLOCATABLE :: out(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: k
+  out = PACK( [(k, k=1, SIZE(l(:), DIM=1))], MASK = l(:) )
+  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
+END FUNCTION booFind
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== GET THE INDEX IN "rawList" OF THE 1ST APPEARANCE OF ONE OF THE "del(:)" SEPARATORS (0 IF NONE OF THEM ARE PRESENT)
+!===  IF lSc == .TRUE.:  * SKIP HEAD SIGNS OR EXPONENTS SIGNS THAT SHOULD NOT BE CONFUSED WITH SEPARATORS
+!===                     * THEN TEST WHETHER THE STRING FROM START TO THE FOUND SEPARATOR IS A CORRECTLY FORMATTED NUMBER
+!==============================================================================================================================
+LOGICAL FUNCTION strIdx_prv(rawList, del, ibeg, idx, idel, lSc) RESULT(lerr)
+    CHARACTER(LEN=*),  INTENT(IN)  :: rawList                          !--- String in which delimiters have to be identified
+  CHARACTER(LEN=*),  INTENT(IN)  :: del(:)                           !--- List of delimiters
+  INTEGER,           INTENT(IN)  :: ibeg                             !--- Start index
+  INTEGER,           INTENT(OUT) :: idx                              !--- Index of the first identified delimiter in "rawList"
+  INTEGER,           INTENT(OUT) :: idel                             !--- Index of the identified delimiter (0 if idx==0)
+  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc                              !--- Care about nbs with front sign or in scient. notation
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: idx0                                                    !--- Used to display an identified non-numeric string
+  lerr = .FALSE.
+  idx = strIdx1(rawList, del, ibeg, idel)                            !--- idx/=0: del(idel) is at position "idx" in "rawList"
+  IF(.NOT.PRESENT(lSc))               RETURN                         !--- No need to check exceptions for numbers => finished
+  IF(.NOT.        lSc )               RETURN                         !--- No need to check exceptions for numbers => finished
+
+  !=== No delimiter found: the whole string must be a valid number
+  IF(idx == 0) THEN                                                  !--- No element of "del" in "rawList"
+    lerr = .NOT.is_numeric(rawList(ibeg:LEN_TRIM(rawList)))          !--- String must be a number
+    IF(lerr) idx = LEN_TRIM(rawList); RETURN                         !--- Set idx so that rawList(ibeg:idx-1) = whole string
+  END IF
+
+  lerr = idx == 1 .AND. INDEX('+-',del(idel)) /= 0; IF(lerr) RETURN  !--- The front delimiter is different from +/-: error
+  IF(    idx /= 1 .AND. is_numeric(rawList(ibeg:idx-1)))     RETURN  !--- The input string head is a valid number
+
+  !=== The string part in front of the 1st delimiter is not a valid number: search for next delimiter index "idx"
+  idx0 = idx ; idx = strIdx1(rawList, del, idx+1, idel)              !--- Keep start index because idx is recycled
+  IF(idx == 0) THEN
+    lerr = .NOT.is_numeric(rawList(ibeg:LEN_TRIM(rawList)))          !--- No other delimiter: whole string must be a valid numb
+    IF(lerr) idx = idx0; RETURN
+  END IF
+  lerr = .NOT.is_numeric(rawList(ibeg:idx-1))
+
+CONTAINS
+
+!------------------------------------------------------------------------------------------------------------------------------
+INTEGER FUNCTION strIdx1(str, del, ib, id) RESULT(i)
+!--- Get the index of the first appereance of one of the delimiters "del(:)" in "str" starting from position "ib".
+!--- "id" is the index in "del(:)" of the first delimiter found.
+    CHARACTER(LEN=*),  INTENT(IN)  :: str, del(:)
+  INTEGER,           INTENT(IN)  :: ib
+  INTEGER,           INTENT(OUT) :: id
+!------------------------------------------------------------------------------------------------------------------------------
+  DO i = ib, LEN_TRIM(str); id = strIdx(del, str(i:i)); IF(id /= 0) EXIT; END DO
+  IF(i > LEN_TRIM(str)) THEN; i = 0; id = 0; END IF
+END FUNCTION strIdx1
+
+END FUNCTION strIdx_prv
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== Count the number of elements separated by "delimiter" in list "rawList". =================================================
+!==============================================================================================================================
+LOGICAL FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr)
+    CHARACTER(LEN=*),  INTENT(IN)  :: rawList
+  CHARACTER(LEN=*),  INTENT(IN)  :: delimiter
+  INTEGER,           INTENT(OUT) :: nb
+  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc
+!------------------------------------------------------------------------------------------------------------------------------
+  LOGICAL :: ll
+  ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
+  lerr = strCount_1m(rawList, [delimiter], nb, ll)
+END FUNCTION strCount_11
+!==============================================================================================================================
+LOGICAL FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr)
+    CHARACTER(LEN=*),     INTENT(IN)  :: rawList(:)
+  CHARACTER(LEN=*),     INTENT(IN)  :: delimiter
+  INTEGER, ALLOCATABLE, INTENT(OUT) :: nb(:)
+  LOGICAL,    OPTIONAL, INTENT(IN)  :: lSc
+!------------------------------------------------------------------------------------------------------------------------------
+  LOGICAL :: ll
+  INTEGER :: id
+  ll  = .FALSE.; IF(PRESENT(lSc)) ll = lSc .AND. INDEX('+-', delimiter) /= 0
+  lerr = .TRUE.
+  ALLOCATE(nb(SIZE(rawList)))
+  DO id = 1, SIZE(rawList)
+    lerr = lerr .AND. strCount_1m(rawList(id), [delimiter], nb(id), ll)
+  END DO
+END FUNCTION strCount_m1
+!==============================================================================================================================
+LOGICAL FUNCTION strCount_1m(rawList, delimiter, nb, lSc) RESULT(lerr)
+    CHARACTER(LEN=*),  INTENT(IN)  :: rawList
+  CHARACTER(LEN=*),  INTENT(IN)  :: delimiter(:)
+  INTEGER,           INTENT(OUT) :: nb
+  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER              :: ib, ie, jd, nr
+  LOGICAL              :: ll
+  CHARACTER(LEN=1024)  :: r
+  lerr = .FALSE.
+  ll   = .FALSE.; IF(PRESENT(lSc)) ll = lSc
+  r  = TRIM(ADJUSTL(rawList))
+  nr = LEN_TRIM(r); IF(nr == 0) RETURN
+  nb = 1; ib = 1
+  DO
+    lerr = strIdx_prv(r, delimiter, ib, ie, jd, ll)
+    IF(fmsg('"'//TRIM(r(ib:ie-1))//'" is not numeric', ll=lerr)) RETURN
+    IF(ie == 0 .OR. jd == 0) EXIT
+    ib = ie + LEN(delimiter(jd))
+    DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO     !--- Skip spaces before next chain
+    nb = nb + 1
+  END DO
+END FUNCTION strCount_1m
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== Purpose: Parse "delimiter"-separated list "rawList" into the pair keys(:), vals(:).   ====================================
+!===          Corresponding "vals" remains empty if the element does not contain "=" sign. ====================================
+!==============================================================================================================================
+LOGICAL FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr)
+    CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter
+  CHARACTER(LEN=maxlen), ALLOCATABLE,           INTENT(OUT) :: keys(:)
+  INTEGER,                            OPTIONAL, INTENT(OUT) :: n
+  CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: vals(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=1024) :: r
+  INTEGER :: nr, nk
+  lerr = .FALSE.
+  r  = TRIM(ADJUSTL(rawList))
+  nr = LEN_TRIM(r); IF(nr == 0) THEN; keys = ['']; RETURN; END IF
+  nk = countK()                                                      !--- COUNT THE ELEMENTS
+  CALL parseK(keys)                                                  !--- PARSE THE KEYS
+  IF(PRESENT(vals)) CALL parseV(vals)                                !--- PARSE <key>=<val> PAIRS
+  IF(PRESENT(n)) n = nk                                              !--- RETURN THE NUMBER OF KEYS
+
+CONTAINS
+
+!------------------------------------------------------------------------------------------------------------------------------
+INTEGER FUNCTION countK() RESULT(nkeys)
+!--- Get the number of elements after parsing.
+  !------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: ib, ie, nl
+  nkeys = 1; ib = 1; nl = LEN(delimiter)
+  DO
+    ie = INDEX(rawList(ib:nr), delimiter)+ib-1                       !--- Determine the next separator start index
+    IF(ie == ib-1) EXIT
+    ib = ie + nl
+    DO WHILE(ANY([0, 9, 32] == IACHAR(r(ib:ib))) .AND. ib < nr)      !--- Skip blanks (ascii): NULL (0), TAB (9), SPACE (32)
+      ib = ib + 1
+    END DO     !--- Skip spaces before next chain
+    nkeys = nkeys+1
+  END DO
+END FUNCTION countK
+
+!------------------------------------------------------------------------------------------------------------------------------
+SUBROUTINE parseK(keys)
+!--- Parse the string separated by "delimiter" from "rawList" into "keys(:)"
+    CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: keys(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: ib, ie, ik
+  ALLOCATE(keys(nk))
+  ib = 1
+  DO ik = 1, nk
+    ie = INDEX(rawList(ib:nr), delimiter)+ib-1                       !--- Determine the next separator start index
+    IF(ie == ib-1) EXIT
+    keys(ik) = r(ib:ie-1)                                            !--- Get the ikth key
+    ib = ie + LEN(delimiter)
+    DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO     !--- Skip spaces before next chain
+  END DO
+  keys(ik) = r(ib:nr)                                                !--- Get the last key
+END SUBROUTINE parseK
+
+!------------------------------------------------------------------------------------------------------------------------------
+SUBROUTINE parseV(vals)
+!--- Parse the <key>=<val> pairs in "keys(:)" into "keys" and "vals"
+    CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: vals(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: key
+  INTEGER :: ik, ix
+  ALLOCATE(vals(nk))
+  DO ik = 1, nk; key = keys(ik)
+    vals(ik) = ''
+    ix = INDEX(key, '='); IF(ix == 0) CYCLE                          !--- First "=" index in "key"
+    vals(ik) = ADJUSTL(key(ix+1:LEN_TRIM(key)))
+    keys(ik) = ADJUSTL(key(1:ix-1))
+  END DO
+END SUBROUTINE parseV
+
+END FUNCTION strParse
+!==============================================================================================================================
+LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr)
+    CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter(:)
+  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: keys(:)  !--- Parsed keys vector
+  INTEGER,               OPTIONAL,              INTENT(OUT) :: n        !--- Length of the parsed vector
+  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: vals(:)  !--- Values for <name>=<value> keys
+  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lSc      !--- Take care about numbers in scientific notation
+  INTEGER,               OPTIONAL, ALLOCATABLE, INTENT(OUT) :: id(:)    !--- Indexes of the separators in "delimiter(:)" vector
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=1024) :: r
+  INTEGER :: nr, ik, nk, ib, ie, jd
+  LOGICAL :: ll
+  ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
+  lerr = strCount_1m(rawList, delimiter, nk, ll)
+  CALL msg("Couldn't parse list: non-numerical strings were found", ll=lerr); IF(lerr) RETURN
+
+  !--- FEW ALLOCATIONS
+  ALLOCATE(keys(nk))
+  IF(PRESENT(vals)) ALLOCATE(vals(nk))
+  IF(PRESENT(id))   ALLOCATE(id(nk-1))
+  IF(PRESENT(n)) n = nk
+
+  !--- PARSING
+  r  = TRIM(ADJUSTL(rawList))
+  nr = LEN_TRIM(r); IF(nr == 0) RETURN
+  ib = 1
+  DO ik = 1, nk-1
+    lerr = strIdx_prv(r, delimiter, ib, ie, jd, ll)
+    CALL msg('Non-numeric values found', ll=lerr); IF(lerr) RETURN
+    keys(ik) = r(ib:ie-1)
+    IF(PRESENT(vals)) CALL parseKeys(keys(ik), vals(ik))             !--- Parse a <key>=<val> pair
+    IF(PRESENT(id  )) id(ik) = jd                                    !--- Index in "delimiter(:)" of the "ik"th delimiter
+    ib = ie + LEN_TRIM( delimiter(jd) )                              !--- Length of the current delimiter
+    DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO     !--- Skip spaces before next chain
+  END DO
+  keys(nk) = r(ib:nr)
+  IF(PRESENT(vals)) CALL parseKeys(keys(nk), vals(nk))               !--- Parse a <key>=<val> pair
+
+CONTAINS
+
+!------------------------------------------------------------------------------------------------------------------------------
+SUBROUTINE parseKeys(key, val)
+    CHARACTER(LEN=*), INTENT(INOUT) :: key
+  CHARACTER(LEN=*), INTENT(OUT)   :: val
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: ix
+  ix = INDEX(key, '='); IF(ix == 0) RETURN                           !--- First "=" index in "key"
+  val = ADJUSTL(key(ix+1:LEN_TRIM(key)))
+  key = ADJUSTL(key(1:ix-1))
+END SUBROUTINE parseKeys
+
+END FUNCTION strParse_m
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== String substitution: replace "key" by "val" each time it appears in "str".
+!==============================================================================================================================
+SUBROUTINE strReplace_1(str, key, val, lsurr)
+    CHARACTER(LEN=*),  INTENT(INOUT) :: str        !--- Main string
+  CHARACTER(LEN=*),  INTENT(IN)    :: key, val   !--- "key" will be replaced by "val"
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lsurr      !--- TRUE => key must be surrounded by special characters to be substituted
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: i0, ix, nk, ns
+  LOGICAL :: lsur, lb, le
+  lsur = .FALSE.; IF(PRESENT(lsurr)) lsur = lsurr
+  nk = LEN_TRIM(key)
+  i0 = 1
+  DO
+    ns = LEN_TRIM(str)
+    ix = INDEX(str(i0:ns), TRIM(key))            !--- First appearance index of "key" in "s", starting from index "i0"
+    IF(ix == 0) EXIT
+    ix = ix + i0 -1
+    IF(lsur) THEN                                !--- Key must be surrounded by special characters
+      !--- lb=.TRUE.: key is at the very beginning of "str" or located after  a special character
+      lb = ix     ==1;  IF(.NOT.lb) lb = INDEX('+-*/()^', str(ix-1 :ix-1 ))/=0
+      !--- le=.TRUE.: key is at the very end       of "str" or located before a special character
+      le = ix+nk-1==ns; IF(.NOT.le) le = INDEX('+-*/()^', str(ix+nk:ix+nk))/=0
+      IF(.NOT.(lb.AND.le)) THEN; i0 = i0 + nk; CYCLE; END IF
+    END IF
+    str = str(1:ix-1)//TRIM(val)//str(ix+nk:ns)
+  END DO
+END SUBROUTINE strReplace_1
+!==============================================================================================================================
+SUBROUTINE strReplace_m(str, key, val, lsurr)
+    CHARACTER(LEN=*),  INTENT(INOUT) :: str(:)     !--- Main strings vector
+  CHARACTER(LEN=*),  INTENT(IN)    :: key, val   !--- "key" will be replaced by "val"
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lsurr      !--- TRUE => key must be surrounded by special characters to be substituted
+  INTEGER :: k
+  LOGICAL :: ll
+  ll=.FALSE.; IF(PRESENT(lsurr)) ll=lsurr
+  DO k=1, SIZE(str); CALL strReplace_1(str(k),key,val,ll); END DO
+END SUBROUTINE strReplace_m
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== Contatenate horizontally scalars/vectors of strings/integers/reals into a vector/array ===================================
+!==============================================================================================================================
+FUNCTION horzcat_s00(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(OUT)
+    CHARACTER(LEN=*),                   INTENT(IN) :: s0
+  CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1, s2, s3, s4, s5, s6, s7, s8, s9
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
+  CHARACTER(LEN=maxlen), POINTER     :: s
+  INTEGER                            :: nrow, iv
+  LOGICAL                            :: pre(9)
+!------------------------------------------------------------------------------------------------------------------------------
+  pre(:) = [PRESENT(s1),PRESENT(s2),PRESENT(s3),PRESENT(s4),PRESENT(s5),PRESENT(s6),PRESENT(s7),PRESENT(s8),PRESENT(s9)]
+  nrow = 1+COUNT(pre)
+  ALLOCATE(out(nrow))
+  out(1) = s0
+  DO iv = 2, nrow; IF(.NOT.pre(iv-1)) CYCLE
+    SELECT CASE(iv-1)
+      CASE(1); s=> s1; CASE(2); s=> s2; CASE(3); s=> s3; CASE(4); s=> s4; CASE(5); s=> s5
+      CASE(6); s=> s6; CASE(7); s=> s7; CASE(8); s=> s8; CASE(9); s=> s9
+    END SELECT
+    out(iv) = s
+  END DO
+END FUNCTION horzcat_s00
+!==============================================================================================================================
+FUNCTION horzcat_s10(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(OUT)
+    CHARACTER(LEN=*),           INTENT(IN) :: s0(:), s1
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s2, s3, s4, s5, s6, s7, s8, s9
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:), tmp(:)
+  INTEGER :: nc
+  nc = SIZE(s0)
+  tmp = horzcat_s00(s0(nc), s1, s2, s3, s4, s5, s6, s7, s8, s9)
+  IF(nc == 1) out = tmp
+  IF(nc /= 1) out = [s0(1:nc-1), tmp]
+END FUNCTION horzcat_s10
+!==============================================================================================================================
+FUNCTION horzcat_s11(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(OUT)
+    CHARACTER(LEN=*),                   INTENT(IN) :: s0(:)
+  CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1(:), s2(:), s3(:), s4(:), s5(:), s6(:), s7(:), s8(:), s9(:)
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:)
+  CHARACTER(LEN=maxlen), POINTER     :: s(:)
+  INTEGER                            :: nrow, ncol, iv, n
+  LOGICAL                            :: pre(9)
+!------------------------------------------------------------------------------------------------------------------------------
+  pre(:) = [PRESENT(s1),PRESENT(s2),PRESENT(s3),PRESENT(s4),PRESENT(s5),PRESENT(s6),PRESENT(s7),PRESENT(s8),PRESENT(s9)]
+  nrow = SIZE(s0)
+  ncol = 1+COUNT(pre)
+  ALLOCATE(out(nrow, ncol))
+  out(:,1) = s0
+  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
+    SELECT CASE(iv-1)
+      CASE(1); s=> s1; CASE(2); s=> s2; CASE(3); s=> s3; CASE(4); s=> s4; CASE(5); s=> s5
+      CASE(6); s=> s6; CASE(7); s=> s7; CASE(8); s=> s8; CASE(9); s=> s9
+    END SELECT
+    n = SIZE(s, DIM=1)
+    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
+    out(:,iv) = s(:)
+  END DO
+END FUNCTION horzcat_s11
+!==============================================================================================================================
+FUNCTION horzcat_s21(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(OUT)
+    CHARACTER(LEN=*),           INTENT(IN) :: s0(:,:), s1(:)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s2(:), s3(:), s4(:), s5(:), s6(:), s7(:), s8(:), s9(:)
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:), tmp(:,:)
+  INTEGER :: nc
+  nc  = SIZE(s0, 2)
+  tmp = horzcat_s11(s0(:,nc), s1, s2, s3, s4, s5, s6, s7, s8, s9)
+  IF(nc == 1) out = tmp
+  IF(nc /= 1) out = RESHAPE([PACK(s0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(s0, 1), nc + SIZE(tmp, 2)-1])
+END FUNCTION horzcat_s21
+!==============================================================================================================================
+FUNCTION horzcat_i00(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(OUT)
+    INTEGER,                   INTENT(IN) :: i0
+  INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1, i2, i3, i4, i5, i6, i7, i8, i9
+  INTEGER, ALLOCATABLE :: out(:)
+  INTEGER, POINTER     :: i
+  INTEGER              :: ncol, iv
+  LOGICAL              :: pre(9)
+!------------------------------------------------------------------------------------------------------------------------------
+  pre(:) = [PRESENT(i1),PRESENT(i2),PRESENT(i3),PRESENT(i4),PRESENT(i5),PRESENT(i6),PRESENT(i7),PRESENT(i8),PRESENT(i9)]
+  ncol = SIZE(pre)
+  ALLOCATE(out(ncol))
+  out(1) = i0
+  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
+    SELECT CASE(iv-1)
+      CASE(1); i=> i1; CASE(2); i=> i2; CASE(3); i=> i3; CASE(4); i=> i4; CASE(5); i=> i5
+      CASE(6); i=> i6; CASE(7); i=> i7; CASE(8); i=> i8; CASE(9); i=> i9
+    END SELECT
+    out(iv) = i
+  END DO
+END FUNCTION horzcat_i00
+!==============================================================================================================================
+FUNCTION horzcat_i10(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(OUT)
+    INTEGER,           INTENT(IN) :: i0(:), i1
+  INTEGER, OPTIONAL, INTENT(IN) :: i2, i3, i4, i5, i6, i7, i8, i9
+  INTEGER, ALLOCATABLE :: out(:), tmp(:)
+  INTEGER :: nc
+  nc = SIZE(i0)
+  tmp = horzcat_i00(i0(nc), i1, i2, i3, i4, i5, i6, i7, i8, i9)
+  IF(nc == 1) out = tmp
+  IF(nc /= 1) out = [i0(1:nc-1), tmp]
+END FUNCTION horzcat_i10
+!==============================================================================================================================
+FUNCTION horzcat_i11(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(OUT)
+    INTEGER,                   INTENT(IN) :: i0(:)
+  INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1(:), i2(:), i3(:), i4(:), i5(:), i6(:), i7(:), i8(:), i9(:)
+  INTEGER, ALLOCATABLE :: out(:,:)
+  INTEGER, POINTER     :: i(:)
+  INTEGER              :: nrow, ncol, iv, n
+  LOGICAL              :: pre(9)
+!------------------------------------------------------------------------------------------------------------------------------
+  pre(:) = [PRESENT(i1),PRESENT(i2),PRESENT(i3),PRESENT(i4),PRESENT(i5),PRESENT(i6),PRESENT(i7),PRESENT(i8),PRESENT(i9)]
+  nrow = SIZE(i0)
+  ncol = 1+COUNT(pre)
+  ALLOCATE(out(nrow, ncol))
+  out(:,1) = i0
+  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
+    SELECT CASE(iv-1)
+      CASE(1); i=> i1; CASE(2); i=> i2; CASE(3); i=> i3; CASE(4); i=> i4; CASE(5); i=> i5
+      CASE(6); i=> i6; CASE(7); i=> i7; CASE(8); i=> i8; CASE(9); i=> i9
+    END SELECT
+    n = SIZE(i, DIM=1)
+    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
+    out(:,iv) = i(:)
+  END DO
+END FUNCTION horzcat_i11
+!==============================================================================================================================
+FUNCTION horzcat_i21(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(OUT)
+    INTEGER,           INTENT(IN) :: i0(:,:), i1(:)
+  INTEGER, OPTIONAL, INTENT(IN) :: i2(:), i3(:), i4(:), i5(:), i6(:), i7(:), i8(:), i9(:)
+  INTEGER, ALLOCATABLE :: out(:,:), tmp(:,:)
+  INTEGER :: nc
+  nc  = SIZE(i0, 2)
+  tmp = horzcat_i11(i0(:,nc), i1, i2, i3, i4, i5, i6, i7, i8, i9)
+  IF(nc == 1) out = tmp
+  IF(nc /= 1) out = RESHAPE([PACK(i0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(i0, 1), nc + SIZE(tmp, 2)-1])
+END FUNCTION horzcat_i21
+!==============================================================================================================================
+FUNCTION horzcat_r00(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(OUT)
+    REAL,                   INTENT(IN) :: r0
+  REAL, OPTIONAL, TARGET, INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
+  REAL, ALLOCATABLE :: out(:)
+  REAL, POINTER     :: r
+  INTEGER           :: ncol, iv
+  LOGICAL           :: pre(9)
+!------------------------------------------------------------------------------------------------------------------------------
+  pre(:) = [PRESENT(r1),PRESENT(r2),PRESENT(r3),PRESENT(r4),PRESENT(r5),PRESENT(r6),PRESENT(r7),PRESENT(r8),PRESENT(r9)]
+  ncol = 1+COUNT(pre)
+  ALLOCATE(out(ncol))
+  out(1) = r0
+  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
+    SELECT CASE(iv-1)
+      CASE(1); r=> r1; CASE(2); r=> r2; CASE(3); r=> r3; CASE(4); r=> r4; CASE(5); r=> r5
+      CASE(6); r=> r6; CASE(7); r=> r7; CASE(8); r=> r8; CASE(9); r=> r9
+    END SELECT
+    out(iv) = r
+  END DO
+END FUNCTION horzcat_r00
+!==============================================================================================================================
+FUNCTION horzcat_r10(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(OUT)
+    REAL,           INTENT(IN) :: r0(:), r1
+  REAL, OPTIONAL, INTENT(IN) :: r2, r3, r4, r5, r6, r7, r8, r9
+  REAL, ALLOCATABLE :: out(:), tmp(:)
+  INTEGER :: nc
+  nc  = SIZE(r0)
+  tmp = horzcat_r00(r0(nc), r1, r2, r3, r4, r5, r6, r7, r8, r9)
+  IF(nc == 1) out = tmp
+  IF(nc /= 1) out = [r0(1:nc-1), tmp]
+END FUNCTION horzcat_r10
+!==============================================================================================================================
+FUNCTION horzcat_r11(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(OUT)
+    REAL,                   INTENT(IN) :: r0(:)
+  REAL, OPTIONAL, TARGET, INTENT(IN) :: r1(:), r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
+  REAL, ALLOCATABLE :: out(:,:)
+  REAL, POINTER     :: r(:)
+  INTEGER           :: nrow, ncol, iv, n
+  LOGICAL           :: pre(9)
+!------------------------------------------------------------------------------------------------------------------------------
+  pre(:) = [PRESENT(r1),PRESENT(r2),PRESENT(r3),PRESENT(r4),PRESENT(r5),PRESENT(r6),PRESENT(r7),PRESENT(r8),PRESENT(r9)]
+  nrow = SIZE(r0)
+  ncol = 1+COUNT(pre)
+  ALLOCATE(out(nrow, ncol))
+  out(:,1) = r0
+  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
+    SELECT CASE(iv-1)
+      CASE(1); r=> r1; CASE(2); r=> r2; CASE(3); r=> r3; CASE(4); r=> r4; CASE(5); r=> r5
+      CASE(6); r=> r5; CASE(7); r=> r7; CASE(8); r=> r8; CASE(9); r=> r9
+    END SELECT
+    n = SIZE(r, DIM=1)
+    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
+    out(:,iv) = r(:)
+  END DO
+END FUNCTION horzcat_r11
+!==============================================================================================================================
+FUNCTION horzcat_r21(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(OUT)
+    REAL,           INTENT(IN) :: r0(:,:), r1(:)
+  REAL, OPTIONAL, INTENT(IN) :: r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
+  REAL, ALLOCATABLE :: out(:,:), tmp(:,:)
+  INTEGER :: nc
+  nc  = SIZE(r0, 2)
+  tmp = horzcat_r11(r0(:,nc), r1, r2, r3, r4, r5, r6, r7, r8, r9)
+  IF(nc == 1) out = tmp
+  IF(nc /= 1) out = RESHAPE([PACK(r0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(r0, 1), nc + SIZE(tmp, 2)-1])
+END FUNCTION horzcat_r21
+!==============================================================================================================================
+FUNCTION horzcat_d00(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(OUT)
+    DOUBLE PRECISION,                   INTENT(IN) :: d0
+  DOUBLE PRECISION, OPTIONAL, TARGET, INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
+  DOUBLE PRECISION, ALLOCATABLE :: out(:)
+  DOUBLE PRECISION, POINTER     :: d
+  INTEGER                       :: ncol, iv
+  LOGICAL                       :: pre(9)
+!------------------------------------------------------------------------------------------------------------------------------
+  pre(:) = [PRESENT(d1),PRESENT(d2),PRESENT(d3),PRESENT(d4),PRESENT(d5),PRESENT(d6),PRESENT(d7),PRESENT(d8),PRESENT(d9)]
+  ncol = 1+COUNT(pre)
+  ALLOCATE(out(ncol))
+  out(1) = d0
+  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
+    SELECT CASE(iv-1)
+      CASE(1); d=> d1; CASE(2); d=> d2; CASE(3); d=> d3; CASE(4); d=> d4; CASE(5); d=> d5
+      CASE(6); d=> d6; CASE(7); d=> d7; CASE(8); d=> d8; CASE(9); d=> d9
+    END SELECT
+    out(iv) = d
+  END DO
+END FUNCTION horzcat_d00
+!==============================================================================================================================
+FUNCTION horzcat_d10(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(OUT)
+    DOUBLE PRECISION,           INTENT(IN) :: d0(:), d1
+  DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: d2, d3, d4, d5, d6, d7, d8, d9
+  DOUBLE PRECISION, ALLOCATABLE :: out(:), tmp(:)
+  INTEGER :: nc
+  nc = SIZE(d0)
+  tmp = horzcat_d00(d0(nc), d1, d2, d3, d4, d5, d6, d7, d8, d9)
+  IF(nc == 1) out = tmp
+  IF(nc /= 1) out = [d0(1:nc-1), tmp]
+END FUNCTION horzcat_d10
+!==============================================================================================================================
+FUNCTION horzcat_d11(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(OUT)
+    DOUBLE PRECISION,                   INTENT(IN) :: d0(:)
+  DOUBLE PRECISION, OPTIONAL, TARGET, INTENT(IN) :: d1(:), d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
+  DOUBLE PRECISION, ALLOCATABLE :: out(:,:)
+  DOUBLE PRECISION, POINTER     :: d(:)
+  INTEGER                       :: nrow, ncol, iv, n
+  LOGICAL                       :: pre(9)
+!------------------------------------------------------------------------------------------------------------------------------
+  nrow = SIZE(d0)
+  pre(:) = [PRESENT(d1),PRESENT(d2),PRESENT(d3),PRESENT(d4),PRESENT(d5),PRESENT(d6),PRESENT(d7),PRESENT(d8),PRESENT(d9)]
+  ncol = 1+COUNT(pre)
+  ALLOCATE(out(nrow, ncol))
+  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
+    SELECT CASE(iv-1)
+      CASE(1); d=> d1; CASE(2); d=> d2; CASE(3); d=> d3; CASE(4); d=> d4; CASE(5); d=> d5
+      CASE(6); d=> d6; CASE(7); d=> d7; CASE(8); d=> d8; CASE(9); d=> d9
+    END SELECT
+    n = SIZE(d, DIM=1)
+    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
+    out(:,iv) = d(:)
+  END DO
+END FUNCTION horzcat_d11
+!==============================================================================================================================
+FUNCTION horzcat_d21(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(OUT)
+    DOUBLE PRECISION,           INTENT(IN) :: d0(:,:), d1(:)
+  DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
+  DOUBLE PRECISION, ALLOCATABLE :: out(:,:), tmp(:,:)
+  INTEGER :: nc
+  nc  = SIZE(d0, 2)
+  tmp = horzcat_d11(d0(:,nc), d1, d2, d3, d4, d5, d6, d7, d8, d9)
+  IF(nc == 1) out = tmp
+  IF(nc /= 1) out = RESHAPE([PACK(d0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(d0, 1), nc + SIZE(tmp, 2)-1])
+END FUNCTION horzcat_d21
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!--- Display a clean table composed of successive vectors of same length.
+!=== The profile "p" describe in which order to pick up the columns from "s", "i" and "r" for display.
+!===  * nRowMax lines are displayed (default: all lines)
+!===  * nColMax characters (default: as long as needed) are displayed at most on a line. If the effective total length is
+!===    higher, several partial tables are displayed ; the nHead (default: 1) first columns are included in each sub-table.
+!==============================================================================================================================
+LOGICAL FUNCTION dispTable(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr)
+    CHARACTER(LEN=*),           INTENT(IN)  :: p             !--- DISPLAY MAP: s/i/r
+  CHARACTER(LEN=*),           INTENT(IN)  :: titles(:)     !--- TITLES (ONE EACH COLUMN)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: s(:,:)        !--- STRINGS
+  INTEGER,          OPTIONAL, INTENT(IN)  :: i(:,:)        !--- INTEGERS
+  REAL,             OPTIONAL, INTENT(IN)  :: r(:,:)        !--- REALS
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: rFmt          !--- Format for reals
+  INTEGER,          OPTIONAL, INTENT(IN)  :: nRowMax       !--- Display at most "nRowMax" rows
+  INTEGER,          OPTIONAL, INTENT(IN)  :: nColMax       !--- Display at most "nColMax" characters each line
+  INTEGER,          OPTIONAL, INTENT(IN)  :: nHead         !--- Head columns repeated for multiple tables display
+  INTEGER,          OPTIONAL, INTENT(IN)  :: unit          !--- Output unit (default: screen)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: sub           !--- Subroutine name
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=2048) :: row
+  CHARACTER(LEN=maxlen)  :: rFm, el, subn
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: d(:,:)
+  CHARACTER(LEN=1) :: s1, sp
+  INTEGER :: is, ii, ir, it, k, nmx,  unt, ic, np
+  INTEGER :: ns, ni, nr, nt, l, ncol, nHd, ib, l0
+  INTEGER, ALLOCATABLE :: n(:), ncmx(:)
+  INTEGER, PARAMETER   :: nm=1                             !--- Space between values & columns
+  LOGICAL :: ls, li, lr
+  subn = '';    IF(PRESENT(sub)) subn = sub
+  rFm = '*';    IF(PRESENT(rFmt)) rFm = rFmt               !--- Specified format for reals
+  unt = lunout; IF(PRESENT(unit)) unt = unit               !--- Specified output unit
+  np = LEN_TRIM(p); ns = 0; ni = 0; nr = 0; ncol = 0
+  ls = PRESENT(s); li = PRESENT(i); lr = PRESENT(r)
+  lerr = .FALSE.; IF(.NOT.ANY([ls,li,lr])) RETURN          !--- Nothing to DO
+  sp = '|'                                                 !--- Separator
+
+  !--- CHECK ARGUMENTS COHERENCE
+  lerr = np /= SIZE(titles); IF(fmsg('display map "p" length and titles list mismatch', subn, lerr)) RETURN
+  IF(ls) THEN
+    ns = SIZE(s, 1); ncol = ncol + SIZE(s, 2); lerr = COUNT([(p(ic:ic)=='s', ic=1, np)]) /= SIZE(s, 2)
+  END IF
+  IF(li) THEN
+    ni = SIZE(i, 1); ncol = ncol + SIZE(i, 2); lerr = COUNT([(p(ic:ic)=='i', ic=1, np)]) /= SIZE(i, 2)
+  END IF
+  IF(lr) THEN
+    nr = SIZE(r, 1); ncol = ncol + SIZE(r, 2); lerr = COUNT([(p(ic:ic)=='r', ic=1, np)]) /= SIZE(r, 2)
+  END IF
+  IF(fmsg('display map "p" length and arguments number mismatch', subn, lerr)) RETURN
+  lerr = ncol /= SIZE(titles); IF(fmsg('"titles" length and arguments number mismatch', subn, lerr)) RETURN
+  lerr = ls.AND.li.AND.ns/=ni; IF(fmsg('string and integer arguments lengths mismatch', subn, lerr)) RETURN
+  lerr = ls.AND.lr.AND.ns/=nr; IF(fmsg(   'string and real arguments lengths mismatch', subn, lerr)) RETURN
+  lerr = li.AND.lr.AND.ni/=nr; IF(fmsg(  'integer and real arguments lengths mismatch', subn, lerr)) RETURN
+  nmx = MAX(ns,ni,nr)+1; IF(PRESENT(nRowMax)) nmx = MIN(nmx,nRowMax+1)
+
+  !--- Allocate the assembled quantities array
+  ALLOCATE(d(nmx,ncol), n(ncol))
+
+  !--- Assemble the vectors into a strings array in the order indicated by "pattern"
+  is =  1; ii = 1; ir = 1
+  DO ic = 1, ncol
+    d(1,ic) = TRIM(titles(ic))
+    SELECT CASE(p(ic:ic))
+      CASE('s'); d(2:nmx,ic) =          s(:,is)     ; is = is + 1
+      CASE('i'); d(2:nmx,ic) =  int2str(i(:,ii)    ); ii = ii + 1
+      CASE('r'); d(2:nmx,ic) = real2str(r(:,ir),rFm); ir = ir + 1
+    END SELECT
+  END DO
+  CALL cleanZeros(d)
+  DO ic = 1, ncol
+    n(ic)=0; DO ir=1, nmx; n(ic)=MAX(n(ic), LEN_TRIM(d(ir,ic))); END DO
+  END DO
+  n(:) = n(:) + 2*nm
+
+  !--- Build the vector of max column index in case the rows are too long (table must be displayed in multiple parts)
+  nHd = 1; IF(PRESENT(nHead)) nHd = nHead
+  IF(.NOT.PRESENT(nColMax)) THEN
+    nt = 1; ncmx = [ncol]
+  ELSE
+    nt = 1; l0 = SUM(n(1:nHd)+1)+1
+    IF(PRESENT(sub)) l0=l0+LEN_TRIM(subn)+1
+    !--- Count the number of table parts
+    l = l0; DO ic = nHd+1, ncol; l = l+n(ic)+1; IF(l>=nColMax) THEN; nt = nt+1; l = l0+n(ic)+1; END IF; END DO
+    !--- Get the index of the last column for each table part
+    ALLOCATE(ncmx(nt)); k = 1
+    l = l0; DO ic = nHd+1, ncol; l = l+n(ic)+1; IF(l>=nColMax) THEN; ncmx(k) = ic-1; l = l0+n(ic)+1; k = k+1; END IF; END DO
+    ncmx(nt) = ncol
+  END IF
+
+  !--- Display the strings array as a table
+  DO it = 1, nt
+    DO ir = 1, nmx; row = ''
+      DO ic = 1, nHd; el = d(ir,ic)
+        s1 = sp
+        row = TRIM(row)//REPEAT(' ',nm)//TRIM(el)//REPEAT(' ',n(ic)-LEN_TRIM(el)-nm)//s1
+      END DO
+      ib = nHd+1; IF(it>1) ib = ncmx(it-1)+1
+      DO ic = ib, ncmx(it); el = d(ir,ic)
+        s1 = sp
+        row = TRIM(row)//REPEAT(' ',nm)//TRIM(el)//REPEAT(' ',n(ic)-LEN_TRIM(el)-nm)//s1
+      END DO
+      nr = LEN_TRIM(row)-1                                           !--- Final separator removed
+      CALL msg(row(1:nr), subn, unit=unt)
+      IF(ir /= 1) CYCLE                                              !--- Titles only are underlined
+      row=''; DO ic=1,nHd; row=TRIM(row)//REPEAT('-',n(ic))//'+'; END DO
+      DO ic = ib,ncmx(it); row=TRIM(row)//REPEAT('-',n(ic))//'+'; END DO
+      CALL msg(row(1:LEN_TRIM(row)-1), subn, unit=unt)
+    END DO
+    CALL msg('', subn, unit=unt)
+  END DO
+
+END FUNCTION dispTable
+!==============================================================================================================================
+
+!==============================================================================================================================
+LOGICAL FUNCTION dispNamelist(unt, p, titles, s, i, r, rFmt, llast) RESULT(lerr)
+    INTEGER,                    INTENT(IN)  :: unt           !--- Output unit
+  CHARACTER(LEN=*),           INTENT(IN)  :: p             !--- DISPLAY MAP: s/i/r
+  CHARACTER(LEN=*),           INTENT(IN)  :: titles(:)     !--- TITLES (ONE EACH COLUMN)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: s(:,:)        !--- STRINGS
+  INTEGER,          OPTIONAL, INTENT(IN)  :: i(:,:)        !--- INTEGERS
+  REAL,             OPTIONAL, INTENT(IN)  :: r(:,:)        !--- REALS
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: rFmt          !--- Format for reals
+  LOGICAL,          OPTIONAL, INTENT(IN)  :: llast         !--- Last variable: no final ','
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen)  :: rFm, el
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: d(:,:)
+  CHARACTER(LEN=:),      ALLOCATABLE :: sp, row
+  INTEGER :: is, ii, ir, nrow, ic
+  INTEGER :: ns, ni, nr, ncol, np
+  INTEGER, ALLOCATABLE :: n(:)
+  LOGICAL :: ls, li, lr, la
+  rFm = '*';    IF(PRESENT(rFmt)) rFm = rFmt               !--- Specified format for reals
+  ls = PRESENT(s); li = PRESENT(i); lr = PRESENT(r)
+  lerr = .FALSE.; IF(.NOT.ANY([ls,li,lr])) RETURN          !--- Nothing to DO
+  la = .FALSE.; IF(PRESENT(llast)) la = llast
+
+  !--- CHECK ARGUMENTS COHERENCE
+  ns = 0; ni = 0; nr = 0; np = LEN_TRIM(p); ncol = 0
+  IF(ls) THEN; ns = SIZE(s, DIM=1); ncol = ncol + SIZE(s, DIM=2)
+    lerr = COUNT([(p(ic:ic)=='s', ic=1, np)]) /= SIZE(s, DIM=2)
+  END IF
+  IF(li) THEN; ni = SIZE(i, DIM=1); ncol = ncol + SIZE(i, DIM=2)
+    lerr = COUNT([(p(ic:ic)=='i', ic=1, np)]) /= SIZE(i, DIM=2)
+  END IF
+  IF(lr) THEN; nr = SIZE(r, DIM=1); ncol = ncol + SIZE(r, DIM=2)
+    lerr = COUNT([(p(ic:ic)=='r', ic=1, np)]) /= SIZE(r, DIM=2)
+  END IF
+  IF(fmsg('display map "p" length and arguments number mismatch', ll=lerr)) RETURN
+  lerr = ncol /= SIZE(titles); IF(fmsg('"titles" length and arguments number mismatch', ll=lerr)) RETURN
+  lerr = ls.AND.li.AND.ns/=ni; IF(fmsg('string and integer arguments lengths mismatch', ll=lerr)) RETURN
+  lerr = ls.AND.lr.AND.ns/=nr; IF(fmsg(   'string and real arguments lengths mismatch', ll=lerr)) RETURN
+  lerr = li.AND.lr.AND.ni/=nr; IF(fmsg(  'integer and real arguments lengths mismatch', ll=lerr)) RETURN
+
+  !--- Allocate the assembled quantities array
+  nrow = MAX(ns,ni,nr)+1
+  ALLOCATE(d(nrow,ncol), n(ncol))
+
+  !--- Assemble the vectors into a strings array in the order indicated by "pattern"
+  is =  1; ii = 1; ir = 1
+  DO ic = 1, ncol
+    d(1,ic) = TRIM(titles(ic))
+    SELECT CASE(p(ic:ic))
+      CASE('s'); d(2:nrow,ic) =          s(:,is)     ; is = is + 1
+      CASE('i'); d(2:nrow,ic) =  int2str(i(:,ii)    ); ii = ii + 1
+      CASE('r'); d(2:nrow,ic) = real2str(r(:,ir),rFm); ir = ir + 1
+    END SELECT
+  END DO
+  CALL cleanZeros(d)
+  DO ic = 1, ncol
+    n(ic) = 0; DO ir=1, nrow; n(ic)=MAX(n(ic), LEN_TRIM(d(ir,ic))); END DO
+    IF(needQuotes(d(2,ic)) .AND. ic/=1) n(ic) = n(ic) + 2 !--- For quotes, using second line only
+  END DO
+
+  !--- Display the strings array as a table
+  DO ir = 1, nrow
+    row = ''; sp = '   '; IF(TRIM(d(ir,1)) /= '') sp = ' = '
+    DO ic = 1, ncol
+      el = d(ir,ic); IF(ic /= 1) el = addQuotes_1(el)
+      row = row//TRIM(el)//REPEAT(' ',n(ic)-LEN_TRIM(el))//sp
+      sp = '   '; IF(ic /= ncol-1) CYCLE
+      IF(TRIM(d(MIN(ir+1,nrow),1)) /= '' .AND. (ir /= nrow .OR. .NOT.la)) sp = ' , '
+    END DO
+    WRITE(unt,'(a)')TRIM(row)
+  END DO
+
+  !--- End of section
+  IF(la) THEN
+    WRITE(unt,'(a)')'/'
+    WRITE(unt,'(a)')
+  END IF
+
+END FUNCTION dispNameList
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+LOGICAL FUNCTION dispOutliers_1(ll, a, n, err_msg, nam, subn, nRowmax, nColMax, nHead, unit) RESULT(lerr)
+  ! Display outliers list in tables
+! If "nam" is supplied, it means the last index is for tracers => one table each tracer for rank > 2.
+  LOGICAL,                    INTENT(IN)  :: ll(:)                   !--- Linearized mask of outliers
+  REAL,                       INTENT(IN)  ::  a(:)                   !--- Linearized array of values
+  INTEGER,                    INTENT(IN)  ::  n(:)                   !--- Profile before linearization
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: err_msg, nam(:), subn   !--- Error message, variables and calling SUBROUTINE names
+  INTEGER,          OPTIONAL, INTENT(IN)  :: nRowMax                 !--- Maximum number of lines to display    (default: all)
+  INTEGER,          OPTIONAL, INTENT(IN)  :: nColMax                 !--- Maximum number of characters per line (default: 2048)
+  INTEGER,          OPTIONAL, INTENT(IN)  :: nHead                   !--- Number of front columns to duplicate  (default: 1)
+  INTEGER,          OPTIONAL, INTENT(IN)  :: unit                    !--- Output unit                           (def: lunout)
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen),      ALLOCATABLE :: ttl(:)
+  LOGICAL,                    ALLOCATABLE :: m(:)
+  INTEGER,                    ALLOCATABLE :: ki(:), kj(:)
+  INTEGER                                 :: i, j, k, rk, rk1, ib, ie, itr, nm, unt, nRmx, nCmx, nHd, nv
+  CHARACTER(LEN=maxlen)                   :: mes, sub, fm='(f12.9)', v, s
+  CHARACTER(LEN=maxlen),      ALLOCATABLE :: vnm(:)
+
+  lerr = ANY(ll); IF(.NOT.lerr) RETURN                               !--- No outliers -> finished
+
+  mes = 'outliers found'; IF(PRESENT(err_msg)) mes = err_msg         !--- Error message
+  vnm = ['a'];            IF(PRESENT(nam ))    vnm = nam             !--- Variables names
+  sub = 'dispOutliers';   IF(PRESENT(subn))    sub = subn            !--- Calling SUBROUTINE name
+  nRmx= SIZE(a);          IF(PRESENT(nRowMax)) nRmx=MIN(nRmx,nRowMax)!-- Maximum number of lines to print
+  nCmx= 2048;             IF(PRESENT(nColMax)) nCmx=MIN(nCmx,nColMax)!-- Maximum number of characters each line
+  nHd = 1;                IF(PRESENT(nHead))   nHd = nHead           !--- Number of front columns to duplicate
+  unt = lunout;           IF(PRESENT(unit))    unt = unit            !--- Unit to print messages
+
+  rk = SIZE(n); nv = SIZE(vnm)
+  lerr = nv/=1 .AND. nv/=n(rk); CALL msg('SIZE(nam) /= 1 and /= last "n" element', sub, lerr); IF(lerr) RETURN
+  lerr = SIZE(a) /=   SIZE(ll); CALL msg('ll" and "a" sizes mismatch',             sub, lerr); IF(lerr) RETURN
+  lerr = SIZE(a) /= PRODUCT(n); CALL msg('profile "n" does not match "a" and "ll', sub, lerr); IF(lerr) RETURN
+  CALL msg(mes, sub, unit=unt)
+
+  !--- SCALAR CASE: single value to display
+  IF(rk==1.AND.n(1)==1) THEN
+    IF(ll(1)) WRITE(unt,'(a," = ",f12.9)')TRIM(nam(1)),a(1); RETURN
+  END IF
+
+  rk1 = rk; IF(nv==1) rk1 = rk-1                                    !--- Rank of each displayed table
+  SELECT CASE(rk1)                                                  !--- Indices list
+    CASE(1,2); ki = [ (i,i=1,n(1)) ]
+    CASE(3);   ki = [((i,i=1,n(1)),j=1,n(2))]; kj = [((j,i=1,n(1)),j=1,n(2))]
+    CASE DEFAULT; WRITE(unt,*)'Sorry: routine "dispOutliers" is limited to rank 3'; RETURN
+  END SELECT
+
+  !--- VECTOR CASE:  table " name | value " (known names)  /  )  /  " i | a(i) " (unknown names)
+  IF(rk==1) THEN
+    ALLOCATE(ttl(2)); ttl(2) = TRIM(vnm(1))//'(i)'; ttl(1) = 'i'
+    IF(nv == 1) lerr = dispTable('sr', ttl,               s=cat(PACK(nam,ll)), r=cat(PACK(a,ll)), &
+                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
+    IF(nv /= 1) lerr = dispTable('ir', ['name ','value'], i=cat(PACK(ki,m)),   r=cat(PACK(a,ll)), &
+                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
+    CALL msg("can't display outliers table", sub, lerr, unt)
+    RETURN
+  END IF
+
+  !--- OTHER CASES: one table for each tracer (last index)
+  ttl = [(ACHAR(k), k = 105, 104+rk)]                                !--- Titles list ('i', 'j', 'k'...)
+  s = strStack( ttl(1:rk-1) )                                        !--- Tracer name dummy indexes: (i, j, k, ...
+
+  DO itr=1,n(rk)
+    nm = PRODUCT(n(1:rk-1))                                          !--- number of elements per tracer
+    ie = itr*nm; ib = ie-nm+1; m=ll(ib:ie)                           !--- section bounds for tracer "itr" ; outlayers mask
+    IF(.NOT.ANY(m)) CYCLE                                            !--- no outlayers for tracer "itr"
+    v = TRIM(vnm(MIN(itr,SIZE(vnm))))//'('//TRIM(s)                  !--- "<name>("
+    IF(nv == 1) ttl(rk) = TRIM(v)//','//int2str(itr)//')'            !--- "<name>(i,j,itr)" (single name)
+    IF(nv /= 1) ttl(rk) = TRIM(v)//')'                               !--- "<nam(itr)>(i,j)" (one name each table/itr index)
+    IF(rk==2) lerr = dispTable('ir',  ttl, i=cat(PACK(ki,m)),            r=cat(PACK(a(ib:ie),m)), &
+                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
+    IF(rk==3) lerr = dispTable('iir', ttl, i=cat(PACK(ki,m),PACK(kj,m)), r=cat(PACK(a(ib:ie),m)), &
+                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
+    CALL msg("can't display outliers table", sub, lerr, unt)
+    IF(lerr) RETURN
+  END DO
+END FUNCTION dispOutliers_1
+!==============================================================================================================================
+LOGICAL FUNCTION dispOutliers_2(ll, a, n, err_msg, nam, subn, nRowMax, nColMax, nHead, unit) RESULT(lerr)
+  ! Display outliers list in tables
+! If "nam" is supplied and, it means the last index is for tracers => one table each tracer for rank > 2.
+  LOGICAL,                    INTENT(IN)  :: ll(:)                   !--- Linearized mask of outliers
+  REAL,                       INTENT(IN)  ::  a(:,:)                 !--- Linearized arrays of values stacked along 2nd dim.
+  INTEGER,                    INTENT(IN)  ::  n(:)                   !--- Profile before linearization
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: err_msg, nam(:), subn   !--- Error message, variables and calling SUBROUTINE names
+  INTEGER,          OPTIONAL, INTENT(IN)  :: nRowMax                 !--- Maximum number of lines to display    (default: all)
+  INTEGER,          OPTIONAL, INTENT(IN)  :: nColMax                 !--- Maximum number of characters per line (default: 2048)
+  INTEGER,          OPTIONAL, INTENT(IN)  :: nHead                   !--- Number of front columns to duplicate  (default: 1)
+  INTEGER,          OPTIONAL, INTENT(IN)  :: unit                    !--- Output unit                           (def: lunout)
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen)                   :: mes, sub, fm='(f12.9)', prf
+  CHARACTER(LEN=maxlen),      ALLOCATABLE :: ttl(:), vnm(:)
+  INTEGER,                    ALLOCATABLE :: ki(:), kj(:), kl(:)
+  INTEGER                                 :: i, j, k, rk, nv, unt, nRmx, nCmx, nHd
+  REAL,                       ALLOCATABLE :: val(:,:)
+
+  lerr = ANY(ll); IF(.NOT.lerr) RETURN                               !--- No outliers -> finished
+  rk = SIZE(n); nv = SIZE(a,2)
+  mes = 'outliers found';        IF(PRESENT(err_msg)) mes = err_msg  !--- Error message
+  vnm = [(ACHAR(k+96),k=1,nv)];  IF(PRESENT(nam ))    vnm = nam      !--- Variables names
+  sub = 'dispOutliers';          IF(PRESENT(subn))    sub = subn     !--- Calling SUBROUTINE name
+  nRmx= SIZE(a);          IF(PRESENT(nRowMax)) nRmx=MIN(nRmx,nRowMax)!-- Maximum number of lines to print
+  nCmx= 2048;             IF(PRESENT(nColMax)) nCmx=MIN(nCmx,nColMax)!-- Maximum number of characters each line
+  nHd = 1;                IF(PRESENT(nHead))   nHd = nHead           !--- Number of front columns to duplicate
+  unt = lunout;                  IF(PRESENT(unit))    unt = unit     !--- Unit to print messages
+  lerr= SIZE(vnm) /= nv;         IF(fmsg('SIZE(nam) /= SIZE(a,2)',                  sub, lerr, unt)) RETURN
+  lerr= SIZE(a,1) /= SIZE(ll);   IF(fmsg('"ll" and "a" sizes mismatch',             sub, lerr, unt)) RETURN
+  lerr= SIZE(a,1) /= PRODUCT(n); IF(fmsg('profile "n" does not match "a" and "ll"', sub, lerr, unt)) RETURN
+
+  SELECT CASE(rk)                                                   !--- Indices list
+    CASE(0); IF(ll(1)) THEN; WRITE(unt,'(a,", ",a," = ",2f12.9)')TRIM(vnm(1)),TRIM(vnm(2)),a(1,1),a(1,2); RETURN; END IF
+    CASE(1); ki = [  (i,i=1,n(1)) ]
+    CASE(2); ki = [ ((i,i=1,n(1)),j=1,n(2))];           kj = [ ((j,i=1,n(1)),j=1,n(2))]
+    CASE(3); ki = [(((i,i=1,n(1)),j=1,n(2)),k=1,n(3))]; kj = [(((j,i=1,n(1)),j=1,n(2)),k=1,n(3))]
+             kl = [(((k,i=1,n(1)),j=1,n(2)),k=1,n(3))]
+    CASE DEFAULT; WRITE(unt,*)'Sorry: routine "dispOutliers_2" is limited to rank 3'; RETURN
+  END SELECT
+
+  ttl = [(ACHAR(k), k = 105, 104+rk), vnm]                           !--- Titles list ('i', 'j', 'k'...'var1', 'var2', ...)
+  prf = REPEAT('i',rk)//REPEAT('r',nv)                               !--- Profile
+  ALLOCATE(val(COUNT(ll),nv)); DO k=1, nv; val(:,k) = PACK(a(:,k),ll); END DO
+  IF(rk == 1) lerr = dispTable(prf, ttl, i = cat(PACK(ki,ll)),                         r = val, &
+                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
+  IF(rk == 2) lerr = dispTable(prf, ttl, i = cat(PACK(ki,ll),PACK(kj,ll)),             r = val, &
+                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
+  IF(rk == 3) lerr = dispTable(prf, ttl, i = cat(PACK(ki,ll),PACK(kj,ll),PACK(kl,ll)), r = val, &
+                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
+  CALL msg("can't display outliers table", sub, lerr, unt)
+END FUNCTION dispOutliers_2
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== Reduce an algebrical expression (basic operations and parenthesis) to a single number (string format) ====================
+!==============================================================================================================================
+LOGICAL FUNCTION reduceExpr_1(str, val) RESULT(lerr)
+    CHARACTER(LEN=*),      INTENT(IN)  :: str
+  CHARACTER(LEN=maxlen), INTENT(OUT) :: val
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen)              :: v
+  CHARACTER(LEN=1024)                :: s, vv
+  CHARACTER(LEN=1024), ALLOCATABLE :: vl(:)
+  INTEGER,             ALLOCATABLE :: ip(:)
+  INTEGER :: nl, nn, i, j, im, ix
+  LOGICAL :: ll
+  s = str
+
+  !--- Check wether the parenthesis are correctly formed
+  ll = strCount(s,'(',nl)
+  ll = strCount(s,')',nn)
+  lerr = nl /= nn
+  IF(fmsg('Mismatching number of opening and closing parenthesis: '//TRIM(s), ll=lerr)) RETURN
+  nl = 2*nl-1
+
+  !--- Build vectors ; vl: parenthesis-separated elements ; ip: parenthesis types (1: opening, 2: closing)
+  ALLOCATE(ip(nl-1),vl(nl))
+  j = 1; im = 1
+  DO i = 1, LEN_TRIM(str)
+    ix = INDEX('()', str(i:i))
+    IF(ix == 0) CYCLE
+    ip(j) = ix
+    vl(j) = str(im:i-1)
+    j = j + 1; im = i + 1
+  END DO
+  vl(j) = str(im:LEN_TRIM(str))
+
+  !--- Search for each opening/closing parenthesis pair
+  DO WHILE(nl > 1)
+    i = 1; DO WHILE(ip(i) /= 1 .OR. ip(i+1) /= 2); i = i + 1; END DO !IF(i > SIZE(ip)+1) EXIT;END DO
+    lerr = reduceExpr_basic(vl(i+1), v); IF(lerr) RETURN
+    v = TRIM(vl(i))//TRIM(v); IF(i+2<=nl) v=TRIM(v)//TRIM(vl(i+2))
+    vv = v//REPEAT(' ',768)
+    IF(i == 1) THEN;         ip =  ip(3:nl-1);                vl = [            vv, vl(4  :nl)]
+    ELSE IF(i == nl-1) THEN; ip =  ip(1:nl-2);                vl = [vl(1:nl-3), vv            ]
+    ELSE;                    ip = [ip(1: i-1), ip(i+2:nl-1)]; vl = [vl(1: i-1), vv, vl(i+3:nl)]; END IF
+    nl = SIZE(vl)
+  END DO
+  lerr = reduceExpr_basic(vl(1), val)
+END FUNCTION reduceExpr_1
+
+
+!==============================================================================================================================
+!=== Reduce a simple algebrical expression (basic operations, no parenthesis) to a single number (string format) ==============
+!==============================================================================================================================
+LOGICAL FUNCTION reduceExpr_basic(str, val) RESULT(lerr)
+    CHARACTER(LEN=*),      INTENT(IN)  :: str
+  CHARACTER(LEN=*),      INTENT(OUT) :: val
+  DOUBLE PRECISION,      ALLOCATABLE :: vl(:)
+  INTEGER,               ALLOCATABLE :: id(:)
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: ky(:)
+  CHARACTER(LEN=1),      ALLOCATABLE :: op(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=1024) :: s
+  DOUBLE PRECISION :: v, vm, vp
+  INTEGER      :: i, ni, io
+  lerr = .FALSE.
+  IF(is_numeric(str)) THEN; val=TRIM(str); RETURN; END IF
+  op = ['^','/','*','+','-']                                                   !--- List of recognized operations
+  s = str
+  lerr = strParse_m(s, op, ky, lSc=.TRUE., id = id)                            !--- Parse the values
+  IF(lerr) RETURN                                                              !--- Problem with the parsing
+  vl = str2dble(ky)                                                            !--- Conversion to doubles
+  lerr = ANY(vl >= HUGE(1.d0))
+  CALL msg('Some values are non-numeric in: '//TRIM(s), ll=lerr)
+  IF(lerr) RETURN                                                              !--- Non-numerical values found
+  DO io = 1, SIZE(op)                                                          !--- Loop on known operators (order matters !)
+    DO i = SIZE(id), 1, -1                                                     !--- Loop on found operators
+      ni = SIZE(id)
+      IF(id(i) /= io) CYCLE                                                    !--- Current found operator is not op(io)
+      vm = vl(i); vp = vl(i+1)                                                 !--- Couple of values used for current operation
+      SELECT CASE(op(io))                                                      !--- Perform operation on the two values
+        CASE('^'); v = vm**vp
+        CASE('/'); v = vm/vp
+        CASE('*'); v = vm*vp
+        CASE('+'); v = vm+vp
+        CASE('-'); v = vm-vp
+      END SELECT
+      IF(i == ni) THEN; vl = [vl(1:ni-1), v]; ELSE; vl = [vl(1:i-1), v, vl(i+2:ni+1)]; END IF
+      IF(i == ni) THEN; id =  id(1:ni-1);     ELSE; id = [id(1:i-1),    id(i+1:ni  )]; END IF
+    END DO
+  END DO
+  val = dble2str(vl(1))
+
+END FUNCTION reduceExpr_basic
+!==============================================================================================================================
+
+!==============================================================================================================================
+FUNCTION reduceExpr_m(str, val) RESULT(lerr)
+    LOGICAL,               ALLOCATABLE              :: lerr(:)
+  CHARACTER(LEN=*),                   INTENT(IN)  :: str(:)
+  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: i
+  ALLOCATE(lerr(SIZE(str)),val(SIZE(str)))
+  lerr(:) = [(reduceExpr_1(str(i), val(i)), i=1, SIZE(str))]
+END FUNCTION reduceExpr_m
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== Check whether a string is a number or not ================================================================================
+!==============================================================================================================================
+ELEMENTAL LOGICAL FUNCTION is_numeric(str) RESULT(OUT)
+    CHARACTER(LEN=*), INTENT(IN) :: str
+  REAL    :: x
+  INTEGER :: e
+  CHARACTER(LEN=12) :: fmt
+  IF(TRIM(str) == '') THEN; out = .FALSE.; RETURN; END IF
+  WRITE(fmt,'("(f",i0,".0)")') LEN_TRIM(str)
+  READ(str,fmt,IOSTAT=e) x
+  out = e==0 .AND. INDEX('Ee',str(LEN_TRIM(str):LEN_TRIM(str)))==0
+END FUNCTION is_numeric
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== Convert a string into a logical/integer integer or an integer/real into a string =========================================
+!==============================================================================================================================
+ELEMENTAL INTEGER FUNCTION str2bool(str) RESULT(OUT)  !--- Result: 0/1 for .FALSE./.TRUE., -1 if not a valid boolean
+    CHARACTER(LEN=*), INTENT(IN) :: str
+  INTEGER :: ierr
+  LOGICAL :: lout
+  READ(str,*,IOSTAT=ierr) lout
+  out = -HUGE(1)
+  IF(ierr /= 0) THEN
+    IF(ANY(['.FALSE.', 'false  ', 'no     ', 'f      ', 'n      '] == strLower(str))) out = 0
+    IF(ANY(['.TRUE. ', 'true   ', 'yes    ', 't      ', 'y      '] == strLower(str))) out = 1
+  ELSE
+    out = 0; IF(lout) out = 1
+  END IF
+END FUNCTION str2bool
+!==============================================================================================================================
+ELEMENTAL INTEGER FUNCTION str2int(str) RESULT(OUT)
+    CHARACTER(LEN=*), INTENT(IN) :: str
+  INTEGER :: ierr
+  READ(str,*,IOSTAT=ierr) out
+  IF(ierr/=0) out = -HUGE(1)
+END FUNCTION str2int
+!==============================================================================================================================
+ELEMENTAL REAL FUNCTION str2real(str) RESULT(OUT)
+    CHARACTER(LEN=*), INTENT(IN) :: str
+  INTEGER :: ierr
+  READ(str,*,IOSTAT=ierr) out
+  IF(ierr/=0) out = -HUGE(1.)
+END FUNCTION str2real
+!==============================================================================================================================
+ELEMENTAL DOUBLE PRECISION FUNCTION str2dble(str) RESULT(OUT)
+    CHARACTER(LEN=*), INTENT(IN) :: str
+  INTEGER :: ierr
+  READ(str,*,IOSTAT=ierr) out
+  IF(ierr/=0) out = -HUGE(1.d0)
+END FUNCTION str2dble
+!==============================================================================================================================
+ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION bool2str(b) RESULT(OUT)
+    LOGICAL, INTENT(IN) :: b
+  WRITE(out,*)b
+  out = ADJUSTL(OUT)
+END FUNCTION bool2str
+!==============================================================================================================================
+ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION int2str(i, nDigits) RESULT(OUT)
+    INTEGER,           INTENT(IN) :: i
+  INTEGER, OPTIONAL, INTENT(IN) :: nDigits
+!------------------------------------------------------------------------------------------------------------------------------
+  WRITE(out,*)i
+  out = ADJUSTL(OUT)
+  IF(.NOT.PRESENT(nDigits)) RETURN
+  IF(nDigits > LEN_TRIM(out)) out = REPEAT('0', nDigits - LEN_TRIM(out))//TRIM(OUT)
+END FUNCTION int2str
+!==============================================================================================================================
+ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION real2str(r,fmt) RESULT(OUT)
+    REAL,                       INTENT(IN) :: r
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
+!------------------------------------------------------------------------------------------------------------------------------
+  IF(     PRESENT(fmt)) WRITE(out,fmt)r
+  IF(.NOT.PRESENT(fmt)) WRITE(out, * )r
+  out = ADJUSTL(OUT)
+END FUNCTION real2str
+!==============================================================================================================================
+ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION dble2str(d,fmt) RESULT(OUT)
+    DOUBLE PRECISION,           INTENT(IN) :: d
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
+!------------------------------------------------------------------------------------------------------------------------------
+  IF(     PRESENT(fmt)) WRITE(out,fmt)d
+  IF(.NOT.PRESENT(fmt)) WRITE(out, * )d
+  out = ADJUSTL(OUT)
+END FUNCTION dble2str
+!==============================================================================================================================
+ELEMENTAL SUBROUTINE cleanZeros(s)
+    CHARACTER(LEN=*), INTENT(INOUT) :: s
+  INTEGER :: ls, ix, i
+  IF(is_numeric(s)) THEN
+    ls = LEN_TRIM(s)
+    ix = MAX(INDEX(s,'E'),INDEX(s,'e'),INDEX(s,'D'),INDEX(s,'d'))
+    IF(ix == 0) THEN
+      DO ix = ls,1,-1; IF(s(ix:ix) /= '0') EXIT; END DO; s=s(1:ix+1)
+    ELSE IF(INDEX(s,'.')/=0) THEN
+      i = ix-1; DO WHILE(s(i:i) == '0'); i = i-1; END DO; s=s(1:i)//s(ix:ls)
+    END IF
+  END IF
+END SUBROUTINE cleanZeros
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+FUNCTION addQuotes_1(s) RESULT(OUT)
+    CHARACTER(LEN=*), INTENT(IN)  :: s
+  CHARACTER(LEN=:), ALLOCATABLE :: out
+  IF(needQuotes(s)) THEN; out = "'"//TRIM(s)//"'"; ELSE; out = s; END IF
+END FUNCTION addQuotes_1
+!==============================================================================================================================
+FUNCTION addQuotes_m(s) RESULT(OUT)
+    CHARACTER(LEN=*), INTENT(IN)  :: s(:)
+  CHARACTER(LEN=:), ALLOCATABLE :: out(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: k, n
+  n = MAXVAL(LEN_TRIM(s), MASK=.TRUE.)
+  ALLOCATE(CHARACTER(LEN=n) :: out(SIZE(s)))
+  DO k=1,SIZE(s)
+    IF(needQuotes(s(k))) THEN; out(k) = "'"//TRIM(s(k))//"'"; ELSE; out(k) = s(k); END IF
+  END DO
+END FUNCTION addQuotes_m
+!==============================================================================================================================
+ELEMENTAL LOGICAL FUNCTION needQuotes(s) RESULT(OUT)
+    CHARACTER(LEN=*), INTENT(IN) :: s
+  CHARACTER(LEN=1) :: b, e
+!------------------------------------------------------------------------------------------------------------------------------
+  out = .TRUE.; IF(TRIM(s) == '') RETURN
+  b = s(1:1); e = s(MAX(1,LEN_TRIM(s)):MAX(1,LEN_TRIM(s)))
+  out = .NOT.is_numeric(s) .AND. (b /= "'" .OR. e /= "'") .AND. ( b /= '"' .OR. e /= '"')
+END FUNCTION needQuotes
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== DISPLAY "<message>: the following <items> are <reason>" FOLLOWED BY THE LIST OF <str> FOR WHICH <lerr>==T. ===============
+!==============================================================================================================================
+LOGICAL FUNCTION checkList(str, lerr, message, items, reason, nmax) RESULT(OUT)
+  ! Purpose: Messages in case a list contains wrong elements (indicated by lerr boolean vector).
+! Note:    Return value "out" is .TRUE. if there are errors (ie at least one element of "lerr" is TRUE).
+  CHARACTER(LEN=*),   INTENT(IN)  :: str(:)
+  LOGICAL,            INTENT(IN)  :: lerr(:)
+  CHARACTER(LEN=*),   INTENT(IN)  :: message, items, reason
+  INTEGER,  OPTIONAL, INTENT(IN)  :: nmax
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)
+  INTEGER :: i, nmx
+  nmx = 256; IF(PRESENT(nmax)) nmx=nmax
+  out = ANY(lerr); IF(.NOT.out) RETURN
+  CALL msg(TRIM(message)//': the following '//TRIM(items)//' are '//TRIM(reason)//':')
+  s = strStackm(PACK(str, MASK=lerr), ', ',nmx)
+  DO i=1,SIZE(s,DIM=1); CALL msg(s(i)); END DO
+END FUNCTION checkList
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== Remove comment in line "str", ie all the characters from the first "#" sign found in "str". ==============================
+!==============================================================================================================================
+SUBROUTINE removeComment(str)
+    CHARACTER(LEN=*), INTENT(INOUT) :: str
+  INTEGER :: ix
+  ix = INDEX(str,'# '); IF(ix /= 0) str = str(1:ix-1)//REPEAT(' ',LEN(str)-ix+1)
+END SUBROUTINE removeComment
+!==============================================================================================================================
+
+
+END MODULE lmdz_strings
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_vampir.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_vampir.F90	(revision 5117)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_vampir.F90	(revision 5117)
@@ -0,0 +1,86 @@
+module lmdz_vampir
+
+  INTEGER, parameter :: VTcaldyn = 1
+  INTEGER, parameter :: VTintegre = 2
+  INTEGER, parameter :: VTadvection = 3
+  INTEGER, parameter :: VTdissipation = 4
+  INTEGER, parameter :: VThallo = 5
+  INTEGER, parameter :: VTphysiq = 6
+  INTEGER, parameter :: VTinca = 7
+
+  INTEGER, parameter :: nb_inst = 7
+  INTEGER :: MPE_begin(nb_inst)
+  INTEGER :: MPE_end(nb_inst)
+
+contains
+
+  SUBROUTINE InitVampir
+    IMPLICIT NONE
+
+#ifdef USE_VT
+    include 'VT.inc'
+    INTEGER :: ierr
+    
+    CALL VTSYMDEF(VTcaldyn,"caldyn","caldyn",ierr)
+    CALL VTSYMDEF(VTintegre,"integre","integre",ierr)
+    CALL VTSYMDEF(VTadvection,"advection","advection",ierr)
+    CALL VTSYMDEF(VTdissipation,"dissipation","dissipation",ierr)
+    CALL VTSYMDEF(VThallo,"hallo","hallo",ierr)
+    CALL VTSYMDEF(VTphysiq,"physiq","physiq",ierr)
+    CALL VTSYMDEF(VTinca,"inca","inca",ierr)
+#endif
+
+#ifdef USE_MPE
+    include 'mpe_logf.h' 
+    INTEGER :: ierr,i
+    
+    DO i=1,nb_inst
+      ierr = MPE_Log_get_state_eventIDs( MPE_begin(i), MPE_end(i) )
+    ENDDO
+    
+    ierr = MPE_Describe_state( MPE_begin(VTcaldyn), MPE_end(VTcaldyn),"caldyn", "yellow" )
+    ierr = MPE_Describe_state( MPE_begin(VTintegre), MPE_end(VTintegre),"integre", "blue" )
+    ierr = MPE_Describe_state( MPE_begin(VTadvection), MPE_end(VTadvection),"advection", "green" )
+    ierr = MPE_Describe_state( MPE_begin(VTdissipation), MPE_end(VTdissipation),"dissipation", "ivory" )
+    ierr = MPE_Describe_state( MPE_begin(VThallo), MPE_end(VThallo),"hallo", "orange" )
+    ierr = MPE_Describe_state( MPE_begin(VTphysiq), MPE_end(VTphysiq),"physiq", "purple" )
+    ierr = MPE_Describe_state( MPE_begin(VTinca), MPE_end(VTinca),"inca", "LightBlue" )
+#endif     
+  END SUBROUTINE  InitVampir
+
+  SUBROUTINE VTb(number)
+    IMPLICIT NONE
+    INTEGER :: number
+#ifdef USE_VT    
+    include 'VT.inc'
+    INTEGER :: ierr
+    
+    CALL VTBEGIN(number,ierr)
+#endif 
+#ifdef USE_MPE
+    include 'mpe_logf.h' 
+    INTEGER :: ierr,i
+    ierr = MPE_Log_event( MPE_begin(number), 0, '' )
+#endif
+
+  END SUBROUTINE  VTb
+
+  SUBROUTINE VTe(number)
+    IMPLICIT NONE
+    INTEGER :: Number
+#ifdef USE_VT    
+    include 'VT.inc'
+    INTEGER :: ierr
+   
+    CALL VTEND(number,ierr)
+#endif    
+
+#ifdef USE_MPE
+    include 'mpe_logf.h' 
+    INTEGER :: ierr,i
+    ierr = MPE_Log_event( MPE_end(number), 0, '' )
+#endif
+
+  END SUBROUTINE  VTe
+
+end module lmdz_vampir
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_write_field.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_write_field.f90	(revision 5117)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_write_field.f90	(revision 5117)
@@ -0,0 +1,301 @@
+module lmdz_write_field
+  USE netcdf, ONLY: nf90_sync, nf90_put_var, nf90_enddef, nf90_def_dim, nf90_unlimited, &
+          nf90_clobber, nf90_create, nf90_def_var
+  USE lmdz_cppkeys_wrapper, ONLY: nf90_format
+  USE lmdz_strings, ONLY: int2str
+
+  IMPLICIT NONE; PRIVATE
+  PUBLIC WriteField
+
+  INTEGER, parameter :: MaxWriteField = 100
+  INTEGER, DIMENSION(MaxWriteField), save :: FieldId
+  INTEGER, DIMENSION(MaxWriteField), save :: FieldVarId
+  INTEGER, DIMENSION(MaxWriteField), save :: FieldIndex
+  CHARACTER(LEN = 255), DIMENSION(MaxWriteField) :: FieldName
+
+  INTEGER, save :: NbField = 0
+
+  interface WriteField
+    module procedure WriteField3d, WriteField2d, WriteField1d
+  end interface WriteField
+contains
+
+  function GetFieldIndex(name)
+    IMPLICIT NONE
+    INTEGER :: GetFieldindex
+    CHARACTER(LEN = *) :: name
+
+    CHARACTER(LEN = 255) :: TrueName
+    INTEGER :: i
+
+    TrueName = TRIM(ADJUSTL(name))
+
+    GetFieldIndex = -1
+    do i = 1, NbField
+      IF (TrueName==FieldName(i)) THEN
+        GetFieldIndex = i
+        exit
+      endif
+    enddo
+  END FUNCTION GetFieldIndex
+
+  subroutine WriteField3d(name, Field)
+    IMPLICIT NONE
+    CHARACTER(LEN = *) :: name
+    REAL, DIMENSION(:, :, :) :: Field
+    INTEGER, DIMENSION(3) :: Dim
+
+    Dim = shape(Field)
+    CALL WriteField_gen(name, Field, Dim(1), Dim(2), Dim(3))
+
+  END SUBROUTINE WriteField3d
+
+  subroutine WriteField2d(name, Field)
+    IMPLICIT NONE
+    CHARACTER(LEN = *) :: name
+    REAL, DIMENSION(:, :) :: Field
+    INTEGER, DIMENSION(2) :: Dim
+
+    Dim = shape(Field)
+    CALL WriteField_gen(name, Field, Dim(1), Dim(2), 1)
+
+  END SUBROUTINE WriteField2d
+
+  subroutine WriteField1d(name, Field)
+    IMPLICIT NONE
+    CHARACTER(LEN = *) :: name
+    REAL, DIMENSION(:) :: Field
+    INTEGER, DIMENSION(1) :: Dim
+
+    Dim = shape(Field)
+    CALL WriteField_gen(name, Field, Dim(1), 1, 1)
+
+  END SUBROUTINE WriteField1d
+
+  subroutine WriteField_gen(name, Field, dimx, dimy, dimz)
+    IMPLICIT NONE
+    CHARACTER(LEN = *) :: name
+    INTEGER :: dimx, dimy, dimz
+    REAL, DIMENSION(dimx, dimy, dimz) :: Field
+    INTEGER, DIMENSION(dimx * dimy * dimz) :: ndex
+    INTEGER :: status
+    INTEGER :: index
+    INTEGER :: start(4)
+    INTEGER :: count(4)
+
+    Index = GetFieldIndex(name)
+    IF (Index==-1) THEN
+      CALL CreateNewField(name, dimx, dimy, dimz)
+      Index = GetFieldIndex(name)
+    else
+      FieldIndex(Index) = FieldIndex(Index) + 1.
+    endif
+
+    start(1) = 1
+    start(2) = 1
+    start(3) = 1
+    start(4) = FieldIndex(Index)
+
+    count(1) = dimx
+    count(2) = dimy
+    count(3) = dimz
+    count(4) = 1
+
+    status = nf90_put_var(FieldId(Index), FieldVarId(Index), Field, start, count)
+    status = nf90_sync(FieldId(Index))
+
+  END SUBROUTINE WriteField_gen
+
+  subroutine CreateNewField(name, dimx, dimy, dimz)
+    IMPLICIT NONE
+    CHARACTER(LEN = *) :: name
+    INTEGER :: dimx, dimy, dimz
+    INTEGER :: TabDim(4)
+    INTEGER :: status
+
+    NbField = NbField + 1
+    FieldName(NbField) = TRIM(ADJUSTL(name))
+    FieldIndex(NbField) = 1
+
+    status = nf90_create(TRIM(ADJUSTL(name)) // '.nc', nf90_clobber, FieldId(NbField))
+    status = nf90_def_dim(FieldId(NbField), 'X', dimx, TabDim(1))
+    status = nf90_def_dim(FieldId(NbField), 'Y', dimy, TabDim(2))
+    status = nf90_def_dim(FieldId(NbField), 'Z', dimz, TabDim(3))
+    status = nf90_def_dim(FieldId(NbField), 'iter', nf90_unlimited, TabDim(4))
+    status = nf90_def_var(FieldId(NbField), FieldName(NbField), nf90_format, TabDim, FieldVarId(NbField))
+    status = nf90_enddef(FieldId(NbField))
+
+  END SUBROUTINE CreateNewField
+
+  subroutine write_field1D(name, Field)
+    IMPLICIT NONE
+
+    INTEGER, parameter :: MaxDim = 1
+    CHARACTER(LEN = *) :: name
+    REAL, DIMENSION(:) :: Field
+    REAL, DIMENSION(:), ALLOCATABLE :: New_Field
+    CHARACTER(LEN = 20) :: str
+    INTEGER, DIMENSION(MaxDim) :: Dim
+    INTEGER :: i, nb
+    INTEGER, parameter :: id = 10
+    INTEGER, parameter :: NbCol = 4
+    INTEGER :: ColumnSize
+    INTEGER :: pos
+    CHARACTER(LEN = 255) :: form
+    CHARACTER(LEN = 255) :: MaxLen
+
+    open(unit = id, file = name // '.field', form = 'formatted', status = 'replace')
+    write (id, '("----- Field ' // name // '",//)')
+    Dim = shape(Field)
+    MaxLen = int2str(len(trim(int2str(Dim(1)))))
+    ColumnSize = 20 + 6 + 3 + len(trim(int2str(Dim(1))))
+    Nb = 0
+    Pos = 2
+    do i = 1, Dim(1)
+      nb = nb + 1
+
+      IF (MOD(nb, NbCol)==0) THEN
+        form = '(t' // trim(int2str(pos)) // ',i' // trim(MaxLen) // '," ---> ",g22.16,/)'
+        Pos = 2
+      else
+        form = '(t' // trim(int2str(pos)) // ',i' // trim(MaxLen) // '," ---> ",g22.16," | ",)'
+        Pos = Pos + ColumnSize
+      endif
+      write (id, form, advance = 'no') i, Field(i)
+    enddo
+
+    close(id)
+
+  END SUBROUTINE write_field1D
+
+  subroutine write_field2D(name, Field)
+    IMPLICIT NONE
+
+    INTEGER, parameter :: MaxDim = 2
+    CHARACTER(LEN = *) :: name
+    REAL, DIMENSION(:, :) :: Field
+    REAL, DIMENSION(:, :), ALLOCATABLE :: New_Field
+    CHARACTER(LEN = 20) :: str
+    INTEGER, DIMENSION(MaxDim) :: Dim
+    INTEGER :: i, j, nb
+    INTEGER, parameter :: id = 10
+    INTEGER, parameter :: NbCol = 4
+    INTEGER :: ColumnSize
+    INTEGER :: pos, offset
+    CHARACTER(LEN = 255) :: form
+    CHARACTER(LEN = 255) :: spacing
+
+    open(unit = id, file = name // '.field', form = 'formatted', status = 'replace')
+    write (id, '("----- Field ' // name // '",//)')
+
+    Dim = shape(Field)
+    offset = len(trim(int2str(Dim(1)))) + len(trim(int2str(Dim(2)))) + 3
+    ColumnSize = 20 + 6 + 3 + offset
+
+    spacing = '(t2,"' // repeat('-', ColumnSize * NbCol) // '")'
+
+    do i = 1, Dim(2)
+      nb = 0
+      Pos = 2
+      do j = 1, Dim(1)
+        nb = nb + 1
+
+        IF (MOD(nb, NbCol)==0) THEN
+          form = '(t' // trim(int2str(pos)) // &
+                  ',"(' // trim(int2str(j)) // ','          &
+                  // trim(int2str(i)) // ')",t'       &
+                  // trim(int2str(pos + offset))     &
+                  // '," ---> ",g22.16,/)'
+          Pos = 2
+        else
+          form = '(t' // trim(int2str(pos)) // &
+                  ',"(' // trim(int2str(j)) // ','          &
+                  // trim(int2str(i)) // ')",t'       &
+                  // trim(int2str(pos + offset))     &
+                  // '," ---> ",g22.16," | ")'
+          Pos = Pos + ColumnSize
+        endif
+        write (id, form, advance = 'no') Field(j, i)
+      enddo
+      IF (MOD(nb, NbCol)==0) THEN
+        write (id, spacing)
+      else
+        write (id, '("")')
+        write (id, spacing)
+      endif
+    enddo
+
+  END SUBROUTINE write_field2D
+
+  subroutine write_field3D(name, Field)
+    IMPLICIT NONE
+
+    INTEGER, parameter :: MaxDim = 3
+    CHARACTER(LEN = *) :: name
+    REAL, DIMENSION(:, :, :) :: Field
+    REAL, DIMENSION(:, :, :), ALLOCATABLE :: New_Field
+    INTEGER, DIMENSION(MaxDim) :: Dim
+    INTEGER :: i, j, k, nb
+    INTEGER, parameter :: id = 10
+    INTEGER, parameter :: NbCol = 4
+    INTEGER :: ColumnSize
+    INTEGER :: pos, offset
+    CHARACTER(LEN = 255) :: form
+    CHARACTER(LEN = 255) :: spacing
+
+    open(unit = id, file = name // '.field', form = 'formatted', status = 'replace')
+    write (id, '("----- Field ' // name // '"//)')
+
+    Dim = shape(Field)
+    offset = len(trim(int2str(Dim(1)))) + len(trim(int2str(Dim(2)))) + len(trim(int2str(Dim(3)))) + 4
+    ColumnSize = 22 + 6 + 3 + offset
+
+    !    open(unit=id,file=name,form=formatted
+
+    spacing = '(t2,"' // repeat('-', ColumnSize * NbCol) // '")'
+
+    do i = 1, Dim(3)
+
+      do j = 1, Dim(2)
+        nb = 0
+        Pos = 2
+
+        do k = 1, Dim(1)
+          nb = nb + 1
+
+          IF (MOD(nb, NbCol)==0) THEN
+            form = '(t' // trim(int2str(pos)) // &
+                    ',"(' // trim(int2str(k)) // ','          &
+                    // trim(int2str(j)) // ','          &
+                    // trim(int2str(i)) // ')",t'       &
+                    // trim(int2str(pos + offset))      &
+                    // '," ---> ",g22.16,/)'
+            Pos = 2
+          else
+            form = '(t' // trim(int2str(pos)) // &
+                    ',"(' // trim(int2str(k)) // ','          &
+                    // trim(int2str(j)) // ','          &
+                    // trim(int2str(i)) // ')",t'       &
+                    // trim(int2str(pos + offset))      &
+                    // '," ---> ",g22.16," | ")'
+            ! dépend de l'implémention, sur compaq, c'est necessaire
+            !            Pos=Pos+ColumnSize
+          endif
+          write (id, form, advance = 'no') Field(k, j, i)
+        enddo
+        IF (MOD(nb, NbCol)==0) THEN
+          write (id, spacing)
+        else
+          write (id, '("")')
+          write (id, spacing)
+        endif
+      enddo
+      write (id, spacing)
+    enddo
+
+    close(id)
+
+  END SUBROUTINE write_field3D
+
+end module lmdz_write_field
+  
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_wxios.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_wxios.F90	(revision 5117)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_wxios.F90	(revision 5117)
@@ -0,0 +1,787 @@
+! $Id$
+
+MODULE lmdz_wxios
+    USE lmdz_xios
+
+    !Variables disponibles pendant toute l'execution du programme:
+    
+    INTEGER, SAVE :: g_comm
+    CHARACTER(len=100), SAVE :: g_ctx_name ="LMDZ"
+    TYPE(xios_context), SAVE :: g_ctx
+!$OMP THREADPRIVATE(g_comm,g_ctx_name,g_ctx)
+    LOGICAL, SAVE :: g_flag_xml = .FALSE.
+    CHARACTER(len=100) :: g_field_name = "nofield"
+!$OMP THREADPRIVATE(g_flag_xml,g_field_name)
+    REAL :: missing_val_omp
+    REAL :: missing_val
+!$OMP THREADPRIVATE(missing_val)
+
+#ifdef XIOS1
+#error "XIOS v1 no longer supported, use XIOS v2."
+#endif
+
+    CONTAINS
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !   36day => 36d etc     !!!!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    
+    SUBROUTINE reformadate(odate, ndate)
+        CHARACTER(len=*), INTENT(IN) :: odate
+        TYPE(xios_duration) :: ndate
+        
+        INTEGER :: i = 0
+         !!!!!!!!!!!!!!!!!!
+         ! Pour XIOS:
+         !  year : y
+         !  month : mo
+         !  day : d
+         !  hour : h
+         !  minute : mi
+         !  second : s
+         !!!!!!!!!!!!!!!!!!
+
+        i = INDEX(odate, "day")
+        IF (i > 0) THEN
+            read(odate(1:i-1),*) ndate%day
+        END IF
+
+        i = INDEX(odate, "hr")
+        IF (i > 0) THEN
+            read(odate(1:i-1),*) ndate%hour
+        END IF
+
+        i = INDEX(odate, "mth")
+        IF (i > 0) THEN
+            read(odate(1:i-1),*) ndate%month
+        END IF
+        
+        !IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", odate, " => ", ndate
+    END SUBROUTINE reformadate
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !   ave(X) => average etc     !!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    
+    CHARACTER(len=7) FUNCTION reformaop(op)
+        CHARACTER(len=*), INTENT(IN) :: op
+        
+        INTEGER :: i = 0
+        reformaop = "average"
+        
+        IF (op=="inst(X)") THEN
+            reformaop = "instant"
+        END IF
+        
+        IF (op=="once") THEN
+            reformaop = "once"
+        END IF
+        
+        IF (op=="t_max(X)") THEN
+            reformaop = "maximum"
+        END IF
+        
+        IF (op=="t_min(X)") THEN
+            reformaop = "minimum"
+        END IF
+        
+        !IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", op, " => ", reformaop
+    END FUNCTION reformaop
+
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Routine d'initialisation      !!!!!!!!!!!!!
+    !     A lancer juste après mpi_init !!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+    SUBROUTINE wxios_init(xios_ctx_name, locom, outcom, type_ocean)
+        USE lmdz_print_control, ONLY: prt_level, lunout
+        IMPLICIT NONE
+
+      CHARACTER(len=*), INTENT(IN) :: xios_ctx_name
+      INTEGER, INTENT(IN), OPTIONAL :: locom
+      INTEGER, INTENT(OUT), OPTIONAL :: outcom
+      CHARACTER(len=6), INTENT(IN), OPTIONAL :: type_ocean
+
+    
+        TYPE(xios_context) :: xios_ctx
+        INTEGER :: xios_comm
+
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: Initialization"
+
+
+
+        IF (PRESENT(locom)) THEN
+          CALL xios_initialize(xios_ctx_name, local_comm = locom, return_comm = xios_comm )
+          IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," local_comm=",locom,", return_comm=",xios_comm
+        ELSE
+          CALL xios_initialize(xios_ctx_name, return_comm = xios_comm )
+          IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," return_comm=",xios_comm
+        END IF
+        
+        IF (PRESENT(outcom)) THEN
+          outcom = xios_comm
+          IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," outcom=",outcom
+        END IF
+        
+        !Enregistrement des variables globales:
+        g_comm = xios_comm
+        g_ctx_name = xios_ctx_name
+        
+!        ! Si couple alors init fait dans cpl_init
+!        IF (.NOT. PRESENT(type_ocean)) THEN
+!            CALL wxios_context_init()
+!        ENDIF
+         WRITE(*,*)'END of WXIOS_INIT', g_comm , g_ctx_name 
+
+    END SUBROUTINE wxios_init
+
+    SUBROUTINE wxios_context_init()
+        USE lmdz_print_control, ONLY: prt_level, lunout
+        USE lmdz_phys_mpi_data, ONLY: COMM_LMDZ_PHY
+        IMPLICIT NONE
+
+        TYPE(xios_context) :: xios_ctx
+
+!$OMP MASTER
+        !Initialisation du contexte:
+        !!CALL xios_context_initialize(g_ctx_name, g_comm)
+        CALL xios_context_initialize(g_ctx_name, COMM_LMDZ_PHY)
+        CALL xios_get_handle(g_ctx_name, xios_ctx)    !Récupération
+        CALL xios_set_current_context(xios_ctx)            !Activation
+        g_ctx = xios_ctx
+
+        CALL wxios_add_group_init
+        
+        IF (prt_level >= 10) THEN
+          WRITE(lunout,*) "wxios_context_init: Current context is ",trim(g_ctx_name)
+          WRITE(lunout,*) "     now CALL xios_solve_inheritance()"
+        ENDIF
+        !Une première analyse des héritages:
+        CALL xios_solve_inheritance()
+!$OMP END MASTER
+    END SUBROUTINE wxios_context_init
+
+
+    
+    SUBROUTINE wxios_add_group_init
+
+      ! routine create by Anne Cozic (2023)
+      ! This routine will create field associated to group defined without description of fields in field.xml file
+      ! This routine need to be CALL before "xios_sole_inheritance" after an !$OMP MASTER directive
+      
+      USE infotrac_phy, ONLY: nbtr, nqtot, nqo, type_trac, tracers, niso, ntiso
+      USE lmdz_strings,  ONLY: maxlen
+
+      IMPLICIT NONE
+
+      TYPE(xios_fieldgroup) :: group_handle, philev_hdl
+      TYPE(xios_field) :: child
+      INTEGER :: k, iq
+      CHARACTER(len=12) :: nvar, name_phi    
+      CHARACTER(LEN=maxlen) :: varname, dn
+      CHARACTER(LEN=maxlen) :: unt
+    
+
+      ! group create for StratAER variables 
+      !On ajoute les variables 3D traceurs par l interface fortran 
+      CALL xios_get_handle("fields_strataer_trac_3D", group_handle)
+      ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
+      DO iq = 1, nqtot
+         IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
+         dn = 'd'//TRIM(tracers(iq)%name)//'_'
+
+         unt = "kg kg-1"
+         varname=trim(tracers(iq)%name)
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         
+         unt = "kg kg-1 s-1"
+         varname=TRIM(dn)//'vdf'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'the'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'con'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'lessi_impa'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'lessi_nucl'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'insc'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'bcscav'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'evapls'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'ls'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'trsp'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'sscav'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'sat'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'uscav'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+      END DO
+      !On ajoute les variables 2D traceurs par l interface fortran 
+      CALL xios_get_handle("fields_strataer_trac_2D", group_handle)
+      ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
+      DO iq = 1, nqtot
+         IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
+         
+         unt = "kg m-2"
+         varname='cum'//trim(tracers(iq)%name)
+         
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         
+         unt = "kg m-2 s-1"
+         varname='cumd'//trim(tracers(iq)%name)//'_dry'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+      ENDDO
+      
+
+      ! group create for offline mass flow variables
+      CALL xios_get_handle("philev_grp", philev_hdl)
+
+      DO k=1,79
+         IF (k<10) THEN
+            WRITE(nvar,'(i1)') k
+         ELSE IF (k<100) THEN
+            WRITE(nvar,'(i2)') k
+         ELSE
+            WRITE(nvar,'(i3)') k
+         END IF
+         name_phi= "phi_lev"//TRIM(nvar)
+         CALL xios_add_child(philev_hdl, child, "phi_lev"//TRIM(nvar)) 
+         CALL xios_set_attr(child, name=trim(name_phi))
+      ENDDO
+
+
+    END SUBROUTINE wxios_add_group_init
+
+    SUBROUTINE wxios_set_context()
+        IMPLICIT NONE
+        TYPE(xios_context) :: xios_ctx
+
+       !$OMP MASTER
+        CALL xios_get_handle(g_ctx_name, xios_ctx)    !Récupération
+        CALL xios_set_current_context(xios_ctx)            !Activation
+       !$OMP END MASTER
+
+    END SUBROUTINE wxios_set_context
+
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Routine de paramétrisation !!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+    SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure, ini_an, ini_mois, ini_jour, ini_heure)
+        USE lmdz_print_control, ONLY: prt_level, lunout
+        USE lmdz_abort_physic, ONLY: abort_physic
+        IMPLICIT NONE
+
+     !Paramètres:
+     CHARACTER(len=*), INTENT(IN) :: calendrier
+     INTEGER, INTENT(IN) :: annee, mois, jour, ini_an, ini_mois, ini_jour
+     REAL, INTENT(IN) :: pasdetemps, heure, ini_heure
+     
+     !Variables:
+     CHARACTER(len=80) :: abort_message
+     CHARACTER(len=19) :: date
+     INTEGER :: njour = 1
+     
+     !Variables pour xios:
+     TYPE(xios_duration) :: mdtime
+     !REAL(kind = 8) :: year=0, month=0, day=0, hour=0, minute=0, second=0
+     
+        mdtime%second=pasdetemps
+
+        !Réglage du calendrier:
+        SELECT CASE (calendrier)
+            CASE('earth_360d')
+                CALL xios_define_calendar("D360")
+                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 360 jours/an'
+            CASE('earth_365d')
+                CALL xios_define_calendar("NoLeap")
+                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 365 jours/an'
+            CASE('gregorian')
+                CALL xios_define_calendar("Gregorian")
+                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier gregorien'
+            CASE DEFAULT
+                abort_message = 'wxios_set_cal: Mauvais choix de calendrier'
+                CALL abort_physic('Gcm:Xios',abort_message,1)
+        END SELECT
+        
+        !Formatage de la date d'origine:
+        WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") annee, mois, jour, int(heure) 
+        
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Time origin: ", date
+        CALL xios_set_time_origin(xios_date(annee,mois,jour,int(heure),0,0))
+
+        !Formatage de la date de debut:
+
+        WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") ini_an, ini_mois, ini_jour, int(ini_heure)
+        
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Start date: ", date
+        
+        CALL xios_set_start_date(xios_date(ini_an,ini_mois,ini_jour,int(ini_heure),0,0))
+        
+        !Et enfin,le pas de temps:
+        CALL xios_set_timestep(mdtime)
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: ts=",mdtime
+    END SUBROUTINE wxios_set_cal
+
+    SUBROUTINE wxios_set_timestep(ts)
+        REAL, INTENT(IN) :: ts
+        TYPE(xios_duration) :: mdtime     
+
+        mdtime%timestep = ts
+
+        CALL xios_set_timestep(mdtime)
+    END SUBROUTINE wxios_set_timestep
+
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    SUBROUTINE wxios_domain_param(dom_id)
+       USE dimphy, ONLY: klon
+       USE lmdz_phys_transfert_para, ONLY: gather, bcast
+       USE lmdz_phys_para, ONLY: jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
+                                     mpi_size, mpi_rank, klon_mpi, &
+                                     is_sequential, is_south_pole_dyn
+       USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, klon_glo
+       USE lmdz_print_control, ONLY: prt_level, lunout
+       USE lmdz_geometry
+
+       IMPLICIT NONE
+        CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
+
+        REAL   :: rlat_glo(klon_glo)
+        REAL   :: rlon_glo(klon_glo)
+        REAL   :: io_lat(nbp_lat)
+        REAL   :: io_lon(nbp_lon)
+        LOGICAL :: mask(nbp_lon,jj_nb) !Masque pour les problèmes de recouvrement MPI
+        TYPE(xios_domain) :: dom
+        INTEGER :: i
+        LOGICAL :: boool
+        
+
+
+        CALL gather(latitude_deg,rlat_glo) 
+        CALL bcast(rlat_glo)
+        CALL gather(longitude_deg,rlon_glo)
+        CALL bcast(rlon_glo)
+    
+  !$OMP MASTER  
+        io_lat(1)=rlat_glo(1)
+        io_lat(nbp_lat)=rlat_glo(klon_glo)
+        IF ((nbp_lon*nbp_lat) > 1) THEN
+          DO i=2,nbp_lat-1
+            io_lat(i)=rlat_glo(2+(i-2)*nbp_lon)
+          ENDDO
+        ENDIF
+
+        IF (klon_glo == 1) THEN
+          io_lon(1)=rlon_glo(1)
+        ELSE 
+          io_lon(1:nbp_lon)=rlon_glo(2:nbp_lon+1)
+        ENDIF
+
+        
+        !On récupère le handle:
+        CALL xios_get_handle(dom_id, dom)
+        
+        !On parametrise le domaine:
+        CALL xios_set_attr(dom, ni_glo=nbp_lon, ibegin=0, ni=nbp_lon, type="rectilinear")
+        CALL xios_set_attr(dom, nj_glo=nbp_lat, jbegin=jj_begin-1, nj=jj_nb, data_dim=2)
+        CALL xios_set_attr(dom, lonvalue_1d=io_lon(1:nbp_lon), latvalue_1d=io_lat(jj_begin:jj_end))
+        CALL xios_set_domain_attr("dom_out", domain_ref=dom_id)
+
+        !On definit un axe de latitudes pour les moyennes zonales
+        IF (xios_is_valid_axis("axis_lat")) THEN
+           CALL xios_set_axis_attr( "axis_lat", n_glo=nbp_lat, n=jj_nb, begin=jj_begin-1, value=io_lat(jj_begin:jj_end))
+        ENDIF
+        IF (xios_is_valid_axis("axis_lat_greordered")) THEN
+           CALL xios_set_axis_attr( "axis_lat_greordered", n_glo=nbp_lat, n=jj_nb, begin=jj_begin-1, &
+                                    value=io_lat(jj_begin:jj_end)*(-1.))
+        ENDIF
+
+        IF (.NOT.is_sequential) THEN
+            mask(:,:)=.TRUE.
+            IF (ii_begin>1) mask(1:ii_begin-1,1) = .FALSE.
+            IF (ii_end<nbp_lon) mask(ii_end+1:nbp_lon,jj_nb) = .FALSE.
+            ! special case for south pole
+            IF ((ii_end==1).AND.(is_south_pole_dyn)) mask(1:nbp_lon,jj_nb)=.TRUE.
+            IF (prt_level >= 10) THEN
+              WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1)
+              WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,jj_nb)=",mask(:,jj_nb)
+            ENDIF
+            CALL xios_set_attr(dom, mask_2d=mask)
+        END IF
+
+         CALL xios_is_defined_attr(dom,ni_glo=boool)
+        !Vérification:
+        IF (xios_is_valid_domain(dom_id)) THEN
+            IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Domain initialized: ", trim(dom_id), boool
+        ELSE
+            IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id)
+        END IF
+!$OMP END MASTER
+        
+    END SUBROUTINE wxios_domain_param
+    
+
+    SUBROUTINE wxios_domain_param_unstructured(dom_id)
+        USE lmdz_geometry, ONLY: longitude, latitude, boundslon, boundslat,ind_cell_glo
+        USE lmdz_grid_phy, ONLY: nvertex, klon_glo
+        USE lmdz_phys_para
+        USE lmdz_physical_constants, ONLY: PI
+        USE lmdz_ioipsl_getin_p, ONLY: getin_p
+        IMPLICIT NONE
+        CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
+        REAL :: lon_mpi(klon_mpi)
+        REAL :: lat_mpi(klon_mpi)
+        REAL :: boundslon_mpi(klon_mpi,nvertex)
+        REAL :: boundslat_mpi(klon_mpi,nvertex)
+        INTEGER :: ind_cell_glo_mpi(klon_mpi)
+        TYPE(xios_domain) :: dom
+        
+        LOGICAL :: remap_output
+
+        CALL gather_omp(longitude*180/PI,lon_mpi)
+        CALL gather_omp(latitude*180/PI,lat_mpi)
+        CALL gather_omp(boundslon*180/PI,boundslon_mpi)
+        CALL gather_omp(boundslat*180/PI,boundslat_mpi)
+        CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi)
+        
+        remap_output=.TRUE.
+        CALL getin_p("remap_output",remap_output)
+
+!$OMP MASTER
+        CALL xios_get_handle(dom_id, dom)
+        
+        !On parametrise le domaine:
+        CALL xios_set_attr(dom, ni_glo=klon_glo, ibegin=ij_begin-1, ni=ij_nb, type="unstructured")
+        CALL xios_set_attr(dom, nvertex=nvertex, lonvalue_1d=lon_mpi, latvalue_1d=lat_mpi, &
+                           bounds_lon_1d=TRANSPOSE(boundslon_mpi), bounds_lat_1d=TRANSPOSE(boundslat_mpi) )
+        CALL xios_set_attr(dom, i_index=ind_cell_glo_mpi(:)-1)
+        IF (remap_output) THEN
+          CALL xios_set_domain_attr("dom_out", domain_ref="dom_regular")
+          CALL xios_set_fieldgroup_attr("remap_expr", expr="@this_ref")
+          CALL xios_set_fieldgroup_attr("remap_1800s", freq_op=xios_duration_convert_from_string("1800s"))
+          CALL xios_set_fieldgroup_attr("remap_1h",    freq_op=xios_duration_convert_from_string("1h"))
+          CALL xios_set_fieldgroup_attr("remap_3h",    freq_op=xios_duration_convert_from_string("3h"))
+          CALL xios_set_fieldgroup_attr("remap_6h",    freq_op=xios_duration_convert_from_string("6h"))
+          CALL xios_set_fieldgroup_attr("remap_1d",    freq_op=xios_duration_convert_from_string("1d"))
+          CALL xios_set_fieldgroup_attr("remap_1mo",   freq_op=xios_duration_convert_from_string("1mo"))
+        ENDIF
+!$OMP END MASTER
+
+    END SUBROUTINE wxios_domain_param_unstructured
+
+
+
+
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Pour déclarer un axe vertical !!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    SUBROUTINE wxios_add_vaxis(axis_id, axis_size, axis_value,     &
+                               positif, bnds)
+        USE lmdz_print_control, ONLY: prt_level, lunout
+        IMPLICIT NONE
+
+        CHARACTER (len=*), INTENT(IN) :: axis_id
+        INTEGER, INTENT(IN) :: axis_size
+        REAL, DIMENSION(axis_size), INTENT(IN) :: axis_value
+        CHARACTER (len=*), INTENT(IN), OPTIONAL :: positif
+        REAL, DIMENSION(axis_size, 2), INTENT(IN), OPTIONAL :: bnds
+        
+!        TYPE(xios_axisgroup) :: axgroup
+!        TYPE(xios_axis) :: ax
+!        CHARACTER(len=50) :: axis_id 
+        
+!        IF (len_trim(axisgroup_id).gt.len(axis_id)) THEN
+!          WRITE(lunout,*) "wxios_add_vaxis: error, size of axis_id too small!!"
+!          WRITE(lunout,*) "     increase it to at least ",len_trim(axisgroup_id)
+!          CALL abort_gcm("wxios_add_vaxis","len(axis_id) too small",1)
+!        ENDIF
+!        axis_id=trim(axisgroup_id)
+        
+        !On récupère le groupe d'axes qui va bien:
+        !CALL xios_get_axisgroup_handle(axisgroup_id, axgroup)
+        
+        !On ajoute l'axe correspondant à ce fichier:
+        !CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id)))
+        
+        !Et on le parametrise:
+        !CALL xios_set_axis_attr_hdl(ax, size=axis_size, value=axis_value)
+        
+        ! Ehouarn: New way to declare axis, without axis_group:
+        IF (PRESENT(positif) .AND. PRESENT(bnds)) THEN
+          CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
+                                  positive=positif, bounds=bnds)
+        ELSE IF (PRESENT(positif)) THEN
+          CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
+                                  positive=positif)
+        ELSE IF (PRESENT(bnds)) THEN
+          CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
+                                  bounds=bnds)
+        else
+          CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value)
+        endif
+
+        !Vérification:
+        IF (xios_is_valid_axis(TRIM(ADJUSTL(axis_id)))) THEN
+            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id))
+        ELSE
+            WRITE(lunout,*) "wxios_add_vaxis: Invalid axis: ", TRIM(ADJUSTL(axis_id))
+        END IF
+
+    END SUBROUTINE wxios_add_vaxis
+    
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Pour déclarer un fichier  !!!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    SUBROUTINE wxios_add_file(fname, ffreq, flvl)
+        USE lmdz_print_control, ONLY: prt_level, lunout
+        IMPLICIT NONE
+
+        CHARACTER(len=*), INTENT(IN) :: fname
+        CHARACTER(len=*), INTENT(IN) :: ffreq
+        INTEGER, INTENT(IN) :: flvl
+        
+        TYPE(xios_file) :: x_file
+        TYPE(xios_filegroup) :: x_fg
+        TYPE(xios_duration) :: nffreq
+        
+        !On regarde si le fichier n'est pas défini par XML:
+        IF (.NOT.xios_is_valid_file(fname)) THEN
+            !On créé le noeud:
+            CALL xios_get_handle("defile", x_fg)
+            CALL xios_add_child(x_fg, x_file, fname)
+        
+            !On reformate la fréquence:
+            CALL reformadate(ffreq, nffreq)
+        
+            !On configure:
+            CALL xios_set_attr(x_file, name="X"//fname,&
+                output_freq=nffreq, output_level=flvl, enabled=.TRUE.)
+       
+            IF (xios_is_valid_file("X"//fname)) THEN
+                IF (prt_level >= 10) THEN
+                  WRITE(lunout,*) "wxios_add_file: New file: ", "X"//fname
+                  WRITE(lunout,*) "wxios_add_file: output_freq=",nffreq,"; output_lvl=",flvl
+                ENDIF
+            ELSE
+                WRITE(lunout,*) "wxios_add_file: Error, invalid file: ", "X"//trim(fname)
+                WRITE(lunout,*) "wxios_add_file: output_freq=",nffreq,"; output_lvl=",flvl
+            END IF
+        ELSE
+            IF (prt_level >= 10) THEN
+              WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
+            ENDIF
+            ! Ehouarn: add an enable=.TRUE. on top of xml definitions... why???
+            CALL xios_set_file_attr(fname, enabled=.TRUE.)
+        END IF
+    END SUBROUTINE wxios_add_file
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Pour créer un champ      !!!!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
+        USE netcdf, ONLY: nf90_fill_real
+
+        IMPLICIT NONE
+        INCLUDE 'iniprint.h'
+        
+        CHARACTER(len=*), INTENT(IN) :: fieldname
+        TYPE(xios_fieldgroup), INTENT(IN) :: fieldgroup
+        CHARACTER(len=*), INTENT(IN) :: fieldlongname
+        CHARACTER(len=*), INTENT(IN) :: fieldunit
+        
+        TYPE(xios_field) :: field
+        CHARACTER(len=10) :: newunit
+        REAL(KIND=8) :: def
+        
+        !La valeur par défaut des champs non définis:
+        def = nf90_fill_real
+        
+        IF (fieldunit == " ") THEN
+            newunit = "-"
+        ELSE
+            newunit = fieldunit
+        ENDIF
+        
+        !On ajoute le champ:
+        CALL xios_add_child(fieldgroup, field, fieldname)
+        !IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit
+        
+        !On rentre ses paramètres:
+        CALL xios_set_attr(field, standard_name=fieldlongname, unit=newunit, default_value=def)
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: Field ",trim(fieldname), "cree:"
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: long_name=",trim(fieldlongname),"; unit=",trim(newunit),";  default_value=",nf90_fill_real
+
+    END SUBROUTINE wxios_add_field
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Pour déclarer un champ      !!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op, nam_axvert)
+        USE lmdz_print_control, ONLY: prt_level, lunout
+        IMPLICIT NONE
+
+        CHARACTER(len=*), INTENT(IN) :: fieldname
+        INTEGER, INTENT(IN)          :: fdim, fid
+        CHARACTER(len=*), INTENT(IN) :: fname
+        CHARACTER(len=*), INTENT(IN) :: fieldlongname
+        CHARACTER(len=*), INTENT(IN) :: fieldunit
+        INTEGER, INTENT(IN)          :: field_level
+        CHARACTER(len=*), INTENT(IN) :: op
+        
+        CHARACTER(len=20) :: axis_id ! Ehouarn: dangerous...
+        CHARACTER(len=20), INTENT(IN), OPTIONAL :: nam_axvert
+        CHARACTER(len=100) :: operation
+        TYPE(xios_file) :: f
+        TYPE(xios_field) :: field
+        TYPE(xios_fieldgroup) :: fieldgroup
+        TYPE(xios_duration) :: freq_op
+
+        LOGICAL :: bool=.FALSE.
+        INTEGER :: lvl =0
+        
+        
+        ! Ajout Abd pour NMC:
+        IF (fid<=6) THEN
+          axis_id="presnivs"
+        ELSE
+          axis_id="plev"
+        ENDIF
+ 
+        IF (PRESENT(nam_axvert)) THEN
+           axis_id=nam_axvert
+           PRINT*,'nam_axvert=',axis_id
+        ENDIF
+        
+        !on prépare le nom de l'opération:
+        operation = reformaop(op)
+        
+        
+        !On selectionne le bon groupe de champs:
+        IF (fdim==2) THEN
+          CALL xios_get_handle("fields_2D", fieldgroup)
+        ELSE
+          CALL xios_get_handle("fields_3D", fieldgroup)
+        ENDIF
+        
+        !On regarde si le champ à déjà été créé ou non:
+        IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN
+            !Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire
+            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
+            g_flag_xml = .TRUE.
+            g_field_name = fieldname
+
+        ELSE IF (.NOT. g_field_name == fieldname) THEN
+            !Si premier pssage et champ indéfini, alors on le créé
+
+            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
+            
+            !On le créé:
+            CALL wxios_add_field(fieldname,  fieldgroup, fieldlongname, fieldunit)
+            IF (xios_is_valid_field(fieldname)) THEN
+                IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "created"
+            ENDIF
+
+            g_flag_xml = .FALSE.
+            g_field_name = fieldname
+
+        END IF
+
+        IF (.NOT. g_flag_xml) THEN
+            !Champ existe déjà, mais pas XML, alors on l'ajoute
+            !On ajoute le champ:
+            CALL xios_get_handle(fname, f)
+            CALL xios_add_child(f, field)
+            
+            
+            !L'operation, sa frequence:
+            freq_op%timestep=1
+            CALL xios_set_attr(field, field_ref=fieldname, operation=TRIM(ADJUSTL(operation)), freq_op=freq_op, prec=4)
+
+            
+            !On rentre ses paramètres:
+            CALL xios_set_attr(field, level=field_level, enabled=.TRUE.)
+            
+            IF (fdim==2) THEN
+                !Si c'est un champ 2D:
+                IF (prt_level >= 10) THEN
+                  WRITE(lunout,*) "wxios_add_field_to_file: 2D Field ", trim(fieldname), " in ", "X"//trim(fname) ," configured with:"
+                  WRITE(lunout,*) "wxios_add_field_to_file: op=", TRIM(ADJUSTL(operation))
+                  WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
+                ENDIF
+            ELSE
+                !Si 3D :
+                !On ajoute l'axe vertical qui va bien:
+                CALL xios_set_attr(field, axis_ref=TRIM(ADJUSTL(axis_id)))
+                
+                IF (prt_level >= 10) THEN
+                  WRITE(lunout,*) "wxios_add_field_to_file: 3D Field",trim(fieldname), " in ", "X"//trim(fname), "configured with:"
+                  WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
+                  WRITE(lunout,*) "wxios_add_field_to_file: axis=",TRIM(ADJUSTL(axis_id))
+                ENDIF
+            END IF
+        
+        ELSE
+            !Sinon on se contente de l'activer:
+            CALL xios_set_field_attr(fieldname, enabled=.TRUE.)
+            !NB: This will override an enable=.FALSE. set by a user in the xml file;
+            !   then the only way to not output the field is by changing its
+            !   output level
+        ENDIF       
+        
+    END SUBROUTINE wxios_add_field_to_file
+    
+!    SUBROUTINE wxios_update_calendar(ito)
+!        INTEGER, INTENT(IN) :: ito
+!        CALL xios_update_calendar(ito)
+!    END SUBROUTINE wxios_update_calendar
+
+!    SUBROUTINE wxios_write_2D(fieldname, fdata)
+!        CHARACTER(len=*), INTENT(IN) :: fieldname
+!        REAL, DIMENSION(:,:), INTENT(IN) :: fdata
+
+!        CALL xios_send_field(fieldname, fdata)
+!    END SUBROUTINE wxios_write_2D
+    
+!    SUBROUTINE wxios_write_3D(fieldname, fdata)
+!        CHARACTER(len=*), INTENT(IN) :: fieldname
+!        REAL, DIMENSION(:,:,:), INTENT(IN) :: fdata
+
+!        CALL xios_send_field(fieldname, fdata)
+!    END SUBROUTINE wxios_write_3D
+    
+    SUBROUTINE wxios_closedef()
+        CALL xios_close_context_definition()
+!        CALL xios_update_calendar(0)
+    END SUBROUTINE wxios_closedef
+    
+    SUBROUTINE wxios_close()
+        CALL xios_context_finalize()
+         CALL xios_finalize()
+     END SUBROUTINE wxios_close
+END MODULE lmdz_wxios
+
Index: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_xer.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/lmdz_xer.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/misc/lmdz_xer.f90	(revision 5117)
@@ -191,5 +191,5 @@
     !   891214  Prologue converted to Version 4.0 format.  (WRB)
     !   900510  Changed test on NERR to be -9999999 < NERR < 99999999, but
-    !       NERR .ne. 0, and on LEVEL to be -2 < LEVEL < 3.  Added
+    !       NERR .NE. 0, and on LEVEL to be -2 < LEVEL < 3.  Added
     !       LEVEL=-1 logic, changed calls to XERSAV to XERSVE, and
     !       XERCTL to XERCNT.  (RWC)
@@ -734,5 +734,5 @@
     !
     ! This routine sends one or more lines to each of the (up to five)
-    ! logical units to which error messages are to be sent.  This routine
+    ! LOGICAL units to which error messages are to be sent.  This routine
     ! is called several times by XERMSG, sometimes with a single line to
     ! print and sometimes with a (potentially very long) message that may
Index: LMDZ6/branches/Amaury_dev/libf/misc/new_unit_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/new_unit_m.F90	(revision 5116)
+++ 	(revision )
@@ -1,25 +1,0 @@
-module new_unit_m
-
-  IMPLICIT NONE
-
-contains
-
-  SUBROUTINE new_unit(unit)
-
-    integer, intent(out):: unit
-
-    ! Variables local to the procedure:
-    logical opened, exist
-
-    !------------------------------------------------------
-
-    unit = 0
-    do
-       inquire(unit=unit, opened=opened, exist=exist)
-       if (exist .and. .not. opened) exit
-       unit = unit + 1
-    END DO
-
-  END SUBROUTINE  new_unit
-
-end module new_unit_m
Index: LMDZ6/branches/Amaury_dev/libf/misc/nrtype.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/nrtype.F90	(revision 5116)
+++ 	(revision )
@@ -1,22 +1,0 @@
-MODULE nrtype
-
-  IMPLICIT NONE
-
-  integer, parameter:: k8 = selected_real_kind(13)
-
-  ! Frequently used mathematical constants (with precision to spare):
-
-  REAL, PARAMETER :: PI=3.141592653589793238462643383279502884197
-  REAL, PARAMETER :: PIO2=1.57079632679489661923132169163975144209858
-  REAL, PARAMETER :: TWOPI=6.283185307179586476925286766559005768394
-  REAL, PARAMETER :: SQRT2=1.41421356237309504880168872420969807856967
-  REAL, PARAMETER :: EULER=0.5772156649015328606065120900824024310422
-
-  REAL(K8), PARAMETER:: &
-       PI_D = 3.141592653589793238462643383279502884197_k8
-  REAL(K8), PARAMETER:: &
-       PIO2_D=1.57079632679489661923132169163975144209858_k8
-  REAL(K8), PARAMETER:: &
-       TWOPI_D=6.283185307179586476925286766559005768394_k8
-
-END MODULE nrtype
Index: LMDZ6/branches/Amaury_dev/libf/misc/pres2lev_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/pres2lev_mod.F90	(revision 5116)
+++ 	(revision )
@@ -1,79 +1,0 @@
-! $Id: pres2lev.F 1179 2009-06-11 14:18:47Z jghattas $
-
-MODULE pres2lev_mod
-
-CONTAINS 
-
-!******************************************************
-SUBROUTINE pres2lev(varo,varn,lmo,lmn,po,pn,ni,nj,ok_invertp)
-
-! interpolation lineaire pour passer
-! a une nouvelle discretisation verticale pour
-! les variables de GCM
-! Francois Forget (01/1995)
-! MOdif remy roca 12/97 pour passer de pres2sig
-! Modif F.Codron 07/08 po en 3D
-!**********************************************************
-
-  IMPLICIT NONE
-
-!   Declarations:
-! ==============
-
-!  ARGUMENTS
-!  """""""""
-  LOGICAL, INTENT(IN) :: ok_invertp
-  INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches
-  INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
-  
-  INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontal
-  REAL, INTENT(IN) :: po(ni*nj,lmo) ! niveau de pression ancienne grille
-  REAL, INTENT(IN) :: pn(ni*nj,lmn) ! niveau de pression nouvelle grille
-
-  REAL, INTENT(IN)  :: varo(ni*nj,lmo) ! var dans l'ancienne grille
-  REAL, INTENT(OUT) :: varn(ni*nj,lmn) ! var dans la nouvelle grille
-
-  REAL :: zvaro(ni*nj,lmo),zpo(ni*nj,lmo)
-
-! Autres variables
-! """"""""""""""""
-  INTEGER ::  ln ,lo, k
-  REAL    :: coef
-
-
-! Inversion de l'ordre des niveaux verticaux
-  IF (ok_invertp) THEN
-    DO lo=1,lmo
-      DO k=1,ni*nj
-        zpo(k,lo)=po(k,lmo+1-lo)
-        zvaro(k,lo)=varo(k,lmo+1-lo)
-      ENDDO
-    ENDDO
-  ELSE
-    DO lo=1,lmo
-      DO k=1,ni*nj
-        zpo(k,lo)=po(k,lo)
-        zvaro(k,lo)=varo(k,lo)
-      ENDDO
-    ENDDO
-  ENDIF 
-
-  DO ln=1,lmn
-    DO lo=1,lmo-1
-      DO k=1,ni*nj
-        IF (pn(k,ln) >= zpo(k,1) ) THEN
-          varn(k,ln) = zvaro(k,1)
-        ELSE IF (pn(k,ln) <= zpo(k,lmo)) THEN
-          varn(k,ln) = zvaro(k,lmo)
-        ELSE IF ( pn(k,ln) <= zpo(k,lo) .AND. pn(k,ln) > zpo(k,lo+1) ) THEN
-          coef = (pn(k,ln)-zpo(k,lo)) / (zpo(k,lo+1)-zpo(k,lo))
-          varn(k,ln) = zvaro(k,lo) + coef*(zvaro(k,lo+1)-zvaro(k,lo))
-        ENDIF
-         
-      ENDDO  
-    ENDDO
-  ENDDO                
-
-END SUBROUTINE pres2lev    
-
-END MODULE pres2lev_mod
Index: LMDZ6/branches/Amaury_dev/libf/misc/q_sat.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/q_sat.f90	(revision 5116)
+++ 	(revision )
@@ -1,70 +1,0 @@
-
-! $Header$
-
-
-
-SUBROUTINE q_sat(np,temp,pres,qsat)
-
-  IMPLICIT none
-  !======================================================================
-  ! Autheur(s): Z.X. Li (LMD/CNRS)
-  !  reecriture vectorisee par F. Hourdin.
-  ! Objet: calculer la vapeur d'eau saturante (formule Centre Euro.)
-  !======================================================================
-  ! Arguments:
-  ! kelvin---input-R: temperature en Kelvin
-  ! millibar--input-R: pression en mb
-
-  ! q_sat----output-R: vapeur d'eau saturante en kg/kg
-  !======================================================================
-
-  INTEGER :: np
-  REAL :: temp(np),pres(np),qsat(np)
-
-  REAL :: r2es
-  PARAMETER (r2es=611.14 *18.0153/28.9644)
-
-  REAL :: r3les, r3ies, r3es
-  PARAMETER (R3LES=17.269)
-  PARAMETER (R3IES=21.875)
-
-  REAL :: r4les, r4ies, r4es
-  PARAMETER (R4LES=35.86)
-  PARAMETER (R4IES=7.66)
-
-  REAL :: rtt
-  PARAMETER (rtt=273.16)
-
-  REAL :: retv
-  PARAMETER (retv=28.9644/18.0153 - 1.0)
-
-  REAL :: zqsat
-  INTEGER :: ip
-
-  ! ------------------------------------------------------------------
-
-
-  do ip=1,np
-
-   ! WRITE(*,*)'kelvin,millibar=',kelvin,millibar
-   !  WRITE(*,*)'temp,pres=',temp(ip),pres(ip)
-
-     IF (temp(ip) <= rtt) THEN
-        r3es = r3ies
-        r4es = r4ies
-     ELSE
-        r3es = r3les
-        r4es = r4les
-     ENDIF
-
-     zqsat=r2es/pres(ip)*EXP(r3es*(temp(ip)-rtt)/(temp(ip)-r4es))
-     zqsat=MIN(0.5,ZQSAT)
-     zqsat=zqsat/(1.-retv *zqsat)
-
-     qsat(ip)= zqsat
-   ! WRITE(*,*)'qsat=',qsat(ip)
-
-  enddo
-
-
-END SUBROUTINE q_sat
Index: LMDZ6/branches/Amaury_dev/libf/misc/ran1.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/ran1.f90	(revision 5116)
+++ 	(revision )
@@ -1,38 +1,0 @@
-
-! $Id$
-
-FUNCTION RAN1(IDUM)
-  IMPLICIT NONE
-  REAL :: RAN1
-  REAL,SAVE :: R(97)
-  REAL,PARAMETER :: RM1=3.8580247E-6,RM2=7.4373773E-6
-  INTEGER,SAVE :: IFF=0
-  integer,save :: ix1,ix2,ix3
-  INTEGER,PARAMETER :: M1=259200,IA1=7141,IC1=54773
-  INTEGER,PARAMETER :: M2=134456,IA2=8121,IC2=28411
-  INTEGER,PARAMETER :: M3=243000,IA3=4561,IC3=51349
-  INTEGER :: IDUM,J
-
-  IF (IDUM<0.OR.IFF==0) THEN
-    IFF=1
-    IX1=MOD(IC1-IDUM,M1)
-    IX1=MOD(IA1*IX1+IC1,M1)
-    IX2=MOD(IX1,M2)
-    IX1=MOD(IA1*IX1+IC1,M1)
-    IX3=MOD(IX1,M3)
-    DO J=1,97
-      IX1=MOD(IA1*IX1+IC1,M1)
-      IX2=MOD(IA2*IX2+IC2,M2)
-      R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1
-  END DO
-    IDUM=1
-  ENDIF
-  IX1=MOD(IA1*IX1+IC1,M1)
-  IX2=MOD(IA2*IX2+IC2,M2)
-  IX3=MOD(IA3*IX3+IC3,M3)
-  J=1+(97*IX3)/M3
-  IF(J>97.OR.J<1) stop 1
-  RAN1=R(J)
-  R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1
-
-END FUNCTION RAN1
Index: LMDZ6/branches/Amaury_dev/libf/misc/readTracFiles_mod.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/readTracFiles_mod.f90	(revision 5116)
+++ 	(revision )
@@ -1,2761 +1,0 @@
-MODULE readTracFiles_mod
-
-  USE strings_mod,    ONLY: msg, find, get_in, dispTable, strHead,  strReduce,  strFind, strStack, strIdx, &
-             removeComment, cat, fmsg, maxlen, checkList, strParse, strReplace, strTail, strCount, reduceExpr, &
-             int2str, str2int, real2str, str2real, bool2str, str2bool
-
-  IMPLICIT NONE
-
-  PRIVATE
-
-  PUBLIC :: maxlen                                              !--- PARAMETER FOR CASUAL STRING LENGTH
-  PUBLIC :: trac_type, tracers, setGeneration, indexUpdate      !--- TRACERS  DESCRIPTION DATABASE + ASSOCIATED TOOLS
-  PUBLIC :: testTracersFiles, readTracersFiles                  !--- TRACERS FILES READING ROUTINES
-  PUBLIC :: getKeysDBase, setKeysDBase                          !--- TOOLS TO GET/SET THE DATABASE (tracers & isotopes)
-  PUBLIC :: addTracer, delTracer                                !--- ADD/REMOVE A TRACER FROM
-  PUBLIC :: addKey,    delKey,    getKey,    keys_type          !--- TOOLS TO SET/DEL/GET KEYS FROM/TO  tracers & isotopes
-  PUBLIC :: addPhase,  delPhase,  getPhase,  getiPhase,  &      !--- FUNCTIONS RELATED TO THE PHASES
-   nphases, old_phases, phases_sep, known_phases, phases_names  !--- + ASSOCIATED VARIABLES
-
-  PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O        !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def)
-  PUBLIC :: oldHNO3,   newHNO3                                  !--- HNO3 REPRO   BACKWARD COMPATIBILITY (OLD start.nc)
-
-  PUBLIC :: tran0                                               !--- TRANSPORTING FLUID (USUALLY air)
-
-  !=== FOR ISOTOPES: GENERAL
-  PUBLIC :: isot_type, processIsotopes, isoSelect, ixIso, nbIso !--- PROCESS [AND READ] & SELECT ISOTOPES + CLASS IDX & NUMBER
-
-  !=== FOR ISOTOPES: H2O FAMILY ONLY
-  PUBLIC :: iH2O
-
-  !=== FOR ISOTOPES: DEPENDING ON THE SELECTED ISOTOPES CLASS
-  PUBLIC :: isotope, isoKeys                                    !--- SELECTED ISOTOPES DATABASE + ASSOCIATED KEYS
-  PUBLIC :: isoName, isoZone, isoPhas                           !--- ISOTOPES AND TAGGING ZONES NAMES AND PHASES
-  PUBLIC :: niso,    nzone,   nphas,   ntiso                    !---  " " NUMBERS + ISOTOPES AND TAGGING TRACERS NUMBERS
-  PUBLIC :: itZonIso                                            !--- Idx IN isoName(1:niso) = f(tagging idx, isotope idx)
-  PUBLIC :: iqIsoPha                                            !--- Idx IN qx(1:nqtot)     = f(isotope idx,   phase idx)
-  PUBLIC :: iqWIsoPha                                           !--- Idx IN qx(1:nqtot)     = f(isotope idx,   phase idx) but with normal water first
-  PUBLIC :: isoCheck                                            !--- FLAG TO RUN ISOTOPES CHECKING ROUTINES
-
-  PUBLIC :: maxTableWidth
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE :: keys_type                                             !=== TYPE FOR A SET OF KEYS ASSOCIATED TO AN ELEMENT
-    CHARACTER(LEN=maxlen)              :: name                  !--- Tracer name
-    CHARACTER(LEN=maxlen), ALLOCATABLE :: key(:)                !--- Keys string list
-    CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)                !--- Corresponding values string list
-  END TYPE keys_type
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE :: trac_type                                             !=== TYPE FOR A SINGLE TRACER NAMED "name"
-    CHARACTER(LEN=maxlen) :: name        = ''                   !--- Name of the tracer
-    TYPE(keys_type)       :: keys                               !--- <key>=<val> pairs vector
-    CHARACTER(LEN=maxlen) :: gen0Name    = ''                   !--- First generation ancestor name
-    CHARACTER(LEN=maxlen) :: parent      = ''                   !--- Parent name
-    CHARACTER(LEN=maxlen) :: longName    = ''                   !--- Long name (with advection scheme suffix)
-    CHARACTER(LEN=maxlen) :: type        = 'tracer'             !--- Type  (so far: 'tracer' / 'tag')
-    CHARACTER(LEN=maxlen) :: phase       = 'g'                  !--- Phase ('g'as / 'l'iquid / 's'olid)
-    CHARACTER(LEN=maxlen) :: component   = ''                   !--- Coma-separated list of components (Ex: lmdz,inca)
-    INTEGER               :: iGeneration = -1                   !--- Generation number (>=0)
-    INTEGER               :: iqParent    = 0                    !--- Parent index
-    INTEGER,  ALLOCATABLE :: iqDescen(:)                        !--- Descendants index (in growing generation order)
-    INTEGER               :: nqDescen    = 0                    !--- Number of descendants (all generations)
-    INTEGER               :: nqChildren  = 0                    !--- Number of children  (first generation)
-    INTEGER               :: iadv        = 10                   !--- Advection scheme used
-    LOGICAL               :: isAdvected  = .FALSE.              !--- "true" tracers: iadv > 0.   COUNT(isAdvected )=nqtrue
-    LOGICAL               :: isInPhysics = .TRUE.               !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr
-    INTEGER               :: iso_iGroup  = 0                    !--- Isotopes group index in isotopes(:)
-    INTEGER               :: iso_iName   = 0                    !--- Isotope  name  index in isotopes(iso_iGroup)%trac(:)
-    INTEGER               :: iso_iZone   = 0                    !--- Isotope  zone  index in isotopes(iso_iGroup)%zone(:)
-    INTEGER               :: iso_iPhase  = 0                    !--- Isotope  phase index in isotopes(iso_iGroup)%phase
-  END TYPE trac_type
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE :: isot_type                                             !=== TYPE FOR AN ISOTOPES FAMILY DESCENDING ON TRACER "parent"
-    CHARACTER(LEN=maxlen)              :: parent                !--- Isotopes family name (parent tracer name ; ex: H2O)
-    TYPE(keys_type),       ALLOCATABLE :: keys(:)               !--- Isotopes keys/values pairs list     (length: niso)
-    LOGICAL                            :: check=.FALSE.         !--- Flag for checking routines triggering
-    CHARACTER(LEN=maxlen), ALLOCATABLE :: trac(:)               !--- Isotopes + tagging tracers list     (length: ntiso)
-    CHARACTER(LEN=maxlen), ALLOCATABLE :: zone(:)               !--- Geographic tagging zones names list (length: nzone)
-    CHARACTER(LEN=maxlen)              :: phase = 'g'           !--- Phases list: [g][l][s]              (length: nphas)
-    INTEGER                            :: niso  = 0             !--- Number of isotopes, excluding tagging tracers
-    INTEGER                            :: ntiso = 0             !--- Number of isotopes, including tagging tracers
-    INTEGER                            :: nzone = 0             !--- Number of geographic tagging zones
-    INTEGER                            :: nphas = 0             !--- Number of phases
-    INTEGER,               ALLOCATABLE :: iqIsoPha(:,:)         !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso),phas)
-                                                                !---        (former name: "iqiso"
-    INTEGER,               ALLOCATABLE :: iqWIsoPha(:,:)        !--- Idx in "tracers(1:nqtot)" = f([H2O,name(1:ntiso)],phas)
-    INTEGER,               ALLOCATABLE :: itZonIso(:,:)         !--- Idx in "trac(1:ntiso)" = f(zone, name(1:niso))
-  END TYPE isot_type                                            !---        (former name: "index_trac")
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE :: dataBase_type                                         !=== TYPE FOR TRACERS SECTION
-    CHARACTER(LEN=maxlen) :: name                               !--- Section name
-    TYPE(trac_type), ALLOCATABLE :: trac(:)                     !--- Tracers descriptors
-  END TYPE dataBase_type
-!------------------------------------------------------------------------------------------------------------------------------
-  INTERFACE getKey
-    MODULE PROCEDURE &
-       getKeyByIndex_s111, getKeyByIndex_sm11, getKeyByIndex_s1m1, getKeyByIndex_smm1, getKeyByIndex_s1mm, getKeyByIndex_smmm, &
-       getKeyByIndex_i111, getKeyByIndex_im11, getKeyByIndex_i1m1, getKeyByIndex_imm1, getKeyByIndex_i1mm, getKeyByIndex_immm, &
-       getKeyByIndex_r111, getKeyByIndex_rm11, getKeyByIndex_r1m1, getKeyByIndex_rmm1, getKeyByIndex_r1mm, getKeyByIndex_rmmm, &
-       getKeyByIndex_l111, getKeyByIndex_lm11, getKeyByIndex_l1m1, getKeyByIndex_lmm1, getKeyByIndex_l1mm, getKeyByIndex_lmmm, &
-        getKeyByName_s111,  getKeyByName_sm11,  getKeyByName_s1m1,  getKeyByName_smm1,  getKeyByName_s1mm,  getKeyByName_smmm, &
-        getKeyByName_i111,  getKeyByName_im11,  getKeyByName_i1m1,  getKeyByName_imm1,  getKeyByName_i1mm,  getKeyByName_immm, &
-        getKeyByName_r111,  getKeyByName_rm11,  getKeyByName_r1m1,  getKeyByName_rmm1,  getKeyByName_r1mm,  getKeyByName_rmmm, &
-        getKeyByName_l111,  getKeyByName_lm11,  getKeyByName_l1m1,  getKeyByName_lmm1,  getKeyByName_l1mm,  getKeyByName_lmmm
-  END INTERFACE getKey
-!------------------------------------------------------------------------------------------------------------------------------
-  INTERFACE addKey
-    MODULE PROCEDURE addKey_s11, addKey_s1m, addKey_smm, addKey_i11, addKey_i1m, addKey_imm, &
-                     addKey_r11, addKey_r1m, addKey_rmm, addKey_l11, addKey_l1m, addKey_lmm
-  END INTERFACE addKey
-!------------------------------------------------------------------------------------------------------------------------------
-  INTERFACE     isoSelect; MODULE PROCEDURE  isoSelectByIndex,  isoSelectByName; END INTERFACE isoSelect
-  INTERFACE    old2newH2O; MODULE PROCEDURE  old2newH2O_1,  old2newH2O_m;        END INTERFACE old2newH2O
-  INTERFACE    new2oldH2O; MODULE PROCEDURE  new2oldH2O_1,  new2oldH2O_m;        END INTERFACE new2oldH2O
-  INTERFACE     addTracer; MODULE PROCEDURE   addTracer_1, addTracer_1def;       END INTERFACE addTracer
-  INTERFACE     delTracer; MODULE PROCEDURE   delTracer_1, delTracer_1def;       END INTERFACE delTracer
-  INTERFACE      addPhase; MODULE PROCEDURE   addPhase_s1,  addPhase_sm,  addPhase_i1,  addPhase_im; END INTERFACE addPhase
-  INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx,     trSubset_Name,     trSubset_gen0Name; END INTERFACE tracersSubset
-!------------------------------------------------------------------------------------------------------------------------------
-
-  !=== MAIN DATABASE: files sections descriptors
-  TYPE(dataBase_type), SAVE, ALLOCATABLE, TARGET :: dBase(:)
-
-  !--- SOME PARAMETERS THAT ARE NOT LIKELY TO CHANGE OFTEN
-  CHARACTER(LEN=maxlen), SAVE      :: tran0        = 'air'      !--- Default transporting fluid
-  CHARACTER(LEN=maxlen), PARAMETER :: old_phases   = 'vlirb'    !--- Old phases for water (no separator)
-  CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'glsrb'    !--- Known phases initials
-  INTEGER, PARAMETER :: nphases = LEN_TRIM(known_phases)        !--- Number of phases
-  CHARACTER(LEN=maxlen), SAVE      :: phases_names(nphases) &   !--- Known phases names
-                                = ['gaseous  ', 'liquid   ', 'solid    ', 'cloud    ','blownSnow']
-  CHARACTER(LEN=1),      SAVE :: phases_sep  =  '_'             !--- Phase separator
-  CHARACTER(LEN=maxlen), SAVE :: isoFile = 'isotopes_params.def'!--- Name of the isotopes parameters file
-
-  !--- CORRESPONDANCE BETWEEN OLD AND NEW WATER NAMES
-  CHARACTER(LEN=maxlen), SAVE :: oldH2OIso(5) = ['eau',   'HDO',   'O18',   'O17',   'HTO'  ]
-  CHARACTER(LEN=maxlen), SAVE :: newH2OIso(5) = ['H216O', 'HDO  ', 'H218O', 'H217O', 'HTO  ']
-
-  !--- CORRESPONDANCE BETWEEN OLD AND NEW HNO3 RELATED SPECIES NAMES (FOR REPROBUS)
-  CHARACTER(LEN=maxlen), SAVE ::   oldHNO3(2) = ['HNO3_g ', 'HNO3   ']
-  CHARACTER(LEN=maxlen), SAVE ::   newHNO3(2) = ['HNO3   ', 'HNO3tot']
-
-  !=== TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey
-  TYPE(trac_type), ALLOCATABLE, TARGET, SAVE ::  tracers(:)
-  TYPE(isot_type), ALLOCATABLE, TARGET, SAVE :: isotopes(:)
-
-  !=== ALIASES OF VARIABLES FROM SELECTED ISOTOPES FAMILY EMBEDDED IN "isotope" (isotopes(ixIso))
-  TYPE(isot_type),         SAVE, POINTER :: isotope             !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
-  INTEGER,                 SAVE          :: ixIso, iH2O=0       !--- Index of the selected isotopes family and H2O family
-  INTEGER,                 SAVE          :: nbIso               !--- Number of isotopes classes
-  LOGICAL,                 SAVE          :: isoCheck            !--- Flag to trigger the checking routines
-  TYPE(keys_type),         SAVE, POINTER :: isoKeys(:)          !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
-  CHARACTER(LEN=maxlen),   SAVE, POINTER :: isoName(:),   &     !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
-                                            isoZone(:),   &     !--- TAGGING ZONES  FOR THE CURRENTLY SELECTED FAMILY
-                                            isoPhas             !--- USED PHASES    FOR THE CURRENTLY SELECTED FAMILY
-  INTEGER,                 SAVE          ::  niso, nzone, &     !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
-                                            nphas, ntiso        !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
-  INTEGER,                 SAVE, POINTER ::itZonIso(:,:), &     !--- INDEX IN "isoTrac" AS f(tagging zone idx,  isotope idx)
-                                           iqIsoPha(:,:), &     !--- INDEX IN "qx" AS f(isotopic tracer idx, phase idx)
-                                           iqWIsoPha(:,:)       !--- INDEX IN "qx" AS f(H2O + isotopic tracer idx, phase idx)
-
-  !=== PARAMETERS FOR DEFAULT BEHAVIOUR
-  LOGICAL, PARAMETER :: lTracsMerge = .FALSE.                   !--- Merge/stack tracers lists
-  LOGICAL, PARAMETER :: lSortByGen  = .TRUE.                    !--- Sort by growing generation
-
-  INTEGER,    PARAMETER :: maxTableWidth = 192                  !--- Maximum width of a table displayed with "dispTable"
-  CHARACTER(LEN=maxlen) :: modname
-
-CONTAINS
-
-!==============================================================================================================================
-!==============================================================================================================================
-!=== READ ONE OR SEVERAL TRACER FILES AND FILL A "tr" TRACERS DESCRIPTOR DERIVED TYPE.
-!=== THE RETURNED VALUE fType DEPENDS ON WHAT IS FOUND:
-!===  0: NO ADEQUATE FILE FOUND ; DEFAULT VALUES MUST BE USED
-!===  1: AN "OLD STYLE" TRACERS FILE "traceur.def":
-!===    First line: <nb tracers>     Other lines: <hadv> <vadv> <tracer name> [<parent name>]
-!===  2: A  "NEW STYLE" TRACERS FILE  "tracer.def" WITH SEVERAL SECTIONS.
-!===  3: SEVERAL  "  "  TRACERS FILES "tracer_<component>.def" WITH A SINGLE SECTION IN EACH.
-!=== REMARKS:
-!===  * EACH SECTION BEGINS WITH A "&<section name> LINE
-!===  * DEFAULT VALUES FOR ALL THE SECTIONS OF THE FILE ARE DEFINED IN THE SPECIAL SECTION "&default"
-!===  * EACH SECTION LINE HAS THE STRUCTURE:  <name(s)>  <key1>=<value1> <key2>=<value2> ...
-!===  * SO FAR, THE DEFINED KEYS ARE: parent, phases, hadv, vadv, type
-!===  * <name> AND <parent> CAN BE LISTS OF COMA-SEPARATED TRACERS ; THE ROUTINE EXPAND THESE FACTORIZATIONS.
-!=== FUNCTION RETURN VALUE "lerr" IS FALSE IN CASE SOMETHING WENT WRONG.
-!=== ABOUT THE KEYS:
-!     * The "keys" component (of type keys_type) is in principle enough to store everything we could need.
-!     But some variables are stored as direct-access keys to make the code more readable and because they are used often.
-!     * Most of the direct-access keys are set in this module, but some are not (longName, iadv, isAdvected for now).
-!     * Some of the direct-access keys must be updated (using the routine "setDirectKeys") is a subset of "tracers(:)"
-!     is extracted: the indexes are no longer valid for a subset (examples: iqParent, iqDescen).
-!     * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys".
-!==============================================================================================================================
-LOGICAL FUNCTION readTracersFiles(type_trac, tracs, lRepr) RESULT(lerr)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=*),                               INTENT(IN)  :: type_trac     !--- List of components used
-  TYPE(trac_type), ALLOCATABLE, TARGET, OPTIONAL, INTENT(OUT) :: tracs(:)      !--- Tracers descriptor for external storage
-  LOGICAL,                              OPTIONAL, INTENT(IN)  :: lRepr         !--- Activate the HNO3 exceptions for REPROBUS
-  CHARACTER(LEN=maxlen),  ALLOCATABLE :: s(:), sections(:), trac_files(:)
-  CHARACTER(LEN=maxlen) :: str, fname, tname, pname, cname
-  INTEGER               :: nsec, ierr, it, ntrac, ns, ip, ix, fType
-  INTEGER, ALLOCATABLE  :: iGen(:)
-  LOGICAL :: lRep
-  TYPE(keys_type), POINTER :: k
-!------------------------------------------------------------------------------------------------------------------------------
-  lerr = .FALSE.
-  modname = 'readTracersFiles'
-  IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
-  lRep=.FALSE.; IF(PRESENT(lRepr)) lRep = lRepr
-
-  !--- Required sections + corresponding files names (new style single section case) for tests
-  lerr = testTracersFiles(modname, type_trac, fType, .FALSE., trac_files, sections); IF(lerr) RETURN
-  nsec = SIZE(sections)
-
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  SELECT CASE(fType)                         !--- Set name, component, parent, phase, iGeneration, gen0Name, type
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-    CASE(1)                                                          !=== OLD FORMAT "traceur.def"
-    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-      !--- OPEN THE "traceur.def" FILE
-      OPEN(90, FILE="traceur.def", FORM='formatted', STATUS='old', POSITION='REWIND', IOSTAT=ierr)
-
-      !--- GET THE TRACERS NUMBER
-      READ(90,'(i3)',IOSTAT=ierr)ntrac                               !--- Number of lines/tracers
-      lerr = ierr/=0; IF(fmsg('Invalid format for "'//TRIM(fname)//'"', modname, lerr)) RETURN
-
-      !--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>]
-      ALLOCATE(tracers(ntrac))
-      DO it = 1, ntrac                                               !=== READ RAW DATA: loop on the line/tracer number
-        READ(90,'(a)',IOSTAT=ierr) str
-        lerr = ierr>0; IF(fmsg('Invalid format for "' //TRIM(fname)//'"', modname, lerr)) RETURN
-        lerr = ierr<0; IF(fmsg('Not enough lines in "'//TRIM(fname)//'"', modname, lerr)) RETURN
-        lerr = strParse(str, ' ', s, ns)
-        CALL msg('This file is for air tracers only',           modname, ns == 3 .AND. it == 1)
-        CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1)
-        k => tracers(it)%keys
-
-        !=== NAME OF THE TRACER
-        tname = old2newH2O(s(3), ip)
-        ix = strIdx(oldHNO3, s(3))
-        IF(ix /= 0 .AND. lRep) tname = newHNO3(ix)                   !--- Exception for HNO3 (REPROBUS ONLY)
-        tracers(it)%name = tname                                     !--- Set the name of the tracer
-        CALL addKey('name', tname, k)                                !--- Set the name of the tracer
-        tracers(it)%keys%name = tname                                !--- Copy tracers names in keys components
-
-        !=== NAME OF THE COMPONENT
-        cname = type_trac                                            !--- Name of the model component
-        IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz'
-        tracers(it)%component = cname                                !--- Set component
-        CALL addKey('component', cname, k)                           !--- Set the name of the model component
-
-        !=== NAME OF THE PARENT
-        pname = tran0                                                !--- Default name: default transporting fluid (air)
-        IF(ns == 4) THEN
-          pname = old2newH2O(s(4))
-          ix = strIdx(oldHNO3, s(4))
-          IF(ix /= 0 .AND. lRep) pname = newHNO3(ix)                 !--- Exception for HNO3 (REPROBUS ONLY)
-        END IF
-        tracers(it)%parent = pname                                   !--- Set the parent name
-        CALL addKey('parent', pname, k)
-
-        !=== PHASE AND ADVECTION SCHEMES NUMBERS
-        tracers(it)%phase = known_phases(ip:ip)                      !--- Set the phase of the tracer (default: "g"azeous)
-        CALL addKey('phase', known_phases(ip:ip), k)                 !--- Set the phase of the tracer (default: "g"azeous)
-        CALL addKey('hadv', s(1),  k)                                !--- Set the horizontal advection schemes number
-        CALL addKey('vadv', s(2),  k)                                !--- Set the vertical   advection schemes number
-      END DO
-      CLOSE(90)
-      lerr = setGeneration(tracers); IF(lerr) RETURN                 !--- Set iGeneration and gen0Name
-      lerr = getKey('iGeneration', iGen, tracers(:)%keys)            !--- Generation number
-      WHERE(iGen == 2) tracers(:)%type = 'tag'                       !--- Set type:      'tracer' or 'tag'
-      DO it = 1, ntrac
-        CALL addKey('type', tracers(it)%type, tracers(it)%keys)      !--- Set the type of tracer
-      END DO
-      lerr = checkTracers(tracers, fname, fname); IF(lerr) RETURN    !--- Detect orphans and check phases
-      lerr = checkUnique (tracers, fname, fname); IF(lerr) RETURN    !--- Detect repeated tracers
-      CALL sortTracers   (tracers)                                   !--- Sort the tracers
-    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-    CASE(2); lerr=feedDBase(["tracer.def"], [type_trac], modname); IF(lerr) RETURN  !=== SINGLE   FILE, MULTIPLE SECTIONS
-    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-    CASE(3); lerr=feedDBase(  trac_files  ,  sections,   modname); IF(lerr) RETURN  !=== MULTIPLE FILES, SINGLE  SECTION
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  END SELECT
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  IF(ALL([2,3] /= fType)) RETURN
-  IF(nsec == 1) tracers = dBase(1)%trac
-  IF(nsec /= 1) THEN
-    CALL msg('Multiple sections are MERGED',    modname,      lTracsMerge)
-    CALL msg('Multiple sections are CUMULATED', modname, .NOT.lTracsMerge)
-    IF(     lTracsMerge) lerr = cumulTracers(dBase, tracers)
-    IF(.NOT.lTracsMerge) lerr = cumulTracers(dBase, tracers)
-    IF(lerr) RETURN
-  END IF
-  lerr = indexUpdate(tracers); IF(lerr) RETURN                       !--- Set iqParent, iqDescen, nqDescen, nqChildren
-  IF(PRESENT(tracs)) CALL MOVE_ALLOC(FROM=tracers, TO=tracs)
-END FUNCTION readTracersFiles
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-LOGICAL FUNCTION testTracersFiles(modname, type_trac, fType, lDisp, tracf, sects) RESULT(lerr)
-  CHARACTER(LEN=*),                             INTENT(IN)  :: modname, type_trac
-  INTEGER,                                      INTENT(OUT) :: fType
-  LOGICAL,                            OPTIONAL, INTENT(IN)  :: lDisp
-  CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: tracf(:), sects(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: trac_files(:), sections(:)
-  LOGICAL, ALLOCATABLE :: ll(:)
-  LOGICAL :: lD, lFound
-  INTEGER :: is, nsec
-  lD = .FALSE.; IF(PRESENT(lDisp)) lD = lDisp
-  lerr = .FALSE.
-
-  !--- PARSE "type_trac" LIST AND DETERMINE THE TRACERS FILES NAMES (FOR CASE 3: MULTIPLE FILES, SINGLE SECTION PER FILE)
-  !--- If type_trac is a scalar (case 1), "sections" and "trac_files" are not usable, but are meaningless for case 1 anyway.
-  lerr = strParse(type_trac, '|', sections, n=nsec); IF(lerr) RETURN !--- Parse "type_trac" list
-  IF(PRESENT(sects)) sects = sections
-  ALLOCATE(trac_files(nsec), ll(nsec))
-  DO is=1, nsec
-     trac_files(is) = 'tracer_'//TRIM(sections(is))//'.def'
-     INQUIRE(FILE=TRIM(trac_files(is)), EXIST=ll(is))
-  END DO
-  IF(PRESENT(tracf)) tracf = trac_files
-  fType = 0
-  INQUIRE(FILE='traceur.def', EXIST=lFound); IF(lFound)  fType = 1   !--- OLD STYLE FILE
-  INQUIRE(FILE='tracer.def',  EXIST=lFound); IF(lFound)  fType = 2   !--- NEW STYLE ; SINGLE  FILE, SEVERAL SECTIONS
-                                             IF(ALL(ll)) fType = 3   !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
-  IF(.NOT.lD) RETURN                                                 !--- NO CHECKING/DISPLAY NEEDED: JUST GET type_trac,fType
-  IF(ANY(ll) .AND. fType/=3) THEN                                    !--- MISSING FILES
-    lerr = checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'); IF(lerr) RETURN
-  END IF
-
-  !--- TELLS WHAT WAS IS ABOUT TO BE USED
-  CALL msg('Trying to read old-style tracers description file "traceur.def"',                      modname, fType==1)
-  CALL msg('Trying to read the new style multi-sections tracers description file "tracer.def"',    modname, fType==2)
-  CALL msg('Trying to read the new style single section tracers description files "tracer_*.def"', modname, fType==3)
-END FUNCTION testTracersFiles
-!==============================================================================================================================
-
-!==============================================================================================================================
-LOGICAL FUNCTION feedDBase(fnames, snames, modname) RESULT(lerr)
-! Purpose: Read the sections "snames(is)" (pipe-separated list) from each "fnames(is)"
-!   file and create the corresponding tracers set descriptors in the database "dBase":
-! * dBase(id)%name                : section name
-! * dBase(id)%trac(:)%name        : tracers names
-! * dBase(id)%trac(it)%keys%key(:): names  of keys associated to tracer dBase(id)%trac(it)%name
-! * dBase(id)%trac(it)%keys%val(:): values of keys associated to tracer dBase(id)%trac(it)%name
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=*), INTENT(IN)  :: fnames(:)                         !--- Files names
-  CHARACTER(LEN=*), INTENT(IN)  :: snames(:)                         !--- Pipe-deparated list of sections (one list each file)
-  CHARACTER(LEN=*), INTENT(IN)  :: modname                           !--- Calling routine name
-  INTEGER,  ALLOCATABLE :: ndb(:)                                    !--- Number of sections for each file
-  INTEGER,  ALLOCATABLE :: ixf(:)                                    !--- File index for each section of the expanded list
-  CHARACTER(LEN=maxlen) :: fnm, snm
-  INTEGER               :: idb, i
-  LOGICAL :: ll
-!------------------------------------------------------------------------------------------------------------------------------
-  !=== READ THE REQUIRED SECTIONS
-  ll = strCount(snames, '|', ndb)                                    !--- Number of sections for each file
-  ALLOCATE(ixf(SUM(ndb)))
-  DO i=1, SIZE(fnames)                                               !--- Set name, keys
-    lerr = readSections(fnames(i), snames(i), 'default'); IF(lerr) RETURN
-    ixf(1+SUM(ndb(1:i-1)):SUM(ndb(1:i))) = i                         !--- File index for each section of the expanded list
-  END DO
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  DO idb=1,SIZE(dBase)                                               !--- LOOP ON THE LOADED SECTIONS
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-    fnm = fnames(ixf(idb)); snm = dBase(idb)%name                    !--- FILE AND SECTION NAMES
-    lerr = ANY([(dispTraSection('RAW CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
-    lerr = expandSection(dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- EXPAND NAMES ;  SET parent, type, component
-    lerr = setGeneration(dBase(idb)%trac);           IF(lerr) RETURN !---                 SET iGeneration,  genOName
-    lerr = checkTracers (dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- CHECK ORPHANS AND PHASES
-    lerr = checkUnique  (dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- CHECK TRACERS UNIQUENESS
-    lerr = expandPhases (dBase(idb)%trac);           IF(lerr) RETURN !--- EXPAND PHASES ; set phase
-    CALL sortTracers    (dBase(idb)%trac)                            !--- SORT TRACERS
-    lerr = ANY([(dispTraSection('EXPANDED CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  END DO
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-END FUNCTION feedDBase
-!------------------------------------------------------------------------------------------------------------------------------
-
-!------------------------------------------------------------------------------------------------------------------------------
-LOGICAL FUNCTION readSections(fnam,snam,defName) RESULT(lerr)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=*),           INTENT(IN) :: fnam                     !--- File name
-  CHARACTER(LEN=*),           INTENT(IN) :: snam                     !--- Pipe-separated sections list
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: defName                  !--- Special section (default values) name
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE(dataBase_type),   ALLOCATABLE :: tdb(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: sec(:)
-  INTEGER,               ALLOCATABLE ::  ix(:)
-  INTEGER :: n0, idb, ndb
-  LOGICAL :: ll
-!------------------------------------------------------------------------------------------------------------------------------
-  n0 = SIZE(dBase) + 1                                               !--- Index for next entry in the database
-  CALL readSections_all()                                            !--- Read all the sections of file "fnam"
-  ndb= SIZE(dBase)                                                   !--- Current number of sections in the database
-  IF(PRESENT(defName)) THEN                                          !--- Add default values to all the tracers
-    DO idb=n0,ndb; CALL addDefault(dBase(idb)%trac, defName); END DO !--- and remove the virtual tracer "defName"
-  END IF
-  ll = strParse(snam, '|', keys = sec)                               !--- Requested sections names
-  ix = strIdx(dBase(:)%name, sec(:))                                 !--- Indexes of requested sections in database
-  lerr = checkList(sec, ix == 0, 'In file "'//TRIM(fnam)//'"','section(s)', 'missing'); IF(lerr) RETURN
-  tdb = dBase(:); dBase = [tdb(1:n0-1),tdb(PACK(ix, MASK=ix/=0))]    !--- Keep requested sections only
-
-CONTAINS
-
-!------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE readSections_all()
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE ::  s(:), v(:)
-  TYPE(trac_type),       ALLOCATABLE :: tt(:)
-  TYPE(trac_type)       :: tmp
-  CHARACTER(LEN=1024)   :: str, str2
-  CHARACTER(LEN=maxlen) :: secn
-  INTEGER               :: ierr, n
-!------------------------------------------------------------------------------------------------------------------------------
-  IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
-  OPEN(90, FILE=fnam, FORM='formatted', POSITION='REWIND', STATUS='old')
-  DO; str=''
-    DO
-      READ(90,'(a)', IOSTAT=ierr)str2                                !--- Read a full line
-      str=TRIM(str)//' '//TRIM(str2)                                 !--- Append "str" with the current line
-      n=LEN_TRIM(str); IF(n == 0) EXIT                               !--- Empty line (probably end of file)
-      IF(IACHAR(str(n:n))  /= 92) EXIT                               !--- No "\" continuing line symbol found => end of line
-      str = str(1:n-1)                                               !--- Remove the "\" continuing line symbol
-    END DO
-    str = ADJUSTL(str)                                               !--- Remove the front space
-    IF(ierr    /= 0 ) EXIT                                           !--- Finished: error or end of file
-    IF(str(1:1)=='#') CYCLE                                          !--- Skip comments lines
-    CALL removeComment(str)                                          !--- Skip comments at the end of a line
-    IF(LEN_TRIM(str) == 0) CYCLE                                     !--- Empty line (probably end of file)
-    IF(str     == '') CYCLE                                          !--- Skip empty line (probably at the end of the file)
-    IF(str(1:1)=='&') THEN                                           !=== SECTION HEADER LINE
-      ndb  = SIZE(dBase)                                             !--- Number of sections so far
-      secn = str(2:LEN_TRIM(str))//' '                               !--- Current section name
-      IF(ANY(dBase(:)%name == secn)) CYCLE                           !--- Already known section
-      IF(secn(1:7) == 'version')     CYCLE                           !--- Skip the "version" special section
-      ndb = ndb + 1                                                  !--- Extend database
-      ALLOCATE(tdb(ndb))
-      tdb(1:ndb-1)  = dBase
-      tdb(ndb)%name = secn
-      ALLOCATE(tdb(ndb)%trac(0))
-      CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
-    ELSE                                                             !=== TRACER LINE
-      ll = strParse(str,' ', s, n, v)                                !--- Parse <key>=<val> pairs
-      tt = dBase(ndb)%trac(:)
-      v(1) = s(1); s(1) = 'name'                                     !--- Convert "name" into a regular key
-      tmp%name = v(1); tmp%keys = keys_type(v(1), s(:), v(:))        !--- Set %name and %keys
-      dBase(ndb)%trac = [tt(:), tmp]
-      DEALLOCATE(tt, tmp%keys%key, tmp%keys%val)
-    END IF
-  END DO
-  CLOSE(90)
-
-END SUBROUTINE readSections_all
-!------------------------------------------------------------------------------------------------------------------------------
-
-END FUNCTION readSections
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-SUBROUTINE addDefault(t, defName)
-!------------------------------------------------------------------------------------------------------------------------------
-! Purpose: Add the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
-  CHARACTER(LEN=*),                     INTENT(IN)    :: defName
-  INTEGER :: jd, it, k
-  TYPE(keys_type), POINTER :: ky
-  TYPE(trac_type), ALLOCATABLE :: tt(:)
-  jd = strIdx(t(:)%name, defName)
-  IF(jd == 0) RETURN
-  ky => t(jd)%keys
-  DO k = 1, SIZE(ky%key)                                             !--- Loop on the keys of the tracer named "defName"
-!   CALL addKey(ky%key(k), ky%val(k), t(:)%keys, .FALSE.)            !--- Add key to all the tracers (no overwriting)
-    DO it = 1, SIZE(t); CALL addKey(ky%key(k), ky%val(k), t(it)%keys, .FALSE.); END DO
-  END DO
-  tt = [t(1:jd-1),t(jd+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t)   !--- Remove the virtual tracer named "defName"
-END SUBROUTINE addDefault
-!==============================================================================================================================
-
-!==============================================================================================================================
-SUBROUTINE subDefault(t, defName, lSubLocal)
-!------------------------------------------------------------------------------------------------------------------------------
-! Purpose: Substitute the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
-!          Substitute the keys locally (for the current tracer) if the flag "lSubLocal" is .TRUE.
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
-  CHARACTER(LEN=*),                     INTENT(IN)    :: defName
-  LOGICAL,                              INTENT(IN)    :: lSubLocal
-  INTEGER :: i0, it, ik
-  TYPE(keys_type), POINTER     :: k0, ky
-  TYPE(trac_type), ALLOCATABLE :: tt(:)
-  i0 = strIdx(t(:)%name, defName)
-  IF(i0 == 0) RETURN
-  k0 => t(i0)%keys 
-  DO it = 1, SIZE(t); IF(it == i0) CYCLE                             !--- Loop on the tracers
-    ky => t(it)%keys
-
-    !--- Substitute in the values of <key>=<val> pairs the keys defined in the virtual tracer "defName"
-    DO ik = 1, SIZE(k0%key); CALL strReplace(ky%val, k0%key(ik), k0%val(ik), .TRUE.); END DO
-
-    IF(.NOT.lSubLocal) CYCLE
-    !--- Substitute in the values of <key>=<val> pairs the keys defined locally (in the current tracer)
-    DO ik = 1, SIZE(ky%key); CALL strReplace(ky%val, ky%key(ik), ky%val(ik), .TRUE.); END DO
-  END DO
-  tt = [t(1:i0-1),t(i0+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t)   !--- Remove the virtual tracer named "defName"
-
-END SUBROUTINE subDefault
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-LOGICAL FUNCTION expandSection(tr, sname, fname) RESULT(lerr)
-!------------------------------------------------------------------------------------------------------------------------------
-! Purpose: Expand tracers and parents lists in the tracers descriptor "tra".
-! Note:  * The following keys are expanded, so are accessible explicitely using "%" operator: "parent" "type".
-!        * Default values are provided for these keys because they are necessary.
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:)                 !--- Tracer derived type vector
-  CHARACTER(LEN=*),             INTENT(IN)    :: sname                 !--- Current section name
-  CHARACTER(LEN=*), OPTIONAL,   INTENT(IN)    :: fname                 !--- Tracers description file name
-  TYPE(trac_type),       ALLOCATABLE :: ttr(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: ta(:), pa(:), tname(:), parent(:), dType(:)
-  CHARACTER(LEN=maxlen) :: msg1, modname
-  INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr
-  LOGICAL :: ll
-  modname = 'expandSection'
-  lerr = .FALSE.
-  nt = SIZE(tr)
-  lerr = getKey('name',   tname,  tr(:)%keys);                 IF(lerr) RETURN
-  lerr = getKey('parent', parent, tr(:)%keys, def = tran0);    IF(lerr) RETURN
-  lerr = getKey('type',   dType,  tr(:)%keys, def = 'tracer'); IF(lerr) RETURN
-  nq = 0
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  DO it = 1, nt    !=== GET TRACERS NB AFTER EXPANSION + NEEDED KEYS (name, parent, type)
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-    !--- Extract useful keys: parent name, type, component name
-    tr(it)%component = sname
-    CALL addKey('component', sname,  tr(it)%keys)
-
-    !--- Determine the number of tracers and parents ; coherence checking
-    ll = strCount( tname(it), ',', ntr)
-    ll = strCount(parent(it), ',', npr)
-
-    !--- Tagging tracers only can have multiple parents
-    lerr = npr /=1 .AND. TRIM(dType(it)) /= 'tag'
-    IF(lerr) THEN
-      msg1 = 'Check section "'//TRIM(sname)//'"'
-      IF(PRESENT(fname)) msg1 = TRIM(msg1)//' in file "'//TRIM(fname)//'"'
-      CALL msg(TRIM(msg1)//': "'//TRIM(tname(it))//'" has several parents but is not a tag', modname); RETURN
-    END IF
-    nq = nq + ntr*npr                 
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  END DO
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-  ALLOCATE(ttr(nq))
-  iq = 1
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  DO it = 1, nt                                                      !=== EXPAND TRACERS AND PARENTS NAMES LISTS
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-    ll = strParse( tname(it), ',', ta, ntr)                          !--- Number of tracers
-    ll = strParse(parent(it), ',', pa, npr)                          !--- Number of parents
-    DO ipr = 1, npr                                                  !--- Loop on parents list elts
-      DO itr = 1, ntr                                                !--- Loop on tracers list elts
-        ttr(iq)%keys%name = TRIM(ta(itr))
-        ttr(iq)%keys%key  = tr(it)%keys%key
-        ttr(iq)%keys%val  = tr(it)%keys%val
-        ttr(iq)%name      = TRIM(ta(itr))
-        ttr(iq)%parent    = TRIM(pa(ipr))
-        ttr(iq)%type      = dType(it)
-        ttr(iq)%component = sname
-        CALL addKey('name',      ta(itr),   ttr(iq)%keys)
-        CALL addKey('parent',    pa(ipr),   ttr(iq)%keys)
-        CALL addKey('type',      dType(it), ttr(iq)%keys)
-        CALL addKey('component', sname,     ttr(iq)%keys)
-        iq = iq + 1
-      END DO
-    END DO
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  END DO
-  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  DEALLOCATE(ta,pa)
-  CALL MOVE_ALLOC(FROM=ttr, TO=tr)
-
-END FUNCTION expandSection
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-LOGICAL FUNCTION setGeneration(tr) RESULT(lerr)
-!------------------------------------------------------------------------------------------------------------------------------
-! Purpose: Determine, for each tracer of "tr(:)":
-!   * iGeneration: the generation number 
-!   * gen0Name:    the generation 0 ancestor name
-!          Check also for orphan tracers (tracers without parent).
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE(trac_type),     INTENT(INOUT) :: tr(:)                        !--- Tracer derived type vector
-  INTEGER                            :: iq, jq, ig
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: parent(:), tname(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: modname
-  modname = 'setGeneration'
-  lerr = getKey('name',   tname,  ky=tr(:)%keys); IF(lerr) RETURN
-  lerr = getKey('parent', parent, ky=tr(:)%keys); IF(lerr) RETURN
-  DO iq = 1, SIZE(tr)
-    jq = iq; ig = 0
-    DO WHILE(parent(jq) /= tran0)
-      jq = strIdx(tname(:), parent(jq))
-      lerr = jq == 0
-      IF(fmsg('Orphan tracer "'//TRIM(tname(iq))//'"', modname, lerr)) RETURN
-      ig = ig + 1
-    END DO
-    tr(iq)%gen0Name = tname(jq)
-    tr(iq)%iGeneration = ig
-    CALL addKey('iGeneration',   ig,  tr(iq)%keys)
-    CALL addKey('gen0Name', tname(jq), tr(iq)%keys)
-  END DO
-END FUNCTION setGeneration
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-LOGICAL FUNCTION checkTracers(tr, sname, fname) RESULT(lerr)
-!------------------------------------------------------------------------------------------------------------------------------
-! Purpose:
-!   * check for orphan tracers (without parent)
-!   * check wether the phases are known or not (elements of "known_phases")
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE(trac_type),            INTENT(IN) :: tr(:)                    !--- Tracer derived type vector
-  CHARACTER(LEN=*),           INTENT(IN) :: sname                    !--- Section name
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname                    !--- File name
-  CHARACTER(LEN=1) :: p
-  CHARACTER(LEN=maxlen) :: mesg
-  CHARACTER(LEN=maxlen) :: bp(SIZE(tr, DIM=1)), pha                  !--- Bad phases list, phases of current tracer
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:)
-  INTEGER,               ALLOCATABLE ::  iGen(:)
-  INTEGER :: ip, np, iq, nq
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: modname
-  modname = 'checkTracers'
-  nq = SIZE(tr,DIM=1)                                                !--- Number of tracers lines
-  mesg = 'Check section "'//TRIM(sname)//'"'
-  IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
-  lerr = getKey('iGeneration', iGen, tr(:)%keys);               IF(lerr) RETURN
-  lerr = getKey('name',       tname, tr(:)%keys);               IF(lerr) RETURN
-
-  !=== CHECK FOR ORPHAN TRACERS
-  lerr = checkList(tname, iGen==-1, mesg, 'tracers', 'orphan'); IF(lerr) RETURN
-
-  !=== CHECK PHASES
-  DO iq = 1, nq; IF(iGen(iq) /= 0) CYCLE                             !--- Generation O only is checked
-    IF(getKey(['phases','phase '], pha, iq, tr(:)%keys, lDisp=.FALSE.)) pha = 'g'   !--- Phase
-    np = LEN_TRIM(pha); bp(iq)=' '
-    DO ip = 1, np; p = pha(ip:ip); IF(INDEX(known_phases, p) == 0) bp(iq) = TRIM(bp(iq))//p; END DO
-    IF(TRIM(bp(iq)) /= '') bp(iq) = TRIM(tname(iq))//': '//TRIM(bp(iq))
-  END DO
-  lerr = checkList(bp, iGen == 0 .AND. bp /= '', mesg, 'tracers phases', 'unknown')
-END FUNCTION checkTracers
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-LOGICAL FUNCTION checkUnique(tr, sname, fname) RESULT(lerr)
-!------------------------------------------------------------------------------------------------------------------------------
-! Purpose: Make sure that tracers are not repeated.
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE(trac_type),            INTENT(IN) :: tr(:)                    !--- Tracer derived type vector
-  CHARACTER(LEN=*),           INTENT(IN) :: sname                    !--- Section name
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname                    !--- File name
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: ip, np, iq, nq, k
-  LOGICAL, ALLOCATABLE  :: ll(:)
-  CHARACTER(LEN=maxlen) :: mesg, phase, tdup(SIZE(tr,DIM=1))
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), dType(:)
-  INTEGER,               ALLOCATABLE :: iGen(:)
-  CHARACTER(LEN=1) :: p
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: modname
-  modname = 'checkUnique'
-  mesg = 'Check section "'//TRIM(sname)//'"'
-  IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
-  nq=SIZE(tr,DIM=1); lerr=.FALSE.                                    !--- Number of lines ; error flag
-  tdup(:) = ''
-  lerr = getKey('name',       tname, tr%keys); IF(lerr) RETURN
-  lerr = getKey('type',       dType, tr%keys); IF(lerr) RETURN
-  lerr = getKey('iGeneration', iGen, tr%keys); IF(lerr) RETURN
-  DO iq = 1, nq
-    IF(dType(iq) == 'tag') CYCLE                                     !--- Tags can be repeated
-    ll = tname==TRIM(tname(iq))                                      !--- Mask for current tracer name
-    IF(COUNT(ll) == 1) CYCLE                                         !--- Tracer is not repeated
-    IF(iGen(iq) > 0) THEN
-      tdup(iq) = tname(iq)                                           !--- gen>0: MUST be unique
-    ELSE
-      DO ip = 1, nphases; p = known_phases(ip:ip)                    !--- Loop on known phases
-        np = 0
-        DO k = 1, nq
-          IF(.NOT.ll(k)) CYCLE                                       !--- Skip tracers different from current one
-          IF(getKey(['phases','phase '], phase, k, tr%keys, lDisp=.FALSE.)) phase='g'!--- Get current phases
-          IF(INDEX(phase, p) /= 0) np = np + 1                       !--- One more appearance of current tracer with phase "p"
-        END DO
-        IF(np <= 1) CYCLE                                            !--- Regular case: no or a single appearance
-        tdup(iq) = TRIM(tdup(iq))//TRIM(phases_names(ip))            !--- Repeated phase
-        IF(ANY(tdup(1:iq-1) == tdup(iq))) tdup(iq)=''                !--- Avoid repeating same messages
-      END DO
-    END IF
-    IF(tdup(iq) /= '') tdup(iq)=TRIM(tname(iq))//' in '//TRIM(tdup(iq))//' phase(s)'
-  END DO
-  lerr = checkList(tdup, tdup/='', mesg, 'tracers', 'duplicated')
-END FUNCTION checkUnique
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-LOGICAL FUNCTION expandPhases(tr) RESULT(lerr)
-!------------------------------------------------------------------------------------------------------------------------------
-! Purpose: Expand the phases in the tracers descriptor "tr". Phases are not repeated for a tracer, thanks to "checkUnique".
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:)               !--- Tracer derived type vector
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE(trac_type),       ALLOCATABLE :: ttr(:)
-  INTEGER,               ALLOCATABLE ::  i0(:), iGen(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), gen0N(:), phase(:), parents(:), dType(:)
-  CHARACTER(LEN=maxlen)              ::  nam,     gen0Nm,   pha,      parent
-  CHARACTER(LEN=1) :: p
-  INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n
-  LOGICAL :: lTag, lExt
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: modname
-  modname = 'expandPhases'
-  nq = SIZE(tr, DIM=1)
-  nt = 0
-  lerr = getKey('name',       tname, tr%keys); IF(lerr) RETURN       !--- Names of the tracers
-  lerr = getKey('gen0Name',   gen0N, tr%keys); IF(lerr) RETURN       !--- Names of the tracers of first generation
-  lerr = getKey('iGeneration', iGen, tr%keys); IF(lerr) RETURN       !--- Generation number
-  lerr = getKey('phases',     phase, tr%keys); IF(lerr) RETURN       !--- Phases names
-  lerr = getKey('parent',   parents, tr%keys); IF(lerr) RETURN       !--- Parents names
-  lerr = getKey('type',       dType, tr%keys); IF(lerr) RETURN       !--- Tracers types ('tracer' or 'tag')
-  DO iq = 1, nq                                                      !--- GET THE NUMBER OF TRACERS
-    IF(iGen(iq) /= 0) CYCLE                                          !--- Only deal with generation 0 tracers
-    nc = COUNT(gen0N == tname(iq) .AND. iGen /= 0)                   !--- Number of children of tr(iq)
-    np = LEN_TRIM(phase(iq))                                         !--- Number of phases   of tr(iq)
-    nt = nt + (1+nc) * np                                            !--- Number of tracers after expansion
-  END DO
-  ALLOCATE(ttr(nt))                                                  !--- Version  of "tr" after phases expansion
-  it = 1                                                             !--- Current "ttr(:)" index
-  DO iq = 1, nq                                                      !--- Loop on "tr(:)" indexes
-    lTag = dType(iq)=='tag'                                          !--- Current tracer is a tag
-    i0 = strFind(tname, TRIM(gen0N(iq)), n)                          !--- Indexes of first generation ancestor copies
-    np = SUM([( LEN_TRIM(phase(i0(i))), i = 1, n )], 1)              !--- Number of phases for current tracer tr(iq)
-    lExt = np > 1                                                    !--- Phase suffix only required if phases number is > 1
-    IF(lTag) lExt = lExt .AND. iGen(iq) > 0                          !--- No phase suffix for generation 0 tags
-    DO i = 1, n                                                      !=== LOOP ON GENERATION 0 ANCESTORS
-      jq = i0(i)                                                     !--- tr(jq): ith tracer with same gen 0 ancestor as tr(iq)
-      IF(iGen(iq) == 0) jq = iq                                      !--- Generation 0: count the current tracer phases only
-      pha = phase(jq)                                                !--- Phases list for tr(jq)
-      DO ip = 1, LEN_TRIM(pha)                                       !=== LOOP ON PHASES LISTS
-        p = pha(ip:ip)
-        nam = tname(iq)                                              !--- Tracer name (regular case)
-        IF(lTag) nam = TRIM(parents(iq))                             !--- Parent name (tagging case)
-        IF(lExt) nam = addPhase(nam, p )                             !--- Phase extension needed
-        IF(lTag) nam = TRIM(nam)//'_'//TRIM(tname(iq))               !--- <parent>_<name> for tags
-        ttr(it) = tr(iq)                                             !--- Same <key>=<val> pairs
-        ttr(it)%name      = TRIM(nam)                                !--- Name with possibly phase suffix
-        ttr(it)%keys%name = TRIM(nam)                                !--- Name inside the keys decriptor
-        ttr(it)%phase     = p                                        !--- Single phase entry
-        CALL addKey('name', nam, ttr(it)%keys)
-        CALL addKey('phase', p,  ttr(it)%keys)
-        IF(lExt) THEN
-          parent = parents(iq); IF(iGen(iq) > 0) parent = addPhase(parent, p)
-          gen0Nm =   gen0N(iq); IF(iGen(iq) > 0) gen0Nm = addPhase(gen0Nm, p)
-          ttr(it)%parent   = parent
-          ttr(it)%gen0Name = gen0Nm
-          CALL addKey('parent',   parent, ttr(it)%keys)
-          CALL addKey('gen0Name', gen0Nm, ttr(it)%keys)
-        END IF
-        it = it+1
-      END DO
-      IF(iGen(iq) == 0) EXIT                                         !--- Break phase loop for gen 0
-    END DO
-  END DO
-  CALL MOVE_ALLOC(FROM=ttr, TO=tr)
-  CALL delKey(['phases'],tr)                                         !--- Remove few keys entries
-
-END FUNCTION expandPhases
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-SUBROUTINE sortTracers(tr)
-!------------------------------------------------------------------------------------------------------------------------------
-! Purpose: Sort tracers:
-!  * Put water at the beginning of the vector, in the "known_phases" order.
-!  * lGrowGen == T: in ascending generations numbers.
-!  * lGrowGen == F: tracer + its children sorted by growing generation, one after the other.
-!   TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE(trac_type), INTENT(INOUT) :: tr(:)                            !--- Tracer derived type vector
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE(trac_type),       ALLOCATABLE :: tr2(:)
-  INTEGER,               ALLOCATABLE :: iy(:), iz(:)
-  INTEGER,               ALLOCATABLE ::  iGen(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), gen0N(:)
-  INTEGER :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k
-  LOGICAL :: lerr
-!  tr2 is introduced in order to cope with a bug in gfortran 4.8.5 compiler
-!------------------------------------------------------------------------------------------------------------------------------
-  lerr = getKey('iGeneration', iGen, tr%keys); IF(lerr) RETURN       !--- Generation number
-  nq = SIZE(tr)
-  DO ip = nphases, 1, -1
-    lerr = getKey('name',     tname, tr%keys); IF(lerr) RETURN       !--- Names of the tracers of first generation
-    iq = strIdx(tname, addPhase('H2O', ip))
-    IF(iq == 0) CYCLE
-    tr2 = tr(:)
-    tr = [tr2(iq), tr2(1:iq-1), tr2(iq+1:nq)]
-  END DO
-  IF(lSortByGen) THEN
-    iq = 1
-    ng = MAXVAL(iGen, MASK=.TRUE., DIM=1)                            !--- Number of generations
-    DO ig = 0, ng                                                    !--- Loop on generations
-      iy = PACK([(k, k=1, nq)], MASK=iGen(:) == ig)                  !--- Generation ig tracers indexes
-      n = SIZE(iy)
-      ix(iq:iq+n-1) = iy                                             !--- Stack growing generations idxs
-      iq = iq + n
-    END DO
-  ELSE
-    lerr = getKey('gen0Name',   gen0N, tr%keys); IF(lerr) RETURN     !--- Names of the tracers    iq = 1
-    DO jq = 1, nq                                                    !--- Loop on generation 0 tracers
-      IF(iGen(jq) /= 0) CYCLE                                        !--- Skip generations /= 0
-      ix(iq) = jq                                                    !--- Generation 0 ancestor index first
-      iq = iq + 1                                                    !--- Next "iq" for next generations tracers
-      iy = strFind(gen0N(:), TRIM(tname(jq)))                        !--- Indices of "tr(jq)" children in "tr(:)"
-      ng = MAXVAL(iGen(iy), MASK=.TRUE., DIM=1)                      !--- Number of generations of the "tr(jq)" family
-      DO ig = 1, ng                                                  !--- Loop   on generations of the "tr(jq)" family
-        iz = find(iGen(iy), ig, n)                                   !--- Indices of the tracers "tr(iy(:))" of generation "ig"
-        ix(iq:iq+n-1) = iy(iz)                                       !--- Same indexes in "tr(:)"
-        iq = iq + n
-      END DO
-    END DO
-  END IF
-  tr = tr(ix)                                                        !--- Reorder the tracers
-END SUBROUTINE sortTracers
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-LOGICAL FUNCTION mergeTracers(sections, tr) RESULT(lerr)
-  TYPE(dataBase_type),  TARGET, INTENT(IN)  :: sections(:)
-  TYPE(trac_type), ALLOCATABLE, INTENT(OUT) ::       tr(:)
-  TYPE(trac_type), POINTER ::   t1(:),   t2(:)
-  TYPE(keys_type), POINTER ::   k1(:),   k2(:)
-  INTEGER,     ALLOCATABLE :: ixct(:), ixck(:)
-  INTEGER :: is, ik, ik1, ik2, nk2, i1, i2, nt2
-  CHARACTER(LEN=maxlen) :: s1, v1, v2, tnam, knam, modname
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: keys(:), n1(:), n2(:)
-  modname = 'mergeTracers'
-  lerr = .FALSE.
-  keys = ['parent     ', 'type       ', 'iGeneration']               !--- Mandatory keys
-  t1 => sections(1)%trac(:); k1 => t1(:)%keys                        !--- Alias: first tracers section, corresponding keys
-  lerr = getKey('name', n1, k1); IF(lerr) RETURN                     !--- Names of the tracers
-  tr = t1
-  !----------------------------------------------------------------------------------------------------------------------------
-  DO is=2,SIZE(sections)                                             !=== SEVERAL SECTIONS: MERGE THEM
-  !----------------------------------------------------------------------------------------------------------------------------
-    t2  => sections(is)%trac(:)                                      !--- Alias: current tracers section
-    k2  => t2(:)%keys
-    lerr = getKey('name', n2, k2); IF(lerr) RETURN                   !--- Names of the tracers
-    nt2  = SIZE(t2(:), DIM=1)                                        !--- Number of tracers in section
-    ixct = strIdx(n1(:), n2(:))                                      !--- Indexes of common tracers
-    tr = [tr, PACK(t2, MASK= ixct==0)]                               !--- Append with new tracers
-    IF( ALL(ixct == 0) ) CYCLE                                       !--- No common tracers => done
-    CALL msg('Tracers defined in previous sections and duplicated in "'//TRIM(sections(is)%name)//'":', modname)
-    CALL msg(n1(PACK(ixct, MASK = ixct/=0)), modname, nmax=128)      !--- Display duplicates (the 128 first at most)
-    !--------------------------------------------------------------------------------------------------------------------------
-    DO i2=1,nt2; tnam = TRIM(t2(i2)%name)                            !=== LOOP ON COMMON TRACERS
-    !--------------------------------------------------------------------------------------------------------------------------
-      i1 = ixct(i2); IF(i1 == 0) CYCLE                               !--- Idx in t1(:) ; skip new tracers
-
-      !=== CHECK WETHER ESSENTIAL KEYS ARE IDENTICAL OR NOT
-      s1=' of "'//TRIM(tnam)//'" in "'//TRIM(sections(is)%name)//'" not matching previous value'
-      DO ik = 1, SIZE(keys)
-        lerr = getKey(keys(ik), v1, i1, k1)
-        lerr = getKey(keys(ik), v2, i2, k2)
-        lerr = v1 /= v2; IF(fmsg(TRIM(keys(ik))//TRIM(s1), modname, lerr)) RETURN
-      END DO
-
-      !=== GET THE INDICES IN tr(i2)%keys%key(:) OF THE KEYS ALSO PRESENT IN tr(i1)%keys%key(:)
-      nk2  =   SIZE(k2(i2)%key(:))                                   !--- Keys number in current section
-      ixck = strIdx(k1(i1)%key(:), k2(i2)%key(:))                    !--- Common keys indexes
-      !--- APPEND THE NEW KEYS PAIRS IN tr(i1)%keys%key(:)
-      tr(i1)%keys%key = [ tr(i1)%keys%key, PACK(tr(i2)%keys%key, MASK = ixck==0)]
-      tr(i1)%keys%val = [ tr(i1)%keys%val, PACK(tr(i2)%keys%val, MASK = ixck==0)]
-
-      !=== KEEP TRACK OF THE COMPONENTS NAMES: COMA-SEPARATED LIST
-      lerr = getKey('component', v1, i1, k1)
-      lerr = getKey('component', v2, i2, k2)
-      tr(i1)%component = TRIM(v1)//','//TRIM(v2)
-      CALL addKey('component', TRIM(v1)//','//TRIM(v2), tr(i1)%keys)
-
-      !=== FOR TRACERS COMMON TO PREVIOUS AND CURRENT SECTIONS: CHECK WETHER SOME KEYS HAVE DIFFERENT VALUES ; KEEP OLD ONE
-      DO ik2 = 1, nk2                                                !--- Collect the corresponding indices
-        ik1 = ixck(ik2); IF(ik1 == 0) CYCLE
-        IF(k1(i1)%val(ik1) == k2(i2)%val(ik2)) ixck(ik2)=0
-      END DO
-      IF(ALL(ixck==0)) CYCLE                                         !--- No identical keys with /=values => nothing to display
-      CALL msg('Key(s)'//TRIM(s1), modname)                          !--- Display the  keys with /=values (names list)
-      DO ik2 = 1, nk2                                                !--- Loop on keys found in both t1(:) and t2(:)
-        knam = k2(i2)%key(ik2)                                       !--- Name of the current key
-        ik1 = ixck(ik2)                                              !--- Corresponding index in t1(:)
-        IF(ik1 == 0) CYCLE                                           !--- New keys are skipped
-        v1 = k1(i1)%val(ik1); v2 = k2(i2)%val(ik2)                   !--- Key values in t1(:) and t2(:)
-        CALL msg(' * '//TRIM(knam)//'='//TRIM(v2)//' ; previous value kept:'//TRIM(v1), modname)
-      END DO
-      !------------------------------------------------------------------------------------------------------------------------
-    END DO
-    !--------------------------------------------------------------------------------------------------------------------------
-  END DO
-  CALL sortTracers(tr)
-
-END FUNCTION mergeTracers
-!==============================================================================================================================
-
-!==============================================================================================================================
-LOGICAL FUNCTION cumulTracers(sections, tr, lRename) RESULT(lerr)
-  TYPE(dataBase_type),  TARGET, INTENT(IN)  :: sections(:)
-  TYPE(trac_type), ALLOCATABLE, INTENT(OUT) ::       tr(:)
-  LOGICAL,            OPTIONAL, INTENT(IN)  :: lRename               !--- .TRUE.: add a section suffix to identical names
-  CHARACTER(LEN=maxlen)  :: tnam_new, modname
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), parent(:), comp(:)
-  INTEGER :: iq, jq, is
-  modname = 'cumulTracers'
-  lerr = .FALSE.
-  tr = [( sections(is)%trac(:), is = 1, SIZE(sections) )]            !--- Concatenated tracers vector
-  IF(PRESENT(lRename)) THEN; IF(lRename) RETURN; END IF              !--- No renaming: finished
-  lerr = getKey('name',     tname, tr%keys); IF(lerr) RETURN         !--- Names
-  lerr = getKey('parent',  parent, tr%keys); IF(lerr) RETURN         !--- Parents
-  lerr = getKey('component', comp, tr%keys); IF(lerr) RETURN         !--- Component name
-  !----------------------------------------------------------------------------------------------------------------------------
-  DO iq = 1, SIZE(tr); IF(COUNT(tname == tname(iq)) == 1) CYCLE      !=== LOOP ON TRACERS
-  !----------------------------------------------------------------------------------------------------------------------------
-    tnam_new = TRIM(tname(iq))//'_'//TRIM(comp(iq))                  !--- Same with section extension
-    CALL addKey('name', tnam_new, tr(iq)%keys)                       !--- Modify tracer name
-    tr(iq)%name = TRIM(tnam_new)                                     !--- Modify tracer name
-    !--------------------------------------------------------------------------------------------------------------------------
-    DO jq = 1, SIZE(tr); IF(parent(jq) /= tname(iq)) CYCLE           !=== LOOP ON TRACERS PARENTS
-    !--------------------------------------------------------------------------------------------------------------------------
-      CALL addKey('parent', tnam_new, tr(jq)%keys)                   !--- Modify tracer name
-      tr(jq)%parent = TRIM(tnam_new)                                 !--- Modify tracer name
-    !--------------------------------------------------------------------------------------------------------------------------
-    END DO
-  !----------------------------------------------------------------------------------------------------------------------------
-  END DO
-  !----------------------------------------------------------------------------------------------------------------------------
-  CALL sortTracers(tr)
-END FUNCTION cumulTracers
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-LOGICAL  FUNCTION  dispTraSection(message, sname, modname) RESULT(lerr)
-  CHARACTER(LEN=*), INTENT(IN) :: message, sname, modname
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:,:), n(:), tmp(:)
-  CHARACTER(LEN=maxlen) :: p
-  INTEGER :: idb, iq, nq
-  idb = strIdx(dBase(:)%name, sname); IF(idb == 0) RETURN
-  nq = SIZE(dBase(idb)%trac)
-  p = ''
-  CALL append(['iq'],     .TRUE. ); IF(lerr) RETURN
-  CALL append(['name'],   .TRUE. ); IF(lerr) RETURN
-  CALL append(['phases','phase '], .FALSE., 'pha'); IF(lerr) RETURN
-  CALL append(['hadv'],   .TRUE. ); IF(lerr) RETURN
-  CALL append(['vadv'],   .TRUE. ); IF(lerr) RETURN
-  CALL append(['parent'], .FALSE.); IF(lerr) RETURN
-  CALL append(['iGen'],   .FALSE.); IF(lerr) RETURN
-  CALL msg(TRIM(message)//':', modname)
-  lerr = dispTable(p, n, s, nColMax=maxTableWidth, nHead=2, sub=modname); IF(lerr) RETURN
-
-CONTAINS
-
-SUBROUTINE append(nam, lMandatory, snam)
-! Test whether key named "nam(:)" is available.
-!  * yes: - get its value for all species in "tmp(:)" and append table "s(:,:)" with it
-!         - append titles list with "nam(1)" (or, if specified, "snam", usually a short name).
-!  * no:  return to calling routine with an error flag if the required key is mandatory
-  CHARACTER(LEN=*),           INTENT(IN) :: nam(:)
-  LOGICAL,                    INTENT(IN) :: lMandatory
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: snam
-  INTEGER :: m
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: n0(:)
-  CHARACTER(LEN=maxlen) :: nm
-  lerr = .FALSE.
-  IF(nam(1) == 'iq') THEN
-    tmp = int2str([(iq, iq=1, nq)])
-  ELSE
-    lerr = getKey(nam, tmp, dBase(idb)%trac(:)%keys, lDisp=lMandatory)
-  END IF
-  IF(lerr) THEN; lerr = lMandatory; RETURN; END IF
-  nm = nam(1); IF(PRESENT(snam)) nm = snam
-  p = TRIM(p)//'s'
-  IF(ALLOCATED(s)) THEN; s = cat(s, tmp); ELSE; ALLOCATE(s(nq,1)); s(:,1) = tmp; END IF
-  IF(ALLOCATED(n)) THEN; m = SIZE(n); ALLOCATE(n0(m+1)); n0(1:m)=n; n0(m+1)=nm; CALL MOVE_ALLOC(FROM=n0, TO=n)
-  ELSE; n=nam(1:1); END IF
-END SUBROUTINE append
-
-END FUNCTION dispTraSection
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== CREATE TRACER(S) ALIAS: SCALAR/VECTOR FROM NAME(S) OR INDICE(S) ==========================================================
-!==============================================================================================================================
-LOGICAL FUNCTION aliasTracer(tname, trac, alias) RESULT(lerr)                  !=== TRACER NAMED "tname" - SCALAR
-  CHARACTER(LEN=*),         INTENT(IN)  :: tname
-  TYPE(trac_type), TARGET,  INTENT(IN)  :: trac(:)
-  TYPE(trac_type), POINTER, INTENT(OUT) :: alias
-  INTEGER :: it
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
-  alias => NULL()
-  lerr = getKey('name', tnames, trac(:)%keys)
-  it = strIdx(tnames, tname)
-  lerr = it /= 0; IF(.NOT.lerr) alias => trac(it)
-END FUNCTION aliasTracer
-!==============================================================================================================================
-LOGICAL FUNCTION trSubset_Indx(trac, idx, alias) RESULT(lerr)                  !=== TRACERS WITH INDICES "idx(:)" - VECTOR
-  TYPE(trac_type), ALLOCATABLE, INTENT(IN)  ::  trac(:)
-  INTEGER,                      INTENT(IN)  ::   idx(:)
-  TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
-  alias = trac(idx)
-  lerr = indexUpdate(alias)
-END FUNCTION trSubset_Indx
-!------------------------------------------------------------------------------------------------------------------------------
-LOGICAL FUNCTION trSubset_Name(trac, tname, alias) RESULT(lerr)                !=== TRACERS NAMED "tname(:)" - VECTOR
-  TYPE(trac_type), ALLOCATABLE, INTENT(IN)  ::  trac(:)
-  CHARACTER(LEN=*),             INTENT(IN)  :: tname(:)
-  TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
-  lerr = getKey('name', tnames, trac(:)%keys)
-  alias = trac(strIdx(tnames, tname))
-  lerr = indexUpdate(alias)
-END FUNCTION trSubset_Name
-!==============================================================================================================================
-LOGICAL FUNCTION trSubset_gen0Name(trac, gen0Nm, alias) RESULT(lerr)           !=== TRACERS OF COMMON 1st GENERATION ANCESTOR
-  TYPE(trac_type), ALLOCATABLE, INTENT(IN)  :: trac(:)
-  CHARACTER(LEN=*),             INTENT(IN)  :: gen0Nm
-  TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: gen0N(:)
-  lerr = getKey('gen0Name', gen0N, trac(:)%keys)
-  alias = trac(strFind(delPhase(gen0N), gen0Nm))
-  lerr = indexUpdate(alias)
-END FUNCTION trSubset_gen0Name
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== UPDATE THE INDEXES iqParent, iqDescend AND iGeneration IN THE TRACERS DESCRIPTOR LIST "tr" (USEFULL FOR SUBSETS) =========
-!==============================================================================================================================
-LOGICAL FUNCTION indexUpdate(tr) RESULT(lerr)
-  TYPE(trac_type), INTENT(INOUT) :: tr(:)
-  INTEGER :: iq, jq, nq, ig, nGen
-  INTEGER,               ALLOCATABLE :: iqDescen(:), ix(:), iy(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:), parent(:)
-  INTEGER,       DIMENSION(SIZE(tr)) :: iqParent, iGen
-  lerr = getKey('name',   tnames, tr%keys); IF(lerr) RETURN          !--- Names
-  lerr = getKey('parent', parent, tr%keys); IF(lerr) RETURN          !--- Parents
-  nq = SIZE(tr)
-
-  !=== iqParent, iGeneration
-  DO iq = 1, nq; iGen(iq) = 0; jq = iq
-    iqParent(iq) = strIdx(tnames, parent(iq))
-    DO; jq = strIdx(tnames, parent(jq)); IF(jq == 0) EXIT; iGen(iq) = iGen(iq) + 1; END DO
-    CALL addKey('iqParent',   parent(iq), tr(iq)%keys)
-    CALL addKey('iqGeneration', iGen(iq), tr(iq)%keys)
-  END DO
-
-  !=== nqChildren, iqDescen, nqDescen
-  nGen = MAXVAL(iGen, MASK=.TRUE.)
-  DO iq = 1, nq
-    ix = [iq]; ALLOCATE(iqDescen(0))
-    DO ig = iGen(iq)+1, nGen
-      iy = find(iqParent, ix); iqDescen = [iqDescen, iy]; ix = iy
-      IF(ig /= iGen(iq)+1) CYCLE
-      CALL addKey('nqChildren', SIZE(iqDescen), tr(iq)%keys)
-      tr(iq)%nqChildren = SIZE(iqDescen)
-    END DO
-    CALL addKey('iqDescen', strStack(int2str(iqDescen)), tr(iq)%keys)
-    CALL addKey('nqDescen',             SIZE(iqDescen),  tr(iq)%keys)
-    tr(iq)%iqDescen =      iqDescen
-    tr(iq)%nqDescen = SIZE(iqDescen)
-    DEALLOCATE(iqDescen)
-  END DO
-END FUNCTION indexUpdate
-!==============================================================================================================================
-  
-  
-!==============================================================================================================================
-!=== READ FILE "fnam" TO APPEND THE "dBase" TRACERS DATABASE WITH AS MUCH SECTIONS AS PARENTS NAMES IN "isot(:)%parent":   ====
-!===  * Each section dBase(i)%name contains the isotopes "dBase(i)%trac(:)" descending on "dBase(i)%name"="iso(i)%parent"  ====
-!===  * For each isotopes class, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot"        ====
-!=== NOTES:                                                                                                                ====
-!===  * Most of the "isot" components have been defined in the calling routine (processIsotopes):                          ====
-!===      parent,  nzone, zone(:),  niso, keys(:)%name,  ntiso, trac(:),  nphas, phas,  iqIsoPha(:,:),  itZonPhi(:,:)      ====
-!===  * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes       ====
-!===  * Each tracers section can contain a "params" virtual isotope line of isotopes parameters default values             ====
-!===  * In case keys are found both in the "params" section and the "*.def" file, the later value is retained              ====
-!===  * On each isotope line, defined keys can be used for other keys defintions (single level depth substitution)         ====
-!===  * The routine gives an error if a required isotope is not available in the database stored in "fnam"                 ====
-!==============================================================================================================================
-LOGICAL FUNCTION readIsotopesFile(fnam, isot) RESULT(lerr)
-  CHARACTER(LEN=*),        INTENT(IN)    :: fnam                     !--- Input file name
-  TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:)                  !--- Isotopes descriptors (field %parent must be defined!)
-  LOGICAL :: lFound
-  INTEGER :: is, iis, it, idb, ndb, nb0
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: vals(:)
-  CHARACTER(LEN=maxlen)              :: modname
-  TYPE(trac_type),           POINTER ::   tt(:), t
-  TYPE(dataBase_type),   ALLOCATABLE ::  tdb(:)
-  modname = 'readIsotopesFile'
-
-  !--- THE INPUT FILE MUST BE PRESENT
-  INQUIRE(FILE=TRIM(fnam), EXIST=lFound); lerr = .NOT.lFound
-  IF(fmsg('Missing isotopes parameters file "'//TRIM(fnam)//'"', modname, lerr)) RETURN
-
-  !--- READ THE FILE SECTIONS, ONE EACH PARENT TRACER
-  nb0 = SIZE(dBase, DIM=1)+1                                         !--- Next database element index
-  lerr = readSections(fnam,strStack(isot(:)%parent,'|')); IF(lerr) RETURN !--- Read sections, one each parent tracer
-  ndb = SIZE(dBase, DIM=1)                                           !--- Current database size
-  DO idb = nb0, ndb
-    iis = idb-nb0+1
-
-    !--- GET FEW GLOBAL KEYS FROM "def" FILES AND ADD THEM TO THE 'params' SECTION
-    CALL addKeysFromDef(dBase(idb)%trac, 'params')
-
-    !--- SUBSTITUTE THE KEYS DEFINED IN THE 'params' VIRTUAL TRACER ; SUBSTITUTE LOCAL KEYS ; REMOVE 'params' VIRTUAL TRACER
-    CALL subDefault(dBase(idb)%trac, 'params', .TRUE.)
-
-    tt => dBase(idb)%trac
-
-    !--- REDUCE THE EXPRESSIONS TO OBTAIN SCALARS AND TRANSFER THEM TO THE "isot" ISOTOPES DESCRIPTORS VECTOR
-    DO it = 1, SIZE(dBase(idb)%trac)
-      t => dBase(idb)%trac(it)
-      is = strIdx(isot(iis)%keys(:)%name, t%name)                    !--- Index in "isot(iis)%keys(:)%name" of isotope "t%name"
-      IF(is == 0) CYCLE
-      lerr = ANY(reduceExpr(t%keys%val, vals)); IF(lerr) RETURN      !--- Reduce expressions ; detect non-numerical elements
-      isot(iis)%keys(is)%key = t%keys%key
-      isot(iis)%keys(is)%val = vals
-    END DO
-
-    !--- CHECK FOR MISSING ISOTOPES (NO KEYS ALLOCATED)
-    lerr = checkList(isot(iis)%keys(:)%name, .NOT.[( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )], &
-                     'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing')
-    IF(lerr) RETURN
-  END DO
-
-  !--- CLEAN THE DATABASE ENTRIES
-  IF(nb0 == 1) THEN
-    DEALLOCATE(dBase); ALLOCATE(dBase(0))
-  ELSE
-    ALLOCATE(tdb(nb0-1)); tdb(1:nb0-1)=dBase(1:nb0-1); CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
-  END IF
-
-  !--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
-  CALL get_in('ok_iso_verif', isot(strIdx(isot%parent, 'H2O'))%check, .FALSE.)
-
-  lerr = dispIsotopes()
-
-CONTAINS
-
-!------------------------------------------------------------------------------------------------------------------------------
-LOGICAL FUNCTION dispIsotopes() RESULT(lerr)
-  INTEGER :: ik, nk, ip, it, nt
-  CHARACTER(LEN=maxlen) :: prf
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), val(:,:)
-  CALL msg('Isotopes parameters read from file "'//TRIM(fnam)//'":', modname)
-  DO ip = 1, SIZE(isot)                                              !--- Loop on parents tracers
-    nk = SIZE(isot(ip)%keys(1)%key)                                  !--- Same keys for each isotope
-    nt = SIZE(isot(ip)%keys)                                         !--- Number of isotopes
-    prf = 'i'//REPEAT('s',nk+1)                                      !--- Profile for table printing
-    ALLOCATE(ttl(nk+2), val(nt,nk+1))
-    ttl(1:2) = ['it  ','name']; ttl(3:nk+2) = isot(ip)%keys(1)%key(:)!--- Titles line with keys names
-    val(:,1) = isot(ip)%keys(:)%name                                 !--- Values table 1st column: isotopes names  
-    DO ik = 1, nk
-      DO it = 1, nt
-        val(it,ik+1) = isot(ip)%keys(it)%val(ik)                     !--- Other columns: keys values
-      END DO
-    END DO
-    lerr = dispTable(prf, ttl, val, cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)
-    IF(fmsg('Problem with the table content', modname, lerr)) RETURN
-    DEALLOCATE(ttl, val)
-  END DO        
-END FUNCTION dispIsotopes
-!------------------------------------------------------------------------------------------------------------------------------
-
-END FUNCTION readIsotopesFile
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== IF ISOTOPES (2ND GENERATION TRACERS) ARE DETECTED:                                                                     ===
-!===    * COMPUTE MOST OF THE RELATED QUANTITIES ("isot" COMPONENTS).                                                       ===
-!===    * COMPUTE FEW ISOTOPES-DEDICATED "trac" COMPONENTS                                                                  ===
-!===    * CALL readIsotopesFile TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS)                                              ===
-!===      NOTE: THIS IS DONE HERE (IN A ROUTINE CALLED BY THE DYNAMIC), BECAUSE THE DYNAMIC NEEDS FEW PHYSICAL PARAMETERS.  ===
-!==============================================================================================================================
-LOGICAL FUNCTION processIsotopes(iNames) RESULT(lerr)
-  CHARACTER(LEN=maxlen), TARGET, OPTIONAL, INTENT(IN)  :: iNames(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: p(:), str(:)                 !--- Temporary storage
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), parent(:), dType(:), phase(:), gen0N(:)
-  CHARACTER(LEN=maxlen) :: iName, modname
-  CHARACTER(LEN=1)   :: ph                                           !--- Phase
-  INTEGER, ALLOCATABLE ::  iGen(:)
-  INTEGER :: ic, ip, iq, it, iz
-  LOGICAL, ALLOCATABLE :: ll(:)                                      !--- Mask
-  TYPE(trac_type), POINTER   ::  t(:), t1
-  TYPE(isot_type), POINTER   ::  i
-
-  lerr = .FALSE.
-  modname = 'readIsotopesFile'
-
-  t => tracers
-
-  lerr = getKey('name',       tname, t%keys); IF(lerr) RETURN       !--- Names
-  lerr = getKey('parent',    parent, t%keys); IF(lerr) RETURN       !--- Parents
-  lerr = getKey('type',       dType, t%keys); IF(lerr) RETURN       !--- Tracer type
-  lerr = getKey('phase',      phase, t%keys); IF(lerr) RETURN       !--- Phase
-  lerr = getKey('gen0Name',   gen0N, t%keys); IF(lerr) RETURN       !--- 1st generation ancestor name
-  lerr = getKey('iGeneration', iGen, t%keys); IF(lerr) RETURN       !--- Generation number
-
-  !--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES
-  p = PACK(delPhase(parent), MASK = dType=='tracer' .AND. iGen==1)
-  CALL strReduce(p, nbIso)
-
-  !--- CHECK WHETHER NEEDED ISOTOPES CLASSES "iNames" ARE AVAILABLE OR NOT
-  IF(PRESENT(iNames)) THEN
-    DO it = 1, SIZE(iNames)
-      lerr = ALL(p /= iNames(it))
-      IF(fmsg('No isotopes class "'//TRIM(iNames(it))//'" found among tracers', modname, lerr)) RETURN
-    END DO
-    p = iNames; nbIso = SIZE(p)
-  END IF
-  IF(ALLOCATED(isotopes)) DEALLOCATE(isotopes)
-  ALLOCATE(isotopes(nbIso))
-
-  IF(nbIso==0) RETURN                                                !=== NO ISOTOPES: FINISHED
-
-  !--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES
-  isotopes(:)%parent = p
-  DO ic = 1, SIZE(p)                                                 !--- Loop on isotopes classes
-    i => isotopes(ic)
-    iname = i%parent                                                 !--- Current isotopes class name (parent tracer name)
-
-    !=== Isotopes children of tracer "iname": mask, names, number (same for each phase of "iname")
-    ll = dType=='tracer' .AND. delPhase(parent) == iname .AND. phase == 'g'
-    str = PACK(delPhase(tname), MASK = ll)                           !--- Effectively found isotopes of "iname"
-    i%niso = SIZE(str)                                               !--- Number of "effectively found isotopes of "iname"
-    ALLOCATE(i%keys(i%niso))
-    FORALL(it = 1:i%niso) i%keys(it)%name = str(it)
-
-    !=== Geographic tagging tracers descending on tracer "iname": mask, names, number
-    ll = dType=='tag'    .AND. delPhase(gen0N) == iname .AND. iGen == 2
-    i%zone = PACK(strTail(tname,'_',.TRUE.), MASK = ll)              !--- Tagging zones names  for isotopes category "iname"
-    CALL strReduce(i%zone)
-    i%nzone = SIZE(i%zone)                                           !--- Tagging zones number for isotopes category "iname"
-
-    !=== Geographic tracers of the isotopes children of tracer "iname" (same for each phase of "iname")
-    !    NOTE: One might like to create a similar variable for 2nd generation tagging tracers (tagging the gen1 tracers)
-    str = PACK(delPhase(tname), MASK=ll)
-    CALL strReduce(str)
-    i%ntiso = i%niso + SIZE(str)                                     !--- Number of isotopes + their geographic tracers [ntiso]
-    ALLOCATE(i%trac(i%ntiso))
-    FORALL(it = 1:i%niso) i%trac(it) = i%keys(it)%name
-    FORALL(it = i%niso+1:i%ntiso) i%trac(it) = str(it-i%niso)
-
-    !=== Phases for tracer "iname"
-    i%phase = ''
-    DO ip = 1, nphases; ph = known_phases(ip:ip); IF(strIdx(t%name,addPhase(iname, ph)) /= 0) i%phase = TRIM(i%phase)//ph; END DO
-    i%nphas = LEN_TRIM(i%phase)                                       !--- Equal to "nqo" for water
-
-    !=== Tables giving the index in a table of effectively found items for each dynamical tracer (1<=iq<=nqtot)
-    DO iq = 1, SIZE(t)
-      t1 => tracers(iq)
-      IF(delPhase(t1%gen0Name)/=iname .OR. t1%iGeneration==0) CYCLE  !--- Only deal with tracers descending on "iname"
-      t1%iso_iGroup = ic                                             !--- Isotopes family       idx in list "isotopes(:)%parent"
-      t1%iso_iName  = strIdx(i%trac, strHead(delPhase(t1%name),'_',.TRUE.)) !--- Current isotope       idx in effective isotopes list
-      t1%iso_iZone  = strIdx(i%zone,          strTail(t1%name, '_',.TRUE.)) !--- Current isotope zone  idx in effective zones    list
-      t1%iso_iPhase =  INDEX(i%phase,TRIM(t1%phase))                 !--- Current isotope phase idx in effective phases   list
-      IF(t1%iGeneration /= 2) t1%iso_iZone = 0                       !--- Skip possible generation 1 tagging tracers
-    END DO
-
-    !=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
-    !    (including tagging tracers) is sorted this way:  iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
-    i%iqIsoPha = RESHAPE( [( (strIdx(t%name,  addPhase(i%trac(it),i%phase(ip:ip))),       it=1, i%ntiso), ip=1, i%nphas)], &
-                         [i%ntiso, i%nphas] )
-    !=== Table used to get iq (index in dyn array, size nqtot) from the water and isotope and phase indexes ; the full isotopes list
-    !    (including tagging tracers) is sorted this way:  iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
-    i%iqWIsoPha = RESHAPE( [( [strIdx(t%name,   addPhase('H2O',i%phase(ip:ip))), i%iqIsoPha(:,ip)], ip=1,i%nphas)], &
-                         [1+i%ntiso, i%nphas] )
-    !=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes
-    i%itZonIso = RESHAPE( [( (strIdx(i%trac(:), TRIM(i%trac(it))//'_'//TRIM(i%zone(iz))), iz=1, i%nzone), it=1, i%niso )], &
-                         [i%nzone, i%niso] )
-  END DO
-
-  !=== READ PHYSICAL PARAMETERS FROM isoFile FILE
-!  lerr = readIsotopesFile(isoFile, isotopes); IF(lerr) RETURN! on commente pour ne pas chercher isotopes_params.def
-
-  !--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
-  CALL get_in('ok_iso_verif', isoCheck, .TRUE.)
-
-  !=== CHECK CONSISTENCY
-  lerr = testIsotopes(); IF(lerr) RETURN
-
-  !=== SELECT WATER ISOTOPES CLASS OR, IF UNFOUND, THE FIRST ISOTOPES CLASS
-  IF(isoSelect('H2O', .TRUE.)) THEN; iH2O = ixIso; ELSE; lerr = isoSelect(1, .TRUE.); END IF
-
-CONTAINS
-
-!------------------------------------------------------------------------------------------------------------------------------
-LOGICAL FUNCTION testIsotopes() RESULT(lerr)     !--- MAKE SURE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: ix, it, ip, np, iz, nz, npha, nzon
-  TYPE(isot_type), POINTER :: i
-  DO ix = 1, nbIso
-    i => isotopes(ix)
-    !--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases
-    DO it = 1, i%ntiso; npha = i%nphas
-      np = SUM([(COUNT(tracers(:)%name == addPhase(i%trac(it), i%phase(ip:ip))), ip=1, npha)])
-      lerr = np /= npha
-      CALL msg(TRIM(int2str(np))//' phases instead of '//TRIM(int2str(npha))//' for '//TRIM(i%trac(it)), modname, lerr)
-      IF(lerr) RETURN
-    END DO
-    DO it = 1, i%niso; nzon = i%nzone
-      nz = SUM([(COUNT(i%trac == TRIM(i%trac(it))//'_'//i%zone(iz)), iz=1, nzon)])
-      lerr = nz /= nzon
-      CALL msg(TRIM(int2str(nz))//' tagging zones instead of '//TRIM(int2str(nzon))//' for '//TRIM(i%trac(it)), modname, lerr)
-      IF(lerr) RETURN
-    END DO
-  END DO
-END FUNCTION testIsotopes
-!------------------------------------------------------------------------------------------------------------------------------
-
-END FUNCTION processIsotopes
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
-!     Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call).
-!==============================================================================================================================
-LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
-   IMPLICIT NONE
-   CHARACTER(LEN=*),  INTENT(IN) :: iName
-   LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
-   INTEGER :: iIso
-   LOGICAL :: lV
-   lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
-   iIso = strIdx(isotopes(:)%parent, iName)
-   lerr = iIso == 0
-   IF(lerr) THEN
-      niso = 0; ntiso = 0; nzone = 0; nphas = 0; isoCheck=.FALSE.
-      CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lV)
-      RETURN
-   END IF
-   lerr = isoSelectByIndex(iIso, lV)
-END FUNCTION isoSelectByName
-!==============================================================================================================================
-LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
-   IMPLICIT NONE
-   INTEGER,           INTENT(IN) :: iIso
-   LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
-   LOGICAL :: lV
-   lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
-   lerr = .FALSE.
-   IF(iIso == ixIso) RETURN                                          !--- Nothing to do if the index is already OK
-   lerr = iIso<=0 .OR. iIso>SIZE(isotopes)
-   CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '&
-          //TRIM(int2str(SIZE(isotopes)))//'"', ll = lerr .AND. lV)
-   IF(lerr) RETURN
-   ixIso = iIso                                                      !--- Update currently selected family index
-   isotope  => isotopes(ixIso)                                       !--- Select corresponding component
-   isoKeys  => isotope%keys;     niso     = isotope%niso
-   isoName  => isotope%trac;     ntiso    = isotope%ntiso
-   isoZone  => isotope%zone;     nzone    = isotope%nzone
-   isoPhas  => isotope%phase;    nphas    = isotope%nphas
-   itZonIso => isotope%itZonIso; isoCheck = isotope%check
-   iqIsoPha => isotope%iqIsoPha
-   iqWIsoPha => isotope%iqWIsoPha
-END FUNCTION isoSelectByIndex
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== ADD THE <key>=<val> PAIR TO THE "ky[(:)]" KEY[S] DESCRIPTOR[S] OR THE <key>=<val(:)> PAIRS TO THE "ky(:)" KEYS DESCRIPTORS
-!==============================================================================================================================
-SUBROUTINE addKey_s11(key, sval, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key, sval
-  TYPE(keys_type),   INTENT(INOUT) :: ky
-  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
-  INTEGER :: iky, nky
-  LOGICAL :: lo
-  lo=.TRUE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
-  IF(.NOT.ALLOCATED(ky%key)) THEN
-    ALLOCATE(ky%key(1)); ky%key(1)=key
-    ALLOCATE(ky%val(1)); ky%val(1)=sval
-    RETURN
-  END IF
-  iky = strIdx(ky%key,key)
-  IF(iky == 0) THEN
-    nky = SIZE(ky%key)
-    ALLOCATE(k(nky+1)); k(1:nky) = ky%key; k(nky+1) = key;  ky%key = k
-    ALLOCATE(v(nky+1)); v(1:nky) = ky%val; v(nky+1) = sval; ky%val = v
-  ELSE IF(lo) THEN
-    ky%key(iky) = key; ky%val(iky) = sval
-  END IF
-END SUBROUTINE addKey_s11
-!==============================================================================================================================
-SUBROUTINE addKey_i11(key, ival, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key
-  INTEGER,           INTENT(IN)    :: ival
-  TYPE(keys_type),   INTENT(INOUT) :: ky
-  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
-!------------------------------------------------------------------------------------------------------------------------------
-  CALL addKey_s11(key, int2str(ival), ky, lOverWrite)
-END SUBROUTINE addKey_i11
-!==============================================================================================================================
-SUBROUTINE addKey_r11(key, rval, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key
-  REAL,              INTENT(IN)    :: rval
-  TYPE(keys_type),   INTENT(INOUT) :: ky
-  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
-!------------------------------------------------------------------------------------------------------------------------------
-  CALL addKey_s11(key, real2str(rval), ky, lOverWrite)
-END SUBROUTINE addKey_r11
-!==============================================================================================================================
-SUBROUTINE addKey_l11(key, lval, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key
-  LOGICAL,           INTENT(IN)    :: lval
-  TYPE(keys_type),   INTENT(INOUT) :: ky
-  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
-!------------------------------------------------------------------------------------------------------------------------------
-  CALL addKey_s11(key, bool2str(lval), ky, lOverWrite)
-END SUBROUTINE addKey_l11
-!==============================================================================================================================
-!==============================================================================================================================
-SUBROUTINE addKey_s1m(key, sval, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key, sval
-  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
-  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: itr
-  DO itr = 1, SIZE(ky); CALL addKey_s11(key, sval, ky(itr), lOverWrite); END DO
-END SUBROUTINE addKey_s1m
-!==============================================================================================================================
-SUBROUTINE addKey_i1m(key, ival, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key
-  INTEGER,           INTENT(IN)    :: ival
-  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
-  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: itr
-  DO itr = 1, SIZE(ky); CALL addKey_s11(key, int2str(ival), ky(itr), lOverWrite); END DO
-END SUBROUTINE addKey_i1m
-!==============================================================================================================================
-SUBROUTINE addKey_r1m(key, rval, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key
-  REAL,              INTENT(IN)    :: rval
-  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
-  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: itr
-  DO itr = 1, SIZE(ky); CALL addKey_s11(key, real2str(rval), ky(itr), lOverWrite); END DO
-END SUBROUTINE addKey_r1m
-!==============================================================================================================================
-SUBROUTINE addKey_l1m(key, lval, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key
-  LOGICAL,           INTENT(IN)    :: lval
-  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
-  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: itr
-  DO itr = 1, SIZE(ky); CALL addKey_s11(key, bool2str(lval), ky(itr), lOverWrite); END DO
-END SUBROUTINE addKey_l1m
-!==============================================================================================================================
-!==============================================================================================================================
-SUBROUTINE addKey_smm(key, sval, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key, sval(:)
-  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
-  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: itr
-  DO itr = 1, SIZE(ky); CALL addKey_s11(key, sval(itr), ky(itr), lOverWrite); END DO
-END SUBROUTINE addKey_smm
-!==============================================================================================================================
-SUBROUTINE addKey_imm(key, ival, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key
-  INTEGER,           INTENT(IN)    :: ival(:)
-  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
-  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: itr
-  DO itr = 1, SIZE(ky); CALL addKey_s11(key, int2str(ival(itr)), ky(itr), lOverWrite); END DO
-END SUBROUTINE addKey_imm
-!==============================================================================================================================
-SUBROUTINE addKey_rmm(key, rval, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key
-  REAL,              INTENT(IN)    :: rval(:)
-  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
-  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: itr
-  DO itr = 1, SIZE(ky); CALL addKey_s11(key, real2str(rval(itr)), ky(itr), lOverWrite); END DO
-END SUBROUTINE addKey_rmm
-!==============================================================================================================================
-SUBROUTINE addKey_lmm(key, lval, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key
-  LOGICAL,           INTENT(IN)    :: lval(:)
-  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
-  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: itr
-  DO itr = 1, SIZE(ky); CALL addKey_s11(key, bool2str(lval(itr)), ky(itr), lOverWrite); END DO
-END SUBROUTINE addKey_lmm
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== OVERWRITE THE KEYS OF THE TRACER NAMED "tr0" WITH THE VALUES FOUND IN THE *.def FILES, IF ANY. ===========================
-!==============================================================================================================================
-SUBROUTINE addKeysFromDef(t, tr0)
-  TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: t(:)
-  CHARACTER(LEN=*),             INTENT(IN)    :: tr0
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: val
-  INTEGER               :: ik, jd
-  jd = strIdx(t%name, tr0)
-  IF(jd == 0) RETURN
-  DO ik = 1, SIZE(t(jd)%keys%key)
-    CALL get_in(t(jd)%keys%key(ik), val, '*none*')
-    IF(val /= '*none*') CALL addKey(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.)
-  END DO
-END SUBROUTINE addKeysFromDef
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== REMOVE THE KEYS NAMED "keyn(:)" FROM EITHER THE "itr"th OR ALL THE KEYS DESCRIPTORS OF "ky(:)" ===========================
-!==============================================================================================================================
-SUBROUTINE delKey_1(itr, keyn, ky)
-  INTEGER,          INTENT(IN)    :: itr
-  CHARACTER(LEN=*), INTENT(IN)    :: keyn(:)
-  TYPE(trac_type),  INTENT(INOUT) :: ky(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
-  LOGICAL,               ALLOCATABLE :: ll(:)
-  INTEGER :: iky
-  IF(itr<=0 .OR. itr>SIZE(ky, DIM=1)) RETURN                          !--- Index is out of range
-  ll = [( ALL(keyn/=ky(itr)%keys%key(iky)), iky=1, SIZE(ky(itr)%keys%key) )]
-  k = PACK(ky(itr)%keys%key, MASK=ll); CALL MOVE_ALLOC(FROM=k, TO=ky(itr)%keys%key)
-  v = PACK(ky(itr)%keys%val, MASK=ll); CALL MOVE_ALLOC(FROM=v, TO=ky(itr)%keys%val)
-END SUBROUTINE delKey_1
-!==============================================================================================================================
-SUBROUTINE delKey(keyn, ky)
-  CHARACTER(LEN=*), INTENT(IN)    :: keyn(:)
-  TYPE(trac_type),  INTENT(INOUT) :: ky(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: iky
-  DO iky = 1, SIZE(ky); CALL delKey_1(iky, keyn, ky); END DO
-END SUBROUTINE delKey
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!===   INTERNAL FUNCTION: GET THE VALUE OF A KEY FOR "itr"th TRACER FROM A "keys_type" DERIVED TYPE AND RETURN THE RESULT   ===
-!===   IF keyn CONTAINS SEVERAL ELEMENTS, TRY WITH EACH ELEMENT ONE AFTER THE OTHER                                         ===
-!==============================================================================================================================
-CHARACTER(LEN=maxlen) FUNCTION fgetKeyIdx(itr, keyn, ky, lerr) RESULT(val)
-  INTEGER,                    INTENT(IN)  :: itr
-  CHARACTER(LEN=*),           INTENT(IN)  :: keyn(:)
-  TYPE(keys_type),            INTENT(IN)  :: ky(:)
-  LOGICAL,          OPTIONAL, INTENT(OUT) :: lerr
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: ik
-  LOGICAL :: ler
-  ler = .TRUE.
-  DO ik = 1, SIZE(keyn)
-    CALL getKeyIdx(keyn(ik)); IF(.NOT.ler) EXIT
-  END DO
-  IF(PRESENT(lerr)) lerr = ler
-
-CONTAINS
-
-SUBROUTINE getKeyIdx(keyn)
-  CHARACTER(LEN=*), INTENT(IN) :: keyn
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: iky
-  iky = 0; val = ''
-  ler = itr <= 0 .OR. itr > SIZE(ky); IF(ler) RETURN
-  iky = strIdx(ky(itr)%key(:), keyn)
-  ler = iky == 0;                     IF(ler) RETURN
-  val = ky(itr)%val(iky)
-END SUBROUTINE getKeyIdx
-
-END FUNCTION fgetKeyIdx
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!===                                          GET KEYS VALUES FROM TRACERS INDICES                                          ===
-!==============================================================================================================================
-!=== TRY TO GET THE KEY NAMED "key" FOR THE "itr"th TRACER IN:                                                              ===
-!===  * ARGUMENT "ky" DATABASE IF SPECIFIED ; OTHERWISE:                                                                    ===
-!===  * IN INTERNAL TRACERS DATABASE "tracers(:)%keys" (IF UNFOUND, IN INTERNAL ISOTOPES DATABASE "isotope%keys(:)")        ===
-!=== THE RETURNED VALUE (STRING, AN INTEGER, A REAL OR A LOGICAL) CAN BE EITHER:                                            ===
-!===  * A SCALAR                                                                                                            ===
-!===  * A VECTOR, WHICH IS THE FOUND VALUE PARSED WITH THE SEPARATOR ","                                                    ===
-!===                                                                                                                        ===
-!=== SYNTAX:       lerr = getKeyByIndex_{sirl}{1m}{1m}1(keyn[(:)], val[(:)], itr[, ky(:)]          [, def][, lDisp])        ===
-!==============================================================================================================================
-!=== IF "itr" IS NOT PRESENT, VALUES FOR ALL THE TRACERS OF THE SELECTED DATABASE ARE STORED IN THE VECTOR "val(:)"         ===
-!=== THE NAME OF THE TRACERS FOUND IN THE EFFECTIVELY USED DATABASE CAN BE RETURNED OPTIONALLY IN "nam(:)"                  ===
-!=== SYNTAX        lerr = getKeyByIndex_{sirl}{1m}mm   (keyn[(:)], val (:)      [, ky(:)][, nam(:)][, def][, lDisp])        ===
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_s111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
-  CHARACTER(LEN=maxlen),     INTENT(OUT) :: val
-  INTEGER,                   INTENT(IN)  :: itr
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  CHARACTER(LEN=*),OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-  lerr = getKeyByIndex_sm11([keyn], val, itr, ky, def, lDisp)
-END FUNCTION getKeyByIndex_s111
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_i111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
-  INTEGER,                   INTENT(OUT) :: val
-  INTEGER,                   INTENT(IN)  :: itr
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  INTEGER,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-  lerr = getKeyByIndex_im11([keyn], val, itr, ky, def, lDisp)
-END FUNCTION getKeyByIndex_i111
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_r111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
-  REAL   ,                   INTENT(OUT) :: val
-  INTEGER,                   INTENT(IN)  :: itr
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  REAL,            OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-  lerr = getKeyByIndex_rm11([keyn], val, itr, ky, def, lDisp)
-END FUNCTION getKeyByIndex_r111
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_l111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
-  LOGICAL,                   INTENT(OUT) :: val
-  INTEGER,                   INTENT(IN)  :: itr
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-  lerr = getKeyByIndex_lm11([keyn], val, itr, ky, def, lDisp)
-END FUNCTION getKeyByIndex_l111
-!==============================================================================================================================
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_sm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
-  CHARACTER(LEN=maxlen),     INTENT(OUT) :: val
-  INTEGER,                   INTENT(IN)  :: itr
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  CHARACTER(LEN=*),OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: s
-  LOGICAL :: lD
-  lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" for tracer nr. '//TRIM(int2str(itr))
-  lerr = .TRUE.
-  IF(lerr .AND. PRESENT(ky))         val = fgetKey(ky)                                   !--- "ky"
-  IF(lerr .AND. ALLOCATED (tracers)) val = fgetKey(tracers(:)%keys)                      !--- "tracers"
-  IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:))                      !--- "isotope"
-  IF(lerr .AND. PRESENT(def)) THEN
-     val = def; lerr = .NOT.PRESENT(def)
-     CALL msg('Using defaut value of '//TRIM(s)//': '//TRIM(def), modname, lD)
-  END IF
-  CALL msg('No '//TRIM(s)//' or out of bounds index', modname, lD .AND. lerr)
-
-CONTAINS
-
-CHARACTER(LEN=maxlen) FUNCTION fgetKey(ky) RESULT(val)
-  TYPE(keys_type),  INTENT(IN)  :: ky(:)
-  lerr = SIZE(ky) == 0; IF(lerr) RETURN
-  val = fgetKeyIdx(itr, keyn(:), ky, lerr)
-END FUNCTION fgetKey
-
-END FUNCTION getKeyByIndex_sm11
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_im11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
-  INTEGER,                   INTENT(OUT) :: val
-  INTEGER,                   INTENT(IN)  :: itr
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  INTEGER,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: sval, s
-  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, int2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  val = str2int(sval)
-  lerr = val == -HUGE(1)
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
-  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
-END FUNCTION getKeyByIndex_im11
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_rm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
-  REAL   ,                   INTENT(OUT) :: val
-  INTEGER,                   INTENT(IN)  :: itr
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  REAL,            OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: sval, s
-  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, real2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  val = str2real(sval)
-  lerr = val == -HUGE(1.)
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
-  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
-END FUNCTION getKeyByIndex_rm11
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_lm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
-  LOGICAL,                   INTENT(OUT) :: val
-  INTEGER,                   INTENT(IN)  :: itr
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: sval, s
-  INTEGER               :: ival
-  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, bool2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  ival = str2bool(sval)
-  lerr = ival == -1
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
-  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
-  IF(.NOT.lerr) val = ival == 1
-END FUNCTION getKeyByIndex_lm11
-!==============================================================================================================================
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_s1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn
-  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
-  INTEGER,                            INTENT(IN)  :: itr
-  TYPE(keys_type),          OPTIONAL, INTENT(IN)  :: ky(:)
-  CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,                  OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)              :: sval
-  lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, def, lDisp); IF(lerr) RETURN
-  lerr = strParse(sval, ',', val)
-  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
-END FUNCTION getKeyByIndex_s1m1
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_i1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
-  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
-  INTEGER,                   INTENT(IN)  :: itr
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  INTEGER,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)              :: sval, s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
-  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, int2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  lerr = strParse(sval, ',', svals)
-  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
-  val = str2int(svals)
-  lerr = ANY(val == -HUGE(1))
-  s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
-  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
-END FUNCTION getKeyByIndex_i1m1
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_r1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
-  REAL,         ALLOCATABLE, INTENT(OUT) :: val(:)
-  INTEGER,                   INTENT(IN)  :: itr
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  REAL,            OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)              :: sval, s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
-  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, real2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
-  lerr = strParse(sval, ',', svals)
-  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
-  val = str2real(svals)
-  lerr = ANY(val == -HUGE(1.))
-  s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
-  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
-END FUNCTION getKeyByIndex_r1m1
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_l1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
-  LOGICAL,      ALLOCATABLE, INTENT(OUT) :: val(:)
-  INTEGER,                   INTENT(IN)  :: itr
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)              :: sval, s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
-  INTEGER,               ALLOCATABLE :: ivals(:)
-  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, bool2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
-  lerr = strParse(sval, ',', svals)
-  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
-  ivals = str2bool(svals)
-  lerr = ANY(ivals == -1)
-  s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
-  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
-  IF(.NOT.lerr) val = ivals == 1
-END FUNCTION getKeyByIndex_l1m1
-!==============================================================================================================================
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_smm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
-  INTEGER,                            INTENT(IN)  :: itr
-  TYPE(keys_type),          OPTIONAL, INTENT(IN)  :: ky(:)
-  CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,                  OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: sval
-  lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, def, lDisp); IF(lerr) RETURN
-  lerr = strParse(sval, ',', val)
-  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
-END FUNCTION getKeyByIndex_smm1
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_imm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
-  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
-  INTEGER,                   INTENT(IN)  :: itr
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  INTEGER,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)              :: sval, s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
-  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, int2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  lerr = strParse(sval, ',', svals)
-  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
-  val = str2int(svals)
-  lerr = ANY(val == -HUGE(1))
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
-  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
-END FUNCTION getKeyByIndex_imm1
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_rmm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
-  REAL,         ALLOCATABLE, INTENT(OUT) :: val(:)
-  INTEGER,                   INTENT(IN)  :: itr
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  REAL,            OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)              :: sval, s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
-  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, real2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  lerr = strParse(sval, ',', svals)
-  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
-  val = str2real(svals)
-  lerr = ANY(val == -HUGE(1.))
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
-  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
-END FUNCTION getKeyByIndex_rmm1
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_lmm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
-  LOGICAL,      ALLOCATABLE, INTENT(OUT) :: val(:)
-  INTEGER,                   INTENT(IN)  :: itr
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)              :: sval, s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
-  INTEGER,               ALLOCATABLE :: ivals(:)
-  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, bool2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  lerr = strParse(sval, ',', svals)
-  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
-  ivals = str2bool(svals)
-  lerr = ANY(ivals == -1)
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
-  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
-  IF(.NOT.lerr) val = ivals == 1
-END FUNCTION getKeyByIndex_lmm1
-!==============================================================================================================================
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_s1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
-  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: val(:)
-  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::  ky(:)
-  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
-  CHARACTER(LEN=*),      OPTIONAL,              INTENT(IN)  :: def
-  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
-  lerr = getKeyByIndex_smmm([keyn], val, ky, nam, def, lDisp)
-END FUNCTION getKeyByIndex_s1mm
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_i1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
-  INTEGER,                         ALLOCATABLE, INTENT(OUT) :: val(:)
-  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::  ky(:)
-  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
-  INTEGER,               OPTIONAL,              INTENT(IN)  :: def
-  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
-  lerr = getKeyByIndex_immm([keyn], val, ky, nam, def, lDisp)
-END FUNCTION getKeyByIndex_i1mm
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_r1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
-  REAL,                            ALLOCATABLE, INTENT(OUT) :: val(:)
-  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::  ky(:)
-  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
-  REAL,                  OPTIONAL,              INTENT(IN)  :: def
-  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
-  lerr = getKeyByIndex_rmmm([keyn], val, ky, nam, def, lDisp)
-END FUNCTION getKeyByIndex_r1mm
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_l1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
-  LOGICAL,                         ALLOCATABLE, INTENT(OUT) :: val(:)
-  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::  ky(:)
-  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
-  LOGICAL,               OPTIONAL,              INTENT(IN)  :: def
-  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
-  lerr = getKeyByIndex_lmmm([keyn], val, ky, nam, def, lDisp)
-END FUNCTION getKeyByIndex_l1mm
-!==============================================================================================================================
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_smmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn(:)
-  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) ::  val(:)
-  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
-  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
-  CHARACTER(LEN=*),      OPTIONAL,              INTENT(IN)  ::  def
-  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:)
-  INTEGER :: iq, nq(3), k
-  LOGICAL :: lD, l(3)
-  lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'"'
-  lerr = .TRUE.
-  IF(PRESENT(ky)) THEN;                 val = fgetKey(ky)                                !--- "ky"
-  ELSE IF(ALLOCATED(tracers)) THEN;     val = fgetKey(tracers(:)%keys)                   !--- "tracers"
-     IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:))                   !--- "isotope"
-  END IF
-  IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN; END IF
-  IF(.NOT.PRESENT(def)) THEN; CALL msg('No '//TRIM(s)//' found', modname, lD); RETURN; END IF
-
-  !--- DEFAULT VALUE
-  l = [PRESENT(ky), ALLOCATED(tracers), ASSOCIATED(isotope)]; nq(:) = 0
-  IF(l(1)) nq(1) = SIZE(ky)
-  IF(l(2)) nq(2) = SIZE(tracers)
-  IF(l(3)) nq(3) = SIZE(isotope%keys)
-  DO k = 1, 3; IF(l(k) .AND. nq(k) /= 0) THEN; val = [(def, iq = 1, nq(k))]; EXIT; END IF; END DO
-  lerr = k == 4
-  CALL msg('Using defaut value for '//TRIM(s)//': '//TRIM(def), modname, lD .AND. .NOT.lerr)
-  CALL msg('No '//TRIM(s), modname, lD .AND. lerr)
-
-CONTAINS
-
-FUNCTION fgetKey(ky) RESULT(val)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)
-  TYPE(keys_type),       INTENT(IN)  :: ky(:)
-  LOGICAL :: ler(SIZE(ky))
-  INTEGER :: iq
-  lerr = SIZE(ky) == 0; IF(lerr) RETURN
-  tname = ky%name
-  val = [(fgetKeyIdx(iq, keyn(:), ky, ler(iq)), iq = 1, SIZE(ky))]
-  lerr = ANY(ler)
-END FUNCTION fgetKey
-
-END FUNCTION getKeyByIndex_smmm
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_immm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn(:)
-  INTEGER,                         ALLOCATABLE, INTENT(OUT) ::  val(:)
-  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
-  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
-  INTEGER,               OPTIONAL,              INTENT(IN)  ::  def
-  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
-  LOGICAL,               ALLOCATABLE ::    ll(:)
-  IF(     PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, int2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp=lDisp)
-  IF(lerr) RETURN
-  val = str2int(svals)
-  ll = val == -HUGE(1)
-  lerr = ANY(ll); IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN; END IF
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(PACK(tname, MASK=ll)))//' is not'
-  CALL msg(TRIM(s)//' an integer: '//TRIM(strStack(svals, MASK=ll)), modname, lerr)
-  IF(.NOT.lerr .AND. PRESENT(nam)) nam = tname
-END FUNCTION getKeyByIndex_immm
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_rmmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn(:)
-  REAL,                            ALLOCATABLE, INTENT(OUT) ::  val(:)
-  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
-  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
-  REAL,                  OPTIONAL,              INTENT(IN)  ::  def
-  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
-  LOGICAL,               ALLOCATABLE ::    ll(:)
-  IF(     PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, real2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp=lDisp)
-  IF(lerr) RETURN
-  val = str2real(svals)
-  ll = val == -HUGE(1.)
-  lerr = ANY(ll); IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN; END IF
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(PACK(tname, MASK=ll)))//' is not a'
-  CALL msg(TRIM(s)//' a real: '//TRIM(strStack(svals, MASK=ll)), modname)
-END FUNCTION getKeyByIndex_rmmm
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByIndex_lmmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn(:)
-  LOGICAL,                         ALLOCATABLE, INTENT(OUT) ::  val(:)
-  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
-  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
-  LOGICAL,               OPTIONAL,              INTENT(IN)  ::  def
-  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
-  LOGICAL,               ALLOCATABLE ::    ll(:)
-  INTEGER,               ALLOCATABLE :: ivals(:)
-  IF(     PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, bool2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp=lDisp)
-  IF(lerr) RETURN
-  ivals = str2bool(svals)
-  ll = ivals == -1
-  lerr = ANY(ll); IF(.NOT.lerr) THEN; val = ivals == 1; IF(PRESENT(nam)) nam = tname; RETURN; END IF
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
-  CALL msg(TRIM(s)//' a boolean: '//TRIM(strStack(svals, MASK=ll)), modname)
-END FUNCTION getKeyByIndex_lmmm
-!==============================================================================================================================
-
-
-
-!==============================================================================================================================
-!===                                           GET KEYS VALUES FROM TRACERS NAMES                                           ===
-!==============================================================================================================================
-!=== TRY TO GET THE KEY NAMED "key" FOR THE TRACER NAMED "tname" IN:                                                        ===
-!===  * ARGUMENT "ky" DATABASE IF SPECIFIED ; OTHERWISE:                                                                    ===
-!===  * IN INTERNAL TRACERS DATABASE "tracers(:)%keys" (IF UNFOUND, IN INTERNAL ISOTOPES DATABASE "isotope%keys(:)")        ===
-!=== THE RETURNED VALUE (STRING, AN INTEGER, A REAL OR A LOGICAL) CAN BE EITHER:                                            ===
-!===  * A SCALAR                                                                                                            ===
-!===  * A VECTOR, WHICH IS THE FOUND VALUE PARSED WITH THE SEPARATOR ","                                                    ===
-!===                                                                                                                        ===
-!=== SYNTAX:       lerr = getKeyByName_{sirl}{1m}{1m}1(keyn[(:)], val[(:)], tname  [, ky(:)][, def][, lDisp])               ===
-!==============================================================================================================================
-!=== IF "tname(:)" IS A VECTOR, THE RETURNED VALUES (ONE EACH "tname(:)" ELEMENT) ARE STORED IN THE VECTOR "val(:)"         ===
-!===                                                                                                                        ===
-!=== SYNTAX        lerr = getKeyByName_{sirl}{1m}mm   (keyn[(:)], val (:), tname(:)[, ky(:)][, def][, lDisp])               ===
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_s111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
-  CHARACTER(LEN=maxlen),     INTENT(OUT) :: val
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  CHARACTER(LEN=*),OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-  lerr = getKeyByName_sm11([keyn], val, tname, ky, def, lDisp)
-END FUNCTION getKeyByName_s111
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_i111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
-  INTEGER,                   INTENT(OUT) :: val
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  INTEGER,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-  lerr = getKeyByName_im11([keyn], val, tname, ky, def, lDisp)
-END FUNCTION getKeyByName_i111
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_r111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
-  REAL   ,                   INTENT(OUT) :: val
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  REAL,            OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-  lerr = getKeyByName_rm11([keyn], val, tname, ky, def, lDisp)
-END FUNCTION getKeyByName_r111
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_l111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
-  LOGICAL,                   INTENT(OUT) :: val
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-  lerr = getKeyByName_lm11([keyn], val, tname, ky, def, lDisp)
-END FUNCTION getKeyByName_l111
-!==============================================================================================================================
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_sm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
-  CHARACTER(LEN=maxlen),     INTENT(OUT) :: val
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  CHARACTER(LEN=*),OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: s, tnam
-  LOGICAL :: lD
-  lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" for "'//TRIM(tname)//'"'
-  lerr = .TRUE.
-  tnam = strHead(delPhase(tname),'_',.TRUE.)                                             !--- Remove phase and tag
-  IF(lerr .AND. PRESENT(ky))         val = fgetKey(ky)                                   !--- "ky"
-  IF(lerr .AND. ALLOCATED (tracers)) val = fgetKey(tracers(:)%keys)                      !--- "tracers"
-  IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:))                      !--- "isotope"
-  IF(lerr .AND. PRESENT(def)) THEN
-     val = def; lerr = .NOT.PRESENT(def)
-     CALL msg('Using defaut value of '//TRIM(s)//': '//TRIM(def), modname, lD)
-  END IF
-  CALL msg('No '//TRIM(s)//' or out of bounds index', modname, lD .AND. lerr)
-
-CONTAINS
-
- CHARACTER(LEN=maxlen) FUNCTION fgetKey(ky) RESULT(val)
-  TYPE(keys_type),  INTENT(IN)  :: ky(:)
-  lerr = SIZE(ky) == 0
-  IF(lerr) RETURN
-           val = fgetKeyIdx(strIdx(ky%name, tname), [keyn], ky, lerr)
-  IF(lerr) val = fgetKeyIdx(strIdx(ky%name, tnam ), [keyn], ky, lerr)
-
-END FUNCTION fgetKey
-
-END FUNCTION getKeyByName_sm11
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_im11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
-  INTEGER,                   INTENT(OUT) :: val
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  INTEGER,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: sval, s
-  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, int2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  val = str2int(sval)
-  lerr = val == -HUGE(1)
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
-  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
-END FUNCTION getKeyByName_im11
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_rm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
-  REAL   ,                   INTENT(OUT) :: val
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  REAL,            OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: sval, s
-  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, real2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  val = str2real(sval)
-  lerr = val == -HUGE(1.)
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
-  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
-END FUNCTION getKeyByName_rm11
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_lm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
-  LOGICAL,                   INTENT(OUT) :: val
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: sval, s
-  INTEGER               :: ival
-  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, bool2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  ival = str2bool(sval)
-  lerr = ival == -1
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
-  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
-  IF(.NOT.lerr) val = ival == 1
-END FUNCTION getKeyByName_lm11
-!==============================================================================================================================
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_s1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn, tname
-  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
-  TYPE(keys_type),          OPTIONAL, INTENT(IN)  :: ky(:)
-  CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,                  OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)              :: sval
-  lerr = getKeyByName_sm11([keyn], sval, tname, ky, def, lDisp); IF(lerr) RETURN
-  lerr = strParse(sval, ',', val)
-  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
-END FUNCTION getKeyByName_s1m1
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_i1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
-  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  INTEGER,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)              :: sval, s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
-  IF(     PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, int2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  lerr = strParse(sval, ',', svals)
-  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
-  val = str2int(svals)
-  lerr = ANY(val == -HUGE(1))
-  s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
-  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
-END FUNCTION getKeyByName_i1m1
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_r1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
-  REAL,         ALLOCATABLE, INTENT(OUT) :: val(:)
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  REAL,            OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)              :: sval, s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
-  IF(     PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, real2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  lerr = strParse(sval, ',', svals)
-  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
-  val = str2real(svals)
-  lerr = ANY(val == -HUGE(1.))
-  s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
-  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
-END FUNCTION getKeyByName_r1m1
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_l1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
-  LOGICAL,      ALLOCATABLE, INTENT(OUT) :: val(:)
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)              :: sval, s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
-  INTEGER,               ALLOCATABLE :: ivals(:)
-  IF(     PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, bool2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  lerr = strParse(sval, ',', svals)
-  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
-  ivals = str2bool(svals)
-  lerr = ANY(ivals == -1)
-  s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
-  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
-  IF(.NOT.lerr) val = ivals == 1
-END FUNCTION getKeyByName_l1m1
-!==============================================================================================================================
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_smm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn(:), tname
-  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
-  TYPE(keys_type),          OPTIONAL, INTENT(IN)  :: ky(:)
-  CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,                  OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: sval
-  lerr = getKeyByName_sm11(keyn, sval, tname, ky, def, lDisp); IF(lerr) RETURN
-  lerr = strParse(sval, ',', val)
-  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
-END FUNCTION getKeyByName_smm1
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_imm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
-  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  INTEGER,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)              :: sval, s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
-  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, int2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  lerr = strParse(sval, ',', svals)
-  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
-  val = str2int(svals)
-  lerr = ANY(val == -HUGE(1))
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
-  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
-END FUNCTION getKeyByName_imm1
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_rmm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
-  REAL,         ALLOCATABLE, INTENT(OUT) :: val(:)
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  REAL,            OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)              :: sval, s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
-  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, real2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  lerr = strParse(sval, ',', svals)
-  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
-  val = str2real(svals)
-  lerr = ANY(val == -HUGE(1.))
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
-  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
-END FUNCTION getKeyByName_rmm1
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_lmm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
-  LOGICAL,      ALLOCATABLE, INTENT(OUT) :: val(:)
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)              :: sval, s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
-  INTEGER,               ALLOCATABLE :: ivals(:)
-  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, bool2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  lerr = strParse(sval, ',', svals)
-  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
-  ivals = str2bool(svals)
-  lerr = ANY(ivals == -1)
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
-  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
-  IF(.NOT.lerr) val = ivals == 1
-END FUNCTION getKeyByName_lmm1
-!==============================================================================================================================
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_s1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn, tname(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
-  TYPE(keys_type),       OPTIONAL,    INTENT(IN)  ::  ky(:)
-  CHARACTER(LEN=*),      OPTIONAL,    INTENT(IN)  :: def
-  LOGICAL,               OPTIONAL,    INTENT(IN)  :: lDisp
-  lerr = getKeyByName_smmm([keyn], val, tname, ky, def, lDisp)
-END FUNCTION getKeyByName_s1mm
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_i1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname(:)
-  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::  ky(:)
-  INTEGER,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-  lerr = getKeyByName_immm([keyn], val, tname, ky, def, lDisp)
-END FUNCTION getKeyByName_i1mm
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_r1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname(:)
-  REAL,         ALLOCATABLE, INTENT(OUT) :: val(:)
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::  ky(:)
-  REAL,            OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-  lerr = getKeyByName_rmmm([keyn], val, tname, ky, def, lDisp)
-END FUNCTION getKeyByName_r1mm
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_l1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname(:)
-  LOGICAL,      ALLOCATABLE, INTENT(OUT) :: val(:)
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::  ky(:)
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-  lerr = getKeyByName_lmmm([keyn], val, tname, ky, def, lDisp)
-END FUNCTION getKeyByName_l1mm
-!==============================================================================================================================
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_smmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn(:), tname(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) ::  val(:)
-  TYPE(keys_type),       OPTIONAL,    INTENT(IN)  ::   ky(:)
-  CHARACTER(LEN=*),      OPTIONAL,    INTENT(IN)  ::   def
-  LOGICAL,               OPTIONAL,    INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: s
-  INTEGER :: iq, nq
-  LOGICAL :: lD
-  nq = SIZE(tname); ALLOCATE(val(nq))
-  lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'"'
-  lerr = .TRUE.
-  IF(PRESENT(ky)) THEN;                 val = fgetKey(ky)                                !--- "ky"
-  ELSE IF(ALLOCATED(tracers)) THEN;     val = fgetKey(tracers(:)%keys)                   !--- "tracers"
-     IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:))                   !--- "isotope"
-  END IF
-  IF(.NOT.PRESENT(def)) THEN; CALL msg('No '//TRIM(s)//' found', modname, lD); RETURN; END IF
-
-  !--- DEFAULT VALUE
-  val = [(def, iq = 1, SIZE(tname))]
-  CALL msg('Using defaut value for '//TRIM(s)//': '//TRIM(def), modname, lD)
-
-CONTAINS
-
-FUNCTION fgetKey(ky) RESULT(val)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)
-  TYPE(keys_type),       INTENT(IN)  :: ky(:)
-  LOGICAL,               ALLOCATABLE :: ler(:)
-  lerr = SIZE(ky) == 0; IF(lerr) RETURN
-  ALLOCATE(ler(SIZE(tname)))
-  val = [(fgetKeyIdx(strIdx(ky(:)%name, tname(iq)), keyn, ky, ler(iq)), iq = 1, SIZE(tname))]
-  lerr = ANY(ler)
-END FUNCTION fgetKey
-
-END FUNCTION getKeyByName_smmm
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_immm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname(:)
-  INTEGER,      ALLOCATABLE, INTENT(OUT) ::  val(:)
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::   ky(:)
-  INTEGER,         OPTIONAL, INTENT(IN)  ::  def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
-  LOGICAL,               ALLOCATABLE ::    ll(:)
-  IF(     PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, int2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  val = str2int(svals)
-  ll = val == -HUGE(1)
-  lerr = ANY(ll); IF(.NOT.lerr) RETURN
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
-  CALL msg(TRIM(s)//' an integer: '//TRIM(strStack(svals, MASK=ll)), modname)
-END FUNCTION getKeyByName_immm
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_rmmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname(:)
-  REAL,         ALLOCATABLE, INTENT(OUT) ::  val(:)
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::   ky(:)
-  REAL,            OPTIONAL, INTENT(IN)  ::  def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
-  LOGICAL,               ALLOCATABLE ::    ll(:)
-  IF(     PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, real2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  val = str2real(svals)
-  ll = val == -HUGE(1.)
-  lerr = ANY(ll); IF(.NOT.lerr) RETURN
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
-  CALL msg(TRIM(s)//' a real: '//TRIM(strStack(svals, MASK=ll)), modname)
-END FUNCTION getKeyByName_rmmm
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_lmmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname(:)
-  LOGICAL,      ALLOCATABLE, INTENT(OUT) ::  val(:)
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::   ky(:)
-  LOGICAL,         OPTIONAL, INTENT(IN)  ::  def
-  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: s
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
-  LOGICAL,               ALLOCATABLE ::    ll(:)
-  INTEGER,               ALLOCATABLE :: ivals(:)
-  IF(     PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, bool2str(def), lDisp)
-  IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
-  IF(lerr) RETURN
-  ivals = str2bool(svals)
-  ll = ivals == -1
-  lerr = ANY(ll); IF(.NOT.lerr) THEN; val = ivals == 1; RETURN; END IF
-  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
-  CALL msg(TRIM(s)//' a boolean: '//TRIM(strStack(svals, MASK=ll)), modname)
-END FUNCTION getKeyByName_lmmm
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== ROUTINES TO GET OR PUT TRACERS AND ISOTOPES DATABASES, SINCE tracers AND isotopes ARE PRIVATE VARIABLES ==================
-!==============================================================================================================================
-SUBROUTINE setKeysDBase(tracers_, isotopes_, isotope_)
-  TYPE(trac_type), OPTIONAL, INTENT(IN) ::  tracers_(:)
-  TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotopes_(:)
-  TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotope_
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE(isot_type), ALLOCATABLE :: iso(:)
-  INTEGER :: ix, nbIso
-  IF(PRESENT( tracers_)) THEN;  tracers =  tracers_; ELSE; ALLOCATE( tracers(0)); END IF
-  IF(PRESENT(isotopes_)) THEN; isotopes = isotopes_; ELSE; ALLOCATE(isotopes(0)); END IF
-  IF(PRESENT(isotope_ )) THEN
-    ix = strIdx(isotopes(:)%parent, isotope_%parent)
-    IF(ix /= 0) THEN
-      isotopes(ix) = isotope_
-    ELSE
-      nbIso = SIZE(isotopes); ALLOCATE(iso(nbIso+1)); iso(1:nbIso) = isotopes; iso(nbIso+1) = isotope_
-      CALL MOVE_ALLOC(FROM=iso, TO=isotopes)
-    END IF
-  END IF
-END SUBROUTINE setKeysDBase
-!==============================================================================================================================
-SUBROUTINE getKeysDBase(tracers_, isotopes_, isotope_)
-  TYPE(trac_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  tracers_(:)
-  TYPE(isot_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: isotopes_(:)
-  TYPE(isot_type), OPTIONAL,              INTENT(OUT) :: isotope_
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: ix
-  IF(PRESENT( tracers_)) THEN;  tracers_ =  tracers; ELSE; ALLOCATE( tracers_(0)); END IF
-  IF(PRESENT(isotopes_)) THEN; isotopes_ = isotopes; ELSE; ALLOCATE(isotopes_(0)); END IF
-  IF(PRESENT(isotope_ )) THEN; ix = strIdx(isotopes(:)%parent, isotope%parent); IF(ix /= 0) isotope_=isotopes(ix); END IF
-END SUBROUTINE getKeysDBase
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== REMOVE, IF ANY, OR ADD THE PHASE SUFFIX OF THE TRACER NAMED "s" ==========================================================
-!==============================================================================================================================
-ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION delPhase(s) RESULT(out)
-  CHARACTER(LEN=*), INTENT(IN) :: s
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: ix, ip, ns
-  out = s; ns = LEN_TRIM(s)
-  IF(s == '' .OR. ns<=2) RETURN                                                !--- Empty string or LEN(name)<=2: nothing to do
-  IF(s(1:3)=='H2O' .AND. INDEX(old_phases,s(4:4))/=0 .AND. (ns==4 .OR. s(5:5)=='_')) THEN
-    out='H2O'//s(5:ns)                                                         !--- H2O<phase>[_<iso>][_<tag>]
-  ELSE IF(s(ns-1:ns-1)==phases_sep .AND. INDEX(known_phases,s(ns:ns))/=0) THEN
-    out = s(1:ns-2); RETURN                                                    !--- <var><phase_sep><phase>
-  ELSE; DO ip = 1, nphases; ix = INDEX(s, phases_sep//known_phases(ip:ip)//'_'); IF(ix /= 0) EXIT; END DO
-    IF(ip /= nphases+1) out = s(1:ix-1)//s(ix+2:ns)                            !--- <var><phase_sep><phase>_<tag>
-  END IF
-END FUNCTION delPhase
-!==============================================================================================================================
-CHARACTER(LEN=maxlen) FUNCTION addPhase_s1(s,pha) RESULT(out)
-  CHARACTER(LEN=*),           INTENT(IN) :: s
-  CHARACTER(LEN=1),           INTENT(IN) :: pha
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: l, i
-  out = s
-  IF(s == '') RETURN                                                           !--- Empty string: nothing to do
-  i = INDEX(s, '_')                                                            !--- /=0 for <var>_<tag> tracers names
-  l = LEN_TRIM(s)
-  IF(i == 0) out =  TRIM(s)//phases_sep//pha                                   !--- <var>       => return <var><sep><pha>
-  IF(i /= 0) out = s(1:i-1)//phases_sep//pha//'_'//s(i+1:l)                    !--- <var>_<tag> => return <var><sep><pha>_<tag>
-END FUNCTION addPhase_s1
-!==============================================================================================================================
-FUNCTION addPhase_sm(s,pha) RESULT(out)
-  CHARACTER(LEN=*),           INTENT(IN) :: s(:)
-  CHARACTER(LEN=1),           INTENT(IN) :: pha
-  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: k
-  out = [( addPhase_s1(s(k), pha), k=1, SIZE(s) )]
-END FUNCTION addPhase_sm
-!==============================================================================================================================
-CHARACTER(LEN=maxlen) FUNCTION addPhase_i1(s,ipha,phases) RESULT(out)
-  CHARACTER(LEN=*),           INTENT(IN) :: s
-  INTEGER,                    INTENT(IN) :: ipha
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
-!------------------------------------------------------------------------------------------------------------------------------
-  out = s
-  IF(s == '') RETURN                                                           !--- Empty string: nothing to do
-  IF(ipha == 0 .OR. ipha > nphases) RETURN                                     !--- Absurd index: no phase to add
-  IF(     PRESENT(phases)) out = addPhase_s1(s,       phases(ipha:ipha))
-  IF(.NOT.PRESENT(phases)) out = addPhase_s1(s, known_phases(ipha:ipha))
-END FUNCTION addPhase_i1
-!==============================================================================================================================
-FUNCTION addPhase_im(s,ipha,phases) RESULT(out)
-  CHARACTER(LEN=*),           INTENT(IN) :: s(:)
-  INTEGER,                    INTENT(IN) :: ipha
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
-  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: k
-  IF(     PRESENT(phases)) out = [( addPhase_i1(s(k), ipha,       phases), k=1, SIZE(s) )]
-  IF(.NOT.PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, known_phases), k=1, SIZE(s) )]
-END FUNCTION addPhase_im
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== APPEND TRACERS DATABASE "tracs" WITH TRACERS/KEYS "tname"/"keys" ; SAME FOR INTERNAL DATABASE "tracers" ==================
-!==============================================================================================================================
-LOGICAL FUNCTION addTracer_1(tname, keys, tracs) RESULT(lerr)
-  CHARACTER(LEN=*),             INTENT(IN)    :: tname
-  TYPE(keys_type),              INTENT(IN)    ::  keys
-  TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tracs(:)
-  TYPE(trac_type), ALLOCATABLE :: tr(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
-  INTEGER :: nt, ix
-  IF(ALLOCATED(tracs)) THEN
-     lerr = getKey('name', tnames, ky=tracs(:)%keys); IF(lerr) RETURN
-     nt = SIZE(tracs)
-     ix = strIdx(tnames, tname)
-     CALL msg('Modifying existing tracer "'//TRIM(tname)//'"', modname, ix /= 0)
-     CALL msg('Appending with tracer "'    //TRIM(tname)//'"', modname, ix == 0)
-     IF(ix == 0) THEN
-        ix = nt+1; ALLOCATE(tr(nt+1)); tr(1:nt) = tracs(1:nt); CALL MOVE_ALLOC(FROM=tr, TO=tracs)
-     END IF
-  ELSE
-     CALL msg('Creating a tracer descriptor with tracer "'//TRIM(tname)//'"', modname)
-     ix = 1; ALLOCATE(tracs(1))
-  END IF
-  CALL addKey('name', tname, tracs(ix)%keys)
-  tracs(ix)%name = tname
-  tracs(ix)%keys = keys
-
-END FUNCTION addTracer_1
-!==============================================================================================================================
-LOGICAL FUNCTION addTracer_1def(tname, keys) RESULT(lerr)
-  CHARACTER(LEN=*),             INTENT(IN)    :: tname
-  TYPE(keys_type),              INTENT(IN)    ::  keys
-  lerr = addTracer_1(tname, keys, tracers)
-END FUNCTION addTracer_1def
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-LOGICAL FUNCTION delTracer_1(tname, tracs) RESULT(lerr)
-  CHARACTER(LEN=*),                     INTENT(IN)    :: tname
-  TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: tracs(:)
-  TYPE(trac_type), ALLOCATABLE :: tr(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
-  INTEGER :: nt, ix
-  lerr = .NOT.ALLOCATED(tracs)
-  IF(fmsg('Can''t remove tracer "'//TRIM(tname)//'" from an empty tracers descriptor', modname, lerr)) RETURN
-  nt = SIZE(tracs)
-  lerr = getKey('name', tnames, ky=tracs(:)%keys); IF(lerr) RETURN
-  ix = strIdx(tnames, tname)
-  CALL msg('Removing tracer "'             //TRIM(tname)//'"', modname, ix /= 0)
-  CALL msg('Can''t remove unknown tracer "'//TRIM(tname)//'"', modname, ix == 0)
-  IF(ix /= 0) THEN
-     ALLOCATE(tr(nt-1)); tr(1:ix-1) = tracs(1:ix-1); tr(ix:nt-1) = tracs(ix+1:nt); CALL MOVE_ALLOC(FROM=tr, TO=tracs)
-  END IF
-END FUNCTION delTracer_1
-!==============================================================================================================================
-LOGICAL FUNCTION delTracer_1def(tname) RESULT(lerr)
-  CHARACTER(LEN=*), INTENT(IN) :: tname
-  lerr = delTracer(tname, tracers)
-END FUNCTION delTracer_1def
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== GET PHASE INDEX IN THE POSSIBLE PHASES LIST OR IN A SPECIFIED LIST ("phases") ============================================
-!==============================================================================================================================
-INTEGER FUNCTION getiPhase(tname, phases) RESULT(iPhase)
-  CHARACTER(LEN=*),           INTENT(IN)  :: tname
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: phases
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: phase
-  IF(     PRESENT(phases)) phase = getPhase(tname,       phases, iPhase)
-  IF(.NOT.PRESENT(phases)) phase = getPhase(tname, known_phases, iPhase)
-END FUNCTION getiPhase
-!==============================================================================================================================
-CHARACTER(LEN=1) FUNCTION getPhase(tname, phases, iPhase) RESULT(phase)
-  CHARACTER(LEN=*),           INTENT(IN)  :: tname
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: phases
-  INTEGER,          OPTIONAL, INTENT(OUT) :: iPhase
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: ip
-  phase = TRIM(strHead(strTail(tname, phases_sep), '_', .TRUE.))     !--- <nam><sep><pha>[_<tag>] -> <pha>[_<tag>] -> <pha>
-  IF(     PRESENT(phases)) ip = INDEX(      phases, phase)
-  IF(.NOT.PRESENT(phases)) ip = INDEX(known_phases, phase)
-  IF(ip == 0) phase = 'g'
-  IF(PRESENT(iPhase)) iPhase = ip
-END FUNCTION getPhase
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!============ CONVERT WATER-DERIVED NAMES FROM FORMER TO CURRENT CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
-!======= NAMES STRUCTURE: H2O[<phase>][_<isotope>][_<tag>] (<phase> from "old_phases", <isotope> from "oldH2OIso") ============
-!==============================================================================================================================
-CHARACTER(LEN=maxlen) FUNCTION old2newH2O_1(oldName, iPhase) RESULT(newName)
-  CHARACTER(LEN=*),  INTENT(IN)  :: oldName
-  INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: tmp(:)
-  INTEGER :: ix, ip, nt
-  LOGICAL :: lerr
-  newName = oldName
-  IF(PRESENT(iPhase)) iPhase = 1                                               !--- Default: gaseous phase
-  lerr = strParse(oldName, '_', tmp, nt)                                       !--- Parsing: 1 up to 3 elements.
-  ip = strIdx( [('H2O'//old_phases(ix:ix), ix=1, nphases)], tmp(1) )           !--- Phase index
-  IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip                                !--- Returning phase index
-  IF(ip == 0 .AND. tmp(1) /= 'H2O')   RETURN                                   !--- Not an old-style water-related species
-  IF(nt == 1) THEN
-    newName = addPhase('H2O',ip)                                               !=== WATER WITH OR WITHOUT PHASE
-  ELSE
-    ix = strIdx(oldH2OIso, tmp(2))                                             !--- Index in the known isotopes list
-    IF(ix /= 0) newName = newH2OIso(ix)                                        !--- Move to new isotope name
-    IF(ip /= 0) newName = addPhase(newName, ip)                                !--- Add phase to isotope name
-    IF(nt == 3) newName = TRIM(newName)//'_'//TRIM(tmp(3))                     !=== WATER ISOTOPE OR TAGGING TRACER
-  END IF
-END FUNCTION old2newH2O_1
-!==============================================================================================================================
-FUNCTION old2newH2O_m(oldName) RESULT(newName)
-  CHARACTER(LEN=*), INTENT(IN) :: oldName(:)
-  CHARACTER(LEN=maxlen)        :: newName(SIZE(oldName))
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: i
-  newName = [(old2newH2O_1(oldName(i)), i=1, SIZE(oldName))]
-END FUNCTION old2newH2O_m
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!============ CONVERT WATER-DERIVED NAMES FROM CURRENT TO FORMER CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
-!==== NAMES STRUCTURE: <var>[<phase_sep><phase>][_<tag>] (<phase> from "known_phases", <var> = 'H2O' or from "newH2OIso") =====
-!==============================================================================================================================
-CHARACTER(LEN=maxlen) FUNCTION new2oldH2O_1(newName, iPhase) RESULT(oldName)
-  CHARACTER(LEN=*),  INTENT(IN)  :: newName
-  INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: ix, ip
-  CHARACTER(LEN=maxlen) :: var
-  oldName = newName
-  ip = getiPhase(newName)                                                      !--- Phase index
-  IF(PRESENT(iPhase)) iPhase = MAX(ip, 1)                                      !--- Return phase index ; default: 1 (gazeous)
-  var = TRIM(strHead(newName, phases_sep, .TRUE.))                             !--- Variable without phase and tag
-  ix = strIdx(newH2OIso, var)                                                  !--- Index in the known H2O isotopes list
-  IF(ix == 0 .AND. var /= 'H2O') RETURN                                        !--- Neither H2O nor an H2O isotope => finished
-  oldName = 'H2O'
-  IF(ip /= 0) oldName = TRIM(oldName)//old_phases(ip:ip)                       !--- Add phase if needed
-  IF(ix /= 0) oldName = TRIM(oldName)//'_'//oldH2OIso(ix)                      !--- H2O isotope name
-  IF(newName /= addPhase(var, ip)) &
-    oldName = TRIM(oldName)//strTail(newName, '_', .TRUE.)                     !--- Add the tag suffix
-  IF(ip == 0 .AND. ix /= 0) oldName = strTail(oldName, '_')                    !--- Isotope with no phase: remove 'H2O_' prefix
-END FUNCTION new2oldH2O_1
-!==============================================================================================================================
-FUNCTION new2oldH2O_m(newName) RESULT(oldName)
-  CHARACTER(LEN=*), INTENT(IN) :: newName(:)
-  CHARACTER(LEN=maxlen)        :: oldName(SIZE(newName))
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: i
-  oldName = [(new2oldH2O_1(newName(i)), i=1, SIZE(newName))]
-END FUNCTION new2oldH2O_m
-!==============================================================================================================================
-
-END MODULE readTracFiles_mod
Index: LMDZ6/branches/Amaury_dev/libf/misc/regr1_step_av_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/regr1_step_av_m.F90	(revision 5116)
+++ 	(revision )
@@ -1,268 +1,0 @@
-! $Id: regr1_step_av_m.F90 3065 2017-11-10 13:25:09Z fairhead $
-module regr1_step_av_m
-
-  ! Author: Lionel GUEZ
-
-  IMPLICIT NONE
-
-  interface regr1_step_av
-
-     ! Each procedure regrids a step function by averaging it.
-     ! The regridding operation is done on the first dimension of the
-     ! input array.
-     ! Source grid contains edges of steps.
-     ! Target grid contains positions of cell edges.
-     ! The target grid should be included in the source grid: no
-     ! extrapolation is allowed.
-     ! The difference between the procedures is the rank of the first argument.
-
-     module procedure regr11_step_av, regr12_step_av, regr13_step_av, &
-          regr14_step_av
-  end interface
-
-  PRIVATE
-  public regr1_step_av
-
-contains
-
-  function regr11_step_av(vs, xs, xt) result(vt)
-
-    ! "vs" has rank 1.
-
-    use lmdz_assert_eq, ONLY: assert_eq
-    use lmdz_assert, ONLY: assert
-    use lmdz_interpolation, ONLY: locate
-
-    real, intent(in):: vs(:) ! values of steps on the source grid
-    ! (Step "is" is between "xs(is)" and "xs(is + 1)".)
-
-    real, intent(in):: xs(:)
-    ! (edges of of steps on the source grid, in strictly increasing order)
-
-    real, intent(in):: xt(:)
-    ! (edges of cells of the target grid, in strictly increasing order)
-
-    real vt(size(xt) - 1) ! average values on the target grid
-    ! (Cell "it" is between "xt(it)" and "xt(it + 1)".)
-
-    ! Variables local to the procedure:
-    integer is, it, ns, nt
-    real left_edge
-
-    !---------------------------------------------
-
-    ns = assert_eq(size(vs), size(xs) - 1, "regr11_step_av ns")
-    nt = size(xt) - 1
-    ! Quick check on sort order:
-    CALL assert(xs(1) < xs(2), "regr11_step_av xs bad order")
-    CALL assert(xt(1) < xt(2), "regr11_step_av xt bad order")
-
-    CALL assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
-         "regr11_step_av extrapolation")
-
-    is = locate(xs, xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
-    do it = 1, nt
-       ! 1 <= is <= ns
-       ! xs(is) <= xt(it) < xs(is + 1)
-       ! Compute "vt(it)":
-       left_edge = xt(it)
-       vt(it) = 0.
-       do while (xs(is + 1) < xt(it + 1))
-          ! 1 <= is <= ns - 1
-          vt(it) = vt(it) + (xs(is + 1) - left_edge) * vs(is)
-          is = is + 1
-          left_edge = xs(is)
-       END DO
-       ! 1 <= is <= ns
-       vt(it) = (vt(it) + (xt(it + 1) - left_edge) * vs(is)) &
-            / (xt(it + 1) - xt(it))
-       if (xs(is + 1) == xt(it + 1)) is = is + 1
-       ! 1 <= is <= ns .or. it == nt
-    END DO
-
-  END FUNCTION regr11_step_av
-
-  !********************************************
-
-  function regr12_step_av(vs, xs, xt) result(vt)
-
-    ! "vs" has rank 2.
-
-    use lmdz_assert_eq, ONLY: assert_eq
-    use lmdz_assert, ONLY: assert
-    use lmdz_interpolation, ONLY: locate
-
-    real, intent(in):: vs(:, :) ! values of steps on the source grid
-    ! (Step "is" is between "xs(is)" and "xs(is + 1)".)
-
-    real, intent(in):: xs(:)
-    ! (edges of steps on the source grid, in strictly increasing order)
-
-    real, intent(in):: xt(:)
-    ! (edges of cells of the target grid, in strictly increasing order)
-
-    real vt(size(xt) - 1, size(vs, 2)) ! average values on the target grid
-    ! (Cell "it" is between "xt(it)" and "xt(it + 1)".)
-
-    ! Variables local to the procedure:
-    integer is, it, ns, nt
-    real left_edge
-
-    !---------------------------------------------
-
-    ns = assert_eq(size(vs, 1), size(xs) - 1, "regr12_step_av ns")
-    nt = size(xt) - 1
-
-    ! Quick check on sort order:
-    CALL assert(xs(1) < xs(2), "regr12_step_av xs bad order")
-    CALL assert(xt(1) < xt(2), "regr12_step_av xt bad order")
-
-    CALL assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
-         "regr12_step_av extrapolation")
-
-    is = locate(xs, xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
-    do it = 1, nt
-       ! 1 <= is <= ns
-       ! xs(is) <= xt(it) < xs(is + 1)
-       ! Compute "vt(it, :)":
-       left_edge = xt(it)
-       vt(it, :) = 0.
-       do while (xs(is + 1) < xt(it + 1))
-          ! 1 <= is <= ns - 1
-          vt(it, :) = vt(it, :) + (xs(is + 1) - left_edge) * vs(is, :)
-          is = is + 1
-          left_edge = xs(is)
-       END DO
-       ! 1 <= is <= ns
-       vt(it, :) = (vt(it, :) + (xt(it + 1) - left_edge) * vs(is, :)) &
-            / (xt(it + 1) - xt(it))
-       if (xs(is + 1) == xt(it + 1)) is = is + 1
-       ! 1 <= is <= ns .or. it == nt
-    END DO
-
-  END FUNCTION regr12_step_av
-
-  !********************************************
-
-  function regr13_step_av(vs, xs, xt) result(vt)
-
-    ! "vs" has rank 3.
-
-    use lmdz_assert_eq, ONLY: assert_eq
-    use lmdz_assert, ONLY: assert
-    use lmdz_interpolation, ONLY: locate
-
-    real, intent(in):: vs(:, :, :) ! values of steps on the source grid
-    ! (Step "is" is between "xs(is)" and "xs(is + 1)".)
-
-    real, intent(in):: xs(:)
-    ! (edges of steps on the source grid, in strictly increasing order)
-
-    real, intent(in):: xt(:)
-    ! (edges of cells of the target grid, in strictly increasing order)
-
-    real vt(size(xt) - 1, size(vs, 2), size(vs, 3)) 
-    ! (average values on the target grid)
-    ! (Cell "it" is between "xt(it)" and "xt(it + 1)".)
-
-    ! Variables local to the procedure:
-    integer is, it, ns, nt
-    real left_edge
-
-    !---------------------------------------------
-
-    ns = assert_eq(size(vs, 1), size(xs) - 1, "regr13_step_av ns")
-    nt = size(xt) - 1
-
-    ! Quick check on sort order:
-    CALL assert(xs(1) < xs(2), "regr13_step_av xs bad order")
-    CALL assert(xt(1) < xt(2), "regr13_step_av xt bad order")
-
-    CALL assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
-         "regr13_step_av extrapolation")
-
-    is = locate(xs, xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
-    do it = 1, nt
-       ! 1 <= is <= ns
-       ! xs(is) <= xt(it) < xs(is + 1)
-       ! Compute "vt(it, :, :)":
-       left_edge = xt(it)
-       vt(it, :, :) = 0.
-       do while (xs(is + 1) < xt(it + 1))
-          ! 1 <= is <= ns - 1
-          vt(it, :, :) = vt(it, :, :) + (xs(is + 1) - left_edge) * vs(is, :, :)
-          is = is + 1
-          left_edge = xs(is)
-       END DO
-       ! 1 <= is <= ns
-       vt(it, :, :) = (vt(it, :, :) &
-            + (xt(it + 1) - left_edge) * vs(is, :, :)) / (xt(it + 1) - xt(it))
-       if (xs(is + 1) == xt(it + 1)) is = is + 1
-       ! 1 <= is <= ns .or. it == nt
-    END DO
-
-  END FUNCTION regr13_step_av
-
-  !********************************************
-
-  function regr14_step_av(vs, xs, xt) result(vt)
-
-    ! "vs" has rank 4.
-
-    use lmdz_assert_eq, ONLY: assert_eq
-    use lmdz_assert, ONLY: assert
-    use lmdz_interpolation, ONLY: locate
-
-    real, intent(in):: vs(:, :, :, :) ! values of steps on the source grid
-    ! (Step "is" is between "xs(is)" and "xs(is + 1)".)
-
-    real, intent(in):: xs(:)
-    ! (edges of steps on the source grid, in strictly increasing order)
-
-    real, intent(in):: xt(:)
-    ! (edges of cells of the target grid, in strictly increasing order)
-
-    real vt(size(xt) - 1, size(vs, 2), size(vs, 3), size(vs, 4))
-    ! (average values on the target grid)
-    ! (Cell "it" is between "xt(it)" and "xt(it + 1)".)
-
-    ! Variables local to the procedure:
-    integer is, it, ns, nt
-    real left_edge
-
-    !---------------------------------------------
-
-    ns = assert_eq(size(vs, 1), size(xs) - 1, "regr14_step_av ns")
-    nt = size(xt) - 1
-
-    ! Quick check on sort order:
-    CALL assert(xs(1) < xs(2), "regr14_step_av xs bad order")
-    CALL assert(xt(1) < xt(2), "regr14_step_av xt bad order")
-
-    CALL assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
-         "regr14_step_av extrapolation")
-
-    is = locate(xs, xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
-    do it = 1, nt
-       ! 1 <= is <= ns
-       ! xs(is) <= xt(it) < xs(is + 1)
-       ! Compute "vt(it, :, :, :)":
-       left_edge = xt(it)
-       vt(it, :, :, :) = 0.
-       do while (xs(is + 1) < xt(it + 1))
-          ! 1 <= is <= ns - 1
-          vt(it, :, :, :) = vt(it, :, :, :) + (xs(is + 1) - left_edge) &
-               * vs(is, :, :, :)
-          is = is + 1
-          left_edge = xs(is)
-       END DO
-       ! 1 <= is <= ns
-       vt(it, :, :, :) = (vt(it, :, :, :) + (xt(it + 1) - left_edge) &
-            * vs(is, :, :, :)) / (xt(it + 1) - xt(it))
-       if (xs(is + 1) == xt(it + 1)) is = is + 1
-       ! 1 <= is <= ns .or. it == nt
-    END DO
-
-  END FUNCTION regr14_step_av
-
-end module regr1_step_av_m
Index: LMDZ6/branches/Amaury_dev/libf/misc/regr_conserv_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/regr_conserv_m.F90	(revision 5116)
+++ 	(revision )
@@ -1,388 +1,0 @@
-MODULE regr_conserv_m
-
-  USE lmdz_assert_eq,   ONLY: assert_eq
-  USE lmdz_assert,      ONLY: assert
-  use lmdz_interpolation, ONLY: locate
-
-  IMPLICIT NONE
-
-! Purpose: Each procedure regrids a piecewise linear function (not necessarily
-!          continuous) by averaging it. This is a conservative regridding.
-!          The regridding operation is done along dimension "ix" of the input
-!          field "vs". Input are positions of cell edges.
-! Remarks:
-!   * The target grid should be included in the source grid:
-!     no extrapolation is allowed.
-!   * Field on target grid "vt" has same rank, slopes and averages as "vs".
-!   * If optional argument "slope" is not given, 0 is assumed for slopes.
-!     Then the regridding is first order instead of second.
-!   * "vs" and "vt" have the same dimensions except Nr. ix (ns for vs, nt for vt)
-
-! Argument                         Type         Description
-!-------------------------------------------------------------------------------
-!  INTEGER, INTENT(IN)  :: ix      Scalar       dimension regridded <=rank(vs)
-!  REAL,    INTENT(IN)  :: vs(*)   Rank>=1      averages in source grid cells
-!  REAL,    INTENT(IN)  :: xs(:)   Vector(ns+1) edges of source grid, asc. order
-!  REAL,    INTENT(IN)  :: xt(:)   Vector(nt+1) edges of target grid, asc. order
-!  REAL,    INTENT(OUT) :: vt(*)   Rank>=1      regridded field
-! [REAL,    INTENT(IN)  :: slope]  Rank>=1      slopes in source grid cells
-
-  INTERFACE regr_conserv
-    ! The procedures differ only from the rank of the input/output fields.
-    MODULE PROCEDURE regr1_conserv, regr2_conserv, regr3_conserv, &
-                     regr4_conserv, regr5_conserv
-  END INTERFACE
-
-  PRIVATE
-  PUBLIC :: regr_conserv
-
-CONTAINS
-
-!-------------------------------------------------------------------------------
-
-SUBROUTINE regr1_conserv(ix, vs, xs, xt, vt, slope)
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER,        INTENT(IN)  :: ix
-  REAL,           INTENT(IN)  :: vs(:)
-  REAL,           INTENT(IN)  :: xs(:), xt(:)
-  REAL,           INTENT(OUT) :: vt(:)
-  REAL, OPTIONAL, INTENT(IN)  :: slope(:)
-!-------------------------------------------------------------------------------
-! Local variables:
-  INTEGER :: is, it, ns, nt
-  REAL    :: co, idt
-  LOGICAL :: lslope
-!-------------------------------------------------------------------------------
-  lslope=PRESENT(slope)
-  CALL check_size(ix,SHAPE(vs),SHAPE(vt),xs,xt,ns,nt)
-  is=locate(xs,xt(1))                    !--- 1<= is <= ns (no extrapolation)
-  vt(:)=0.
-  DO it=1, nt; idt=1./(xt(it+1)-xt(it))
-    IF(xt(it+1)<=xs(is+1)) THEN          !--- xs(is)<=xt(it)<=xt(it+1)<=xs(is+1)
-      CALL mean_lin(xt(it),xt(it+1))
-    ELSE
-      CALL mean_lin(xt(it),xs(is+1)); is=is+1
-      DO WHILE(xs(is+1)<xt(it+1))        !--- 1<=is<=ns-1
-      CALL mean_lin(xs(is),xs(is+1)); is=is+1
-      END DO
-      CALL mean_lin(xs(is),xt(it+1))     !--- 1<=is<=ns
-    END IF
-    IF(xs(is+1)==xt(it+1)) is=is+1       !--- 1<=is<=ns .OR. it==nt
-  END DO
-
-CONTAINS
-
-!-------------------------------------------------------------------------------
-SUBROUTINE mean_lin(a,b)  ! mean [a,b] of the linear function in [xs(is),xs(is+1)]
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL, INTENT(IN)    :: a, b
-!-------------------------------------------------------------------------------
-  IF(lslope.AND.(a/=xs(is).OR.b/=xs(is+1))) THEN; co=0.
-    IF(a==xt(it  )) co=co+xt(it  )-xs(is  )
-    IF(b==xt(it+1)) co=co+xt(it+1)-xs(is+1)
-    vt(it) = vt(it)+idt*(b-a)*(vs(is)+co*slope(is)/2.)
-  ELSE
-    vt(it) = vt(it)+idt*(b-a)* vs(is)
-  END IF
-
-END SUBROUTINE mean_lin
-!-------------------------------------------------------------------------------
-
-END SUBROUTINE regr1_conserv
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-SUBROUTINE regr2_conserv(ix, vs, xs, xt, vt, slope)
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER,        INTENT(IN)  :: ix
-  REAL,           INTENT(IN)  :: vs(:,:)
-  REAL,           INTENT(IN)  :: xs(:), xt(:)
-  REAL,           INTENT(OUT) :: vt(:,:)
-  REAL, OPTIONAL, INTENT(IN)  :: slope(:,:)
-!-------------------------------------------------------------------------------
-! Local variables:
-  INTEGER :: is, it, ns, nt
-  REAL    :: co, idt
-  LOGICAL :: lslope
-!-------------------------------------------------------------------------------
-  lslope=PRESENT(slope)
-  CALL check_size(ix,SHAPE(vs),SHAPE(vt),xs,xt,ns,nt)
-  is=locate(xs,xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
-  vt(:,:)=0.
-  DO it=1, nt; idt=1./(xt(it+1)-xt(it))
-    IF(xt(it+1)<=xs(is+1)) THEN          !--- xs(is)<=xt(it)<=xt(it+1)<=xs(is+1)
-      CALL mean_lin(xt(it),xt(it+1))
-    ELSE
-      CALL mean_lin(xt(it),xs(is+1)); is=is+1
-      DO WHILE(xs(is+1)<xt(it+1))        !--- 1<=is<=ns-1
-      CALL mean_lin(xs(is),xs(is+1)); is=is+1
-      END DO
-      CALL mean_lin(xs(is),xt(it+1))     !--- 1<=is<=ns
-    END IF
-    IF(xs(is+1)==xt(it+1)) is=is+1       !--- 1<=is<=ns .OR. it==nt
-  END DO
-
-CONTAINS
-
-!-------------------------------------------------------------------------------
-SUBROUTINE mean_lin(a,b)  ! mean [a,b] of the linear function in [xs(is),xs(is+1)]
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL, INTENT(IN)    :: a, b
-!-------------------------------------------------------------------------------
-  IF(lslope.AND.(a/=xs(is).OR.b/=xs(is+1))) THEN; co=0.
-    IF(a==xt(it  )) co=co+xt(it  )-xs(is  )
-    IF(b==xt(it+1)) co=co+xt(it+1)-xs(is+1)
-    IF(ix==1) vt(it,:) = vt(it,:)+idt*(b-a)*(vs(is,:)+co*slope(is,:)/2.)
-    IF(ix==2) vt(:,it) = vt(:,it)+idt*(b-a)*(vs(:,is)+co*slope(:,is)/2.)
-  ELSE
-    IF(ix==1) vt(it,:) = vt(it,:)+idt*(b-a)* vs(is,:)
-    IF(ix==2) vt(:,it) = vt(:,it)+idt*(b-a)* vs(:,is)
-  END IF
-
-END SUBROUTINE mean_lin
-!-------------------------------------------------------------------------------
-
-END SUBROUTINE regr2_conserv
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-SUBROUTINE regr3_conserv(ix, vs, xs, xt, vt, slope)
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER,        INTENT(IN)  :: ix
-  REAL,           INTENT(IN)  :: vs(:,:,:)
-  REAL,           INTENT(IN)  :: xs(:), xt(:)
-  REAL,           INTENT(OUT) :: vt(:,:,:)
-  REAL, OPTIONAL, INTENT(IN)  :: slope(:,:,:)
-!-------------------------------------------------------------------------------
-! Local variables:
-  INTEGER :: is, it, ns, nt
-  REAL    :: co, idt
-  LOGICAL :: lslope
-!-------------------------------------------------------------------------------
-  lslope=PRESENT(slope)
-  CALL check_size(ix,SHAPE(vs),SHAPE(vt),xs,xt,ns,nt)
-  is=locate(xs,xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
-  vt(:,:,:)=0.
-  DO it=1, nt; idt=1./(xt(it+1)-xt(it))
-    IF(xt(it+1)<=xs(is+1)) THEN          !--- xs(is)<=xt(it)<=xt(it+1)<=xs(is+1)
-      CALL mean_lin(xt(it),xt(it+1))
-    ELSE
-      CALL mean_lin(xt(it),xs(is+1)); is=is+1
-      DO WHILE(xs(is+1)<xt(it+1))        !--- 1<=is<=ns-1
-      CALL mean_lin(xs(is),xs(is+1)); is=is+1
-      END DO
-      CALL mean_lin(xs(is),xt(it+1))     !--- 1<=is<=ns
-    END IF
-    IF(xs(is+1)==xt(it+1)) is=is+1       !--- 1<=is<=ns .OR. it==nt
-  END DO
-
-CONTAINS
-
-!-------------------------------------------------------------------------------
-SUBROUTINE mean_lin(a,b)  ! mean [a,b] of the linear function in [xs(is),xs(is+1)]
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL, INTENT(IN)    :: a, b
-!-------------------------------------------------------------------------------
-  IF(lslope.AND.(a/=xs(is).OR.b/=xs(is+1))) THEN; co=0.
-    IF(a==xt(it  )) co=co+xt(it  )-xs(is  )
-    IF(b==xt(it+1)) co=co+xt(it+1)-xs(is+1)
-    IF(ix==1) vt(it,:,:) = vt(it,:,:)+idt*(b-a)*(vs(is,:,:)+co*slope(is,:,:)/2.)
-    IF(ix==2) vt(:,it,:) = vt(:,it,:)+idt*(b-a)*(vs(:,is,:)+co*slope(:,is,:)/2.)
-    IF(ix==3) vt(:,:,it) = vt(:,:,it)+idt*(b-a)*(vs(:,:,is)+co*slope(:,:,is)/2.)
-  ELSE
-    IF(ix==1) vt(it,:,:) = vt(it,:,:)+idt*(b-a)* vs(is,:,:)
-    IF(ix==2) vt(:,it,:) = vt(:,it,:)+idt*(b-a)* vs(:,is,:)
-    IF(ix==3) vt(:,:,it) = vt(:,:,it)+idt*(b-a)* vs(:,:,is)
-  END IF
-
-END SUBROUTINE mean_lin
-!-------------------------------------------------------------------------------
-
-END SUBROUTINE regr3_conserv
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-SUBROUTINE regr4_conserv(ix, vs, xs, xt, vt, slope)
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER,        INTENT(IN)  :: ix
-  REAL,           INTENT(IN)  :: vs(:,:,:,:)
-  REAL,           INTENT(IN)  :: xs(:), xt(:)
-  REAL,           INTENT(OUT) :: vt(:,:,:,:)
-  REAL, OPTIONAL, INTENT(IN)  :: slope(:,:,:,:)
-!-------------------------------------------------------------------------------
-! Local variables:
-  INTEGER :: is, it, ns, nt
-  REAL    :: co, idt
-  LOGICAL :: lslope
-!-------------------------------------------------------------------------------
-  lslope=PRESENT(slope)
-  CALL check_size(ix,SHAPE(vs),SHAPE(vt),xs,xt,ns,nt)
-  is=locate(xs,xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
-  vt(:,:,:,:)=0.
-  DO it=1, nt; idt=1./(xt(it+1)-xt(it))
-    IF(xt(it+1)<=xs(is+1)) THEN          !--- xs(is)<=xt(it)<=xt(it+1)<=xs(is+1)
-      CALL mean_lin(xt(it),xt(it+1))
-    ELSE
-      CALL mean_lin(xt(it),xs(is+1)); is=is+1
-      DO WHILE(xs(is+1)<xt(it+1))        !--- 1<=is<=ns-1
-      CALL mean_lin(xs(is),xs(is+1)); is=is+1
-      END DO
-      CALL mean_lin(xs(is),xt(it+1))     !--- 1<=is<=ns
-    END IF
-    IF(xs(is+1)==xt(it+1)) is=is+1       !--- 1<=is<=ns .OR. it==nt
-  END DO
-
-CONTAINS
-
-!-------------------------------------------------------------------------------
-SUBROUTINE mean_lin(a,b)  ! mean [a,b] of the linear function in [xs(is),xs(is+1)]
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL, INTENT(IN) :: a, b
-!-------------------------------------------------------------------------------
-  IF(lslope.AND.(a/=xs(is).OR.b/=xs(is+1))) THEN; co=0.
-    IF(a==xt(it  )) co=co+xt(it  )-xs(is  )
-    IF(b==xt(it+1)) co=co+xt(it+1)-xs(is+1)
-    IF(ix==1) vt(it,:,:,:) = vt(it,:,:,:)+idt*(b-a)*(vs(is,:,:,:)+co*slope(is,:,:,:)/2.)
-    IF(ix==2) vt(:,it,:,:) = vt(:,it,:,:)+idt*(b-a)*(vs(:,is,:,:)+co*slope(:,is,:,:)/2.)
-    IF(ix==3) vt(:,:,it,:) = vt(:,:,it,:)+idt*(b-a)*(vs(:,:,is,:)+co*slope(:,:,is,:)/2.)
-    IF(ix==4) vt(:,:,:,it) = vt(:,:,:,it)+idt*(b-a)*(vs(:,:,:,is)+co*slope(:,:,:,is)/2.)
-  ELSE
-    IF(ix==1) vt(it,:,:,:) = vt(it,:,:,:)+idt*(b-a)* vs(is,:,:,:)
-    IF(ix==2) vt(:,it,:,:) = vt(:,it,:,:)+idt*(b-a)* vs(:,is,:,:)
-    IF(ix==3) vt(:,:,it,:) = vt(:,:,it,:)+idt*(b-a)* vs(:,:,is,:)
-    IF(ix==4) vt(:,:,:,it) = vt(:,:,:,it)+idt*(b-a)* vs(:,:,:,is)
-  END IF
-
-END SUBROUTINE mean_lin
-!-------------------------------------------------------------------------------
-
-END SUBROUTINE regr4_conserv
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-SUBROUTINE regr5_conserv(ix, vs, xs, xt, vt, slope)
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER,        INTENT(IN)  :: ix
-  REAL,           INTENT(IN)  :: vs(:,:,:,:,:)
-  REAL,           INTENT(IN)  :: xs(:), xt(:)
-  REAL,           INTENT(OUT) :: vt(:,:,:,:,:)
-  REAL, OPTIONAL, INTENT(IN)  :: slope(:,:,:,:,:)
-!-------------------------------------------------------------------------------
-! Local variables:
-  INTEGER :: is, it, ns, nt
-  REAL    :: co, idt
-  LOGICAL :: lslope
-!-------------------------------------------------------------------------------
-  lslope=PRESENT(slope)
-  CALL check_size(ix,SHAPE(vs),SHAPE(vt),xs,xt,ns,nt)
-  is=locate(xs,xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
-  vt(:,:,:,:,:)=0.
-  DO it=1, nt; idt=1./(xt(it+1)-xt(it))
-    IF(xt(it+1)<=xs(is+1)) THEN          !--- xs(is)<=xt(it)<=xt(it+1)<=xs(is+1)
-      CALL mean_lin(xt(it),xt(it+1))
-    ELSE
-      CALL mean_lin(xt(it),xs(is+1)); is=is+1
-      DO WHILE(xs(is+1)<xt(it+1))        !--- 1<=is<=ns-1
-      CALL mean_lin(xs(is),xs(is+1)); is=is+1
-      END DO
-      CALL mean_lin(xs(is),xt(it+1))     !--- 1<=is<=ns
-    END IF
-    IF(xs(is+1)==xt(it+1)) is=is+1     !--- 1<=is<=ns .OR. it==nt
-  END DO
-
-CONTAINS
-
-!-------------------------------------------------------------------------------
-SUBROUTINE mean_lin(a,b)  ! mean [a,b] of the linear function in [xs(is),xs(is+1)]
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL, INTENT(IN) :: a, b
-!-------------------------------------------------------------------------------
-  IF(lslope.AND.(a/=xs(is).OR.b/=xs(is+1))) THEN; co=0.
-    IF(a==xt(it  )) co=co+xt(it  )-xs(is  )
-    IF(b==xt(it+1)) co=co+xt(it+1)-xs(is+1)
-    IF(ix==1) vt(it,:,:,:,:) = vt(it,:,:,:,:)+idt*(b-a)*(vs(is,:,:,:,:)+co*slope(is,:,:,:,:)/2.)
-    IF(ix==2) vt(:,it,:,:,:) = vt(:,it,:,:,:)+idt*(b-a)*(vs(:,is,:,:,:)+co*slope(:,is,:,:,:)/2.)
-    IF(ix==3) vt(:,:,it,:,:) = vt(:,:,it,:,:)+idt*(b-a)*(vs(:,:,is,:,:)+co*slope(:,:,is,:,:)/2.)
-    IF(ix==4) vt(:,:,:,it,:) = vt(:,:,:,it,:)+idt*(b-a)*(vs(:,:,:,is,:)+co*slope(:,:,:,is,:)/2.)
-    IF(ix==5) vt(:,:,:,:,it) = vt(:,:,:,:,it)+idt*(b-a)*(vs(:,:,:,:,is)+co*slope(:,:,:,:,is)/2.)
-  ELSE
-    IF(ix==1) vt(it,:,:,:,:) = vt(it,:,:,:,:)+idt*(b-a)* vs(is,:,:,:,:)
-    IF(ix==2) vt(:,it,:,:,:) = vt(:,it,:,:,:)+idt*(b-a)* vs(:,is,:,:,:)
-    IF(ix==3) vt(:,:,it,:,:) = vt(:,:,it,:,:)+idt*(b-a)* vs(:,:,is,:,:)
-    IF(ix==4) vt(:,:,:,it,:) = vt(:,:,:,it,:)+idt*(b-a)* vs(:,:,:,is,:)
-    IF(ix==5) vt(:,:,:,:,it) = vt(:,:,:,:,it)+idt*(b-a)* vs(:,:,:,:,is)
-  END IF
-
-END SUBROUTINE mean_lin
-!-------------------------------------------------------------------------------
-
-END SUBROUTINE regr5_conserv
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-SUBROUTINE check_size(ix,svs,svt,xs,xt,ns,nt)
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER, INTENT(IN)  :: ix, svs(:), svt(:)
-  REAL,    INTENT(IN)  :: xs(:), xt(:)
-  INTEGER, INTENT(OUT) :: ns,    nt
-!-------------------------------------------------------------------------------
-! Local variables:
-  INTEGER :: rk, is, ii, n
-  CHARACTER(LEN=80) :: sub, msg
-!-------------------------------------------------------------------------------
-  WRITE(sub,'(a,2i0,a)')"regr",SIZE(svs),ix,"_conserv"
-  rk=assert_eq(SIZE(svs),SIZE(svt),TRIM(sub)//': inconsistent ranks')
-  WRITE(msg,'(a,2(i0,a))')TRIM(sub)//": ix (",ix,") exceeds field rank (",rk,")"
-  CALL assert(ix>=1.AND.ix<=rk,msg)
-  ii=0
-  DO is=1,rk; IF(is==ix) CYCLE
-    WRITE(msg,'(a,i0)')TRIM(sub)//" n",is
-    n=assert_eq(svs(is),svt(is),msg)
-    ii=ii+1
-  END DO
-  ns=assert_eq(svs(ix),SIZE(xs)-1,TRIM(sub)//" ns")
-  nt=assert_eq(svt(ix),SIZE(xt)-1,TRIM(sub)//" nt")
-
-  !--- Quick check on sort order:
-  CALL assert(xs(1)<xs(2), TRIM(sub)//": xs bad order")
-  CALL assert(xt(1)<xt(2), TRIM(sub)//": xt bad order")
-  CALL assert(xs(1)<=xt(1).AND.xt(nt+1)<=xs(ns+1), TRIM(sub)//": extrapolation")
-
-END SUBROUTINE check_size
-
-!-------------------------------------------------------------------------------
-
-
-END MODULE regr_conserv_m
Index: LMDZ6/branches/Amaury_dev/libf/misc/regr_lint_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/regr_lint_m.F90	(revision 5116)
+++ 	(revision )
@@ -1,219 +1,0 @@
-MODULE regr_lint_m
-
-  USE lmdz_assert_eq,   ONLY: assert_eq
-  USE lmdz_assert,      ONLY: assert
-  use lmdz_interpolation, ONLY: hunt
-
-  IMPLICIT NONE
-
-! Purpose: Each procedure regrids by linear interpolation along dimension "ix"
-!          the input field "vs" to the output field "vt".
-! Remark:
-!   * "vs" and "vt" have the same dimensions except Nr. ix (ns for vs, nt for vt)
-
-! Argument                         Type         Description
-!-------------------------------------------------------------------------------
-!  INTEGER, INTENT(IN)  :: ix      Scalar       dimension regridded <=rank(vs)
-!  REAL,    INTENT(IN)  :: vs(*)   Rank>=1      source grid field values
-!  REAL,    INTENT(IN)  :: xs(:)   Vector(ns)   centers of source grid, asc. order
-!  REAL,    INTENT(IN)  :: xt(:)   Vector(nt)   centers of target grid, asc. order
-!  REAL,    INTENT(OUT) :: vt(*)   Rank>=1      regridded field
-
-  INTERFACE regr_lint
-    ! The procedures differ only from the rank of the input/output fields.
-    MODULE PROCEDURE regr1_lint, regr2_lint, regr3_lint, &
-                     regr4_lint, regr5_lint
-  END INTERFACE
-
-  PRIVATE
-  PUBLIC :: regr_lint
-
-CONTAINS
-
-
-!-------------------------------------------------------------------------------
-
-SUBROUTINE regr1_lint(ix, vs, xs, xt, vt)
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER, INTENT(IN)  :: ix
-  REAL,    INTENT(IN)  :: vs(:)
-  REAL,    INTENT(IN)  :: xs(:)
-  REAL,    INTENT(IN)  :: xt(:)
-  REAL,    INTENT(OUT) :: vt(:)
-!-------------------------------------------------------------------------------
-! Local variables:
-  INTEGER :: is, it, ns, nt, isb ! "is" bound between 1 and "ns - 1"
-  REAL    :: r
-!-------------------------------------------------------------------------------
-  CALL check_size(ix,SHAPE(vs),SHAPE(vt),SIZE(xs),SIZE(xt),ns,nt)
-  is = -1 ! go immediately to bisection on first CALL to "hunt"
-  DO it=1,SIZE(xt)
-    CALL hunt(xs,xt(it),is); isb=MIN(MAX(is,1),ns-1)
-    r=(xs(isb+1)-xt(it))/(xs(isb+1)-xs(isb))
-    vt(it)=r*vs(isb)+(1.-r)*vs(isb+1)
-  END DO
-
-END SUBROUTINE regr1_lint
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-SUBROUTINE regr2_lint(ix, vs, xs, xt, vt)
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER, INTENT(IN)  :: ix
-  REAL,    INTENT(IN)  :: vs(:,:)
-  REAL,    INTENT(IN)  :: xs(:)
-  REAL,    INTENT(IN)  :: xt(:)
-  REAL,    INTENT(OUT) :: vt(:,:)
-!-------------------------------------------------------------------------------
-! Local variables:
-  INTEGER :: is, it, ns, nt, isb ! "is" bound between 1 and "ns - 1"
-  REAL    :: r
-!-------------------------------------------------------------------------------
-  CALL check_size(ix,SHAPE(vs),SHAPE(vt),SIZE(xs),SIZE(xt),ns,nt)
-  is = -1 ! go immediately to bisection on first CALL to "hunt"
-  DO it=1,SIZE(xt)
-    CALL hunt(xs,xt(it),is); isb=MIN(MAX(is,1),ns-1)
-    r=(xs(isb+1)-xt(it))/(xs(isb+1)-xs(isb))
-    IF(ix==1) vt(it,:)=r*vs(isb,:)+(1.-r)*vs(isb+1,:)
-    IF(ix==2) vt(:,it)=r*vs(:,isb)+(1.-r)*vs(:,isb+1)
-  END DO
-
-END SUBROUTINE regr2_lint
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-SUBROUTINE regr3_lint(ix, vs, xs, xt, vt)
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER, INTENT(IN)  :: ix
-  REAL,    INTENT(IN)  :: vs(:,:,:)
-  REAL,    INTENT(IN)  :: xs(:)
-  REAL,    INTENT(IN)  :: xt(:)
-  REAL,    INTENT(OUT) :: vt(:,:,:)
-!-------------------------------------------------------------------------------
-! Local variables:
-  INTEGER :: is, it, ns, nt, isb ! "is" bound between 1 and "ns - 1"
-  REAL    :: r
-!-------------------------------------------------------------------------------
-  CALL check_size(ix,SHAPE(vs),SHAPE(vt),SIZE(xs),SIZE(xt),ns,nt)
-  is = -1 ! go immediately to bisection on first CALL to "hunt"
-  DO it=1,SIZE(xt)
-    CALL hunt(xs,xt(it),is); isb=MIN(MAX(is,1),ns-1)
-    r=(xs(isb+1)-xt(it))/(xs(isb+1)-xs(isb))
-    IF(ix==1) vt(it,:,:)=r*vs(isb,:,:)+(1.-r)*vs(isb+1,:,:)
-    IF(ix==2) vt(:,it,:)=r*vs(:,isb,:)+(1.-r)*vs(:,isb+1,:)
-    IF(ix==3) vt(:,:,it)=r*vs(:,:,isb)+(1.-r)*vs(:,:,isb+1)
-  END DO
-
-END SUBROUTINE regr3_lint
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-SUBROUTINE regr4_lint(ix, vs, xs, xt, vt)
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER, INTENT(IN)  :: ix
-  REAL,    INTENT(IN)  :: vs(:,:,:,:)
-  REAL,    INTENT(IN)  :: xs(:)
-  REAL,    INTENT(IN)  :: xt(:)
-  REAL,    INTENT(OUT) :: vt(:,:,:,:)
-!-------------------------------------------------------------------------------
-! Local variables:
-  INTEGER :: is, it, ns, nt, isb ! "is" bound between 1 and "ns - 1"
-  REAL    :: r
-!-------------------------------------------------------------------------------
-  CALL check_size(ix,SHAPE(vs),SHAPE(vt),SIZE(xs),SIZE(xt),ns,nt)
-  is = -1 ! go immediately to bisection on first CALL to "hunt"
-  DO it=1,SIZE(xt)
-    CALL hunt(xs,xt(it),is); isb=MIN(MAX(is,1),ns-1)
-    r=(xs(isb+1)-xt(it))/(xs(isb+1)-xs(isb))
-    IF(ix==1) vt(it,:,:,:)=r*vs(isb,:,:,:)+(1.-r)*vs(isb+1,:,:,:)
-    IF(ix==2) vt(:,it,:,:)=r*vs(:,isb,:,:)+(1.-r)*vs(:,isb+1,:,:)
-    IF(ix==3) vt(:,:,it,:)=r*vs(:,:,isb,:)+(1.-r)*vs(:,:,isb+1,:)
-    IF(ix==4) vt(:,:,:,it)=r*vs(:,:,:,isb)+(1.-r)*vs(:,:,:,isb+1)
-  END DO
-
-END SUBROUTINE regr4_lint
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-SUBROUTINE regr5_lint(ix, vs, xs, xt, vt)
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER, INTENT(IN)  :: ix
-  REAL,    INTENT(IN)  :: vs(:,:,:,:,:)
-  REAL,    INTENT(IN)  :: xs(:)
-  REAL,    INTENT(IN)  :: xt(:)
-  REAL,    INTENT(OUT) :: vt(:,:,:,:,:)
-!-------------------------------------------------------------------------------
-! Local variables:
-  INTEGER :: is, it, ns, nt, isb ! "is" bound between 1 and "ns - 1"
-  REAL    :: r
-!-------------------------------------------------------------------------------
-  CALL check_size(ix,SHAPE(vs),SHAPE(vt),SIZE(xs),SIZE(xt),ns,nt)
-  is = -1 ! go immediately to bisection on first CALL to "hunt"
-  DO it=1,SIZE(xt)
-    CALL hunt(xs,xt(it),is); isb=MIN(MAX(is,1),ns-1)
-    r=(xs(isb+1)-xt(it))/(xs(isb+1)-xs(isb))
-    IF(ix==1) vt(it,:,:,:,:)=r*vs(isb,:,:,:,:)+(1.-r)*vs(isb+1,:,:,:,:)
-    IF(ix==2) vt(:,it,:,:,:)=r*vs(:,isb,:,:,:)+(1.-r)*vs(:,isb+1,:,:,:)
-    IF(ix==3) vt(:,:,it,:,:)=r*vs(:,:,isb,:,:)+(1.-r)*vs(:,:,isb+1,:,:)
-    IF(ix==4) vt(:,:,:,it,:)=r*vs(:,:,:,isb,:)+(1.-r)*vs(:,:,:,isb+1,:)
-    IF(ix==5) vt(:,:,:,:,it)=r*vs(:,:,:,:,isb)+(1.-r)*vs(:,:,:,:,isb+1)
-  END DO
-
-END SUBROUTINE regr5_lint
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-SUBROUTINE check_size(ix,svs,svt,nxs,nxt,ns,nt)
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER, INTENT(IN)  :: ix, svs(:), svt(:), nxs, nxt
-  INTEGER, INTENT(OUT) :: ns, nt
-!-------------------------------------------------------------------------------
-! Local variables:
-  INTEGER :: rk, is
-  CHARACTER(LEN=80) :: sub, msg
-!-------------------------------------------------------------------------------
-  rk=SIZE(svs)
-  WRITE(sub,'(a,2i0,a)')"regr",rk,ix,"_lint"
-  CALL assert(ix>=1.AND.ix<=rk,TRIM(sub)//": ix exceeds fields rank")
-  DO is=1,rk; IF(is==ix) CYCLE
-    WRITE(msg,'(a,i1)')TRIM(sub)//" n",is
-    CALL assert(svs(is)==svt(is),msg)
-  END DO
-  ns=assert_eq(svs(ix),nxs,TRIM(sub)//" ns")
-  nt=assert_eq(svt(ix),nxt,TRIM(sub)//" nt")
-
-END SUBROUTINE check_size
-
-!-------------------------------------------------------------------------------
-
-END MODULE regr_lint_m
-
-!-------------------------------------------------------------------------------
-
Index: LMDZ6/branches/Amaury_dev/libf/misc/slopes_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/slopes_m.F90	(revision 5116)
+++ 	(revision )
@@ -1,283 +1,0 @@
-MODULE slopes_m
-
-  ! Author: Lionel GUEZ
-  ! Extension / factorisation: David CUGNET
-
-  IMPLICIT NONE
-
-  ! Those generic function computes second order slopes with Van
-  ! Leer slope-limiting, given cell averages. Reference: Dukowicz,
-  ! 1987, SIAM Journal on Scientific and Statistical Computing, 8,
-  ! 305.
-
-  ! The only difference between the specific functions is the rank
-  ! of the first argument and the equal rank of the result.
-
-  ! slope(ix,...) acts on ix th dimension.
-
-  ! real, intent(in), rank >= 1:: f ! (n, ...) cell averages, n must be >= 1
-  ! real, intent(in):: x(:) ! (n + 1) cell edges
-  ! real slopes, same shape as f ! (n, ...)
-  INTERFACE slopes
-     MODULE procedure slopes1, slopes2, slopes3, slopes4, slopes5
-  END INTERFACE
-
-  PRIVATE
-  PUBLIC :: slopes
-
-CONTAINS
-
-!-------------------------------------------------------------------------------
-
-PURE FUNCTION slopes1(ix, f, x)
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER, INTENT(IN) :: ix
-  REAL,    INTENT(IN) :: f(:)
-  REAL,    INTENT(IN) :: x(:)
-  REAL :: slopes1(SIZE(f,1))
-!-------------------------------------------------------------------------------
-! Local:
-  INTEGER :: n, i, j, sta(2), sto(2)
-  REAL :: xc(SIZE(f,1))                             ! (n) cell centers
-  REAL :: h(2:SIZE(f,1)-1), delta_xc(2:SIZE(f,1)-1) ! (2:n-1)
-  REAL :: fm, ff, fp, dx
-!-------------------------------------------------------------------------------
-  n=SIZE(f,ix)
-  FORALL(i=1:n) xc(i)=(x(i)+x(i+1))/2.
-  FORALL(i=2:n-1)
-    h(i)=ABS(x(i+1)-xc(i)) ; delta_xc(i)=xc(i+1)-xc(i-1)
-  END FORALL
-  slopes1(:)=0.
-  DO i=2,n-1
-    ff=f(i); fm=f(i-1); fp=f(i+1)
-    IF(ff>=MAX(fm,fp).OR.ff<=MIN(fm,fp)) THEN
-      slopes1(i)=0.; CYCLE           !--- Local extremum
-      !--- 2nd order slope ; (fm, ff, fp) strictly monotonous
-      slopes1(i)=(fp-fm)/delta_xc(i)
-      !--- Slope limitation
-      slopes1(i) = SIGN(MIN(ABS(slopes1(i)), &
-        ABS(fp-ff)/h(i),ABS(ff-fm)/h(i)),slopes1(i) )
-     END IF
-  END DO
-
-END FUNCTION slopes1
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-PURE FUNCTION slopes2(ix, f, x)
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER, INTENT(IN) :: ix
-  REAL,    INTENT(IN) :: f(:, :)
-  REAL,    INTENT(IN) :: x(:)
-  REAL :: slopes2(SIZE(f,1),SIZE(f,2))
-!-------------------------------------------------------------------------------
-! Local:
-  INTEGER :: n, i, j, sta(2), sto(2)
-  REAL, ALLOCATABLE :: xc(:)                        ! (n) cell centers
-  REAL, ALLOCATABLE :: h(:), delta_xc(:)            ! (2:n-1)
-  REAL :: fm, ff, fp, dx
-!-------------------------------------------------------------------------------
-  n=SIZE(f,ix); ALLOCATE(xc(n),h(2:n-1),delta_xc(2:n-1))
-  FORALL(i=1:n) xc(i)=(x(i)+x(i+1))/2.
-  FORALL(i=2:n-1)
-    h(i)=ABS(x(i+1)-xc(i)) ; delta_xc(i)=xc(i+1)-xc(i-1)
-  END FORALL
-  slopes2(:,:)=0.
-  sta=[1,1]; sta(ix)=2
-  sto=SHAPE(f); sto(ix)=n-1
-  DO j=sta(2),sto(2); IF(ix==2) dx=delta_xc(j)
-    DO i=sta(1),sto(1); IF(ix==1) dx=delta_xc(i)
-      ff=f(i,j)
-      SELECT CASE(ix)
-        CASE(1); fm=f(i-1,j); fp=f(i+1,j)
-        CASE(2); fm=f(i,j-1); fp=f(i,j+1)
-      END SELECT
-      IF(ff>=MAX(fm,fp).OR.ff<=MIN(fm,fp)) THEN
-        slopes2(i,j)=0.; CYCLE           !--- Local extremum
-        !--- 2nd order slope ; (fm, ff, fp) strictly monotonous
-        slopes2(i,j)=(fp-fm)/dx
-        !--- Slope limitation
-        slopes2(i,j) = SIGN(MIN(ABS(slopes2(i,j)), &
-          ABS(fp-ff)/h(i),ABS(ff-fm)/h(i)),slopes2(i,j) )
-       END IF
-    END DO
-  END DO
-  DEALLOCATE(xc,h,delta_xc)
-
-END FUNCTION slopes2
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-PURE FUNCTION slopes3(ix, f, x)
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER, INTENT(IN) :: ix
-  REAL,    INTENT(IN) :: f(:, :, :)
-  REAL,    INTENT(IN) :: x(:)
-  REAL :: slopes3(SIZE(f,1),SIZE(f,2),SIZE(f,3))
-!-------------------------------------------------------------------------------
-! Local:
-  INTEGER :: n, i, j, k, sta(3), sto(3)
-  REAL, ALLOCATABLE :: xc(:)                        ! (n) cell centers
-  REAL, ALLOCATABLE :: h(:), delta_xc(:)            ! (2:n-1)
-  REAL :: fm, ff, fp, dx
-!-------------------------------------------------------------------------------
-  n=SIZE(f,ix); ALLOCATE(xc(n),h(2:n-1),delta_xc(2:n-1))
-  FORALL(i=1:n) xc(i)=(x(i)+x(i+1))/2.
-  FORALL(i=2:n-1)
-    h(i)=ABS(x(i+1)-xc(i)) ; delta_xc(i)=xc(i+1)-xc(i-1)
-  END FORALL
-  slopes3(:,:,:)=0.
-  sta=[1,1,1]; sta(ix)=2
-  sto=SHAPE(f); sto(ix)=n-1
-  DO k=sta(3),sto(3); IF(ix==3) dx=delta_xc(k)
-    DO j=sta(2),sto(2); IF(ix==2) dx=delta_xc(j)
-      DO i=sta(1),sto(1); IF(ix==1) dx=delta_xc(i)
-        ff=f(i,j,k)
-        SELECT CASE(ix)
-          CASE(1); fm=f(i-1,j,k); fp=f(i+1,j,k)
-          CASE(2); fm=f(i,j-1,k); fp=f(i,j+1,k)
-          CASE(3); fm=f(i,j,k-1); fp=f(i,j,k+1)
-        END SELECT
-        IF(ff>=MAX(fm,fp).OR.ff<=MIN(fm,fp)) THEN
-          slopes3(i,j,k)=0.; CYCLE           !--- Local extremum
-          !--- 2nd order slope ; (fm, ff, fp) strictly monotonous
-          slopes3(i,j,k)=(fp-fm)/dx
-          !--- Slope limitation
-          slopes3(i,j,k) = SIGN(MIN(ABS(slopes3(i,j,k)), &
-            ABS(fp-ff)/h(i),ABS(ff-fm)/h(i)),slopes3(i,j,k) )
-         END IF
-      END DO
-    END DO
-  END DO
-  DEALLOCATE(xc,h,delta_xc)
-
-END FUNCTION slopes3
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-PURE FUNCTION slopes4(ix, f, x)
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER, INTENT(IN) :: ix
-  REAL,    INTENT(IN) :: f(:, :, :, :)
-  REAL,    INTENT(IN) :: x(:)
-  REAL :: slopes4(SIZE(f,1),SIZE(f,2),SIZE(f,3),SIZE(f,4))
-!-------------------------------------------------------------------------------
-! Local:
-  INTEGER :: n, i, j, k, l, m, sta(4), sto(4)
-  REAL, ALLOCATABLE :: xc(:)                        ! (n) cell centers
-  REAL, ALLOCATABLE :: h(:), delta_xc(:)            ! (2:n-1)
-  REAL :: fm, ff, fp, dx
-!-------------------------------------------------------------------------------
-  n=SIZE(f,ix); ALLOCATE(xc(n),h(2:n-1),delta_xc(2:n-1))
-  FORALL(i=1:n) xc(i)=(x(i)+x(i+1))/2.
-  FORALL(i=2:n-1)
-    h(i)=ABS(x(i+1)-xc(i)) ; delta_xc(i)=xc(i+1)-xc(i-1)
-  END FORALL
-  slopes4(:,:,:,:)=0.
-  sta=[1,1,1,1]; sta(ix)=2
-  sto=SHAPE(f); sto(ix)=n-1
-  DO l=sta(4),sto(4); IF(ix==4) dx=delta_xc(l)
-    DO k=sta(3),sto(3); IF(ix==3) dx=delta_xc(k)
-      DO j=sta(2),sto(2); IF(ix==2) dx=delta_xc(j)
-        DO i=sta(1),sto(1); IF(ix==1) dx=delta_xc(i)
-          ff=f(i,j,k,l)
-          SELECT CASE(ix)
-            CASE(1); fm=f(i-1,j,k,l); fp=f(i+1,j,k,l)
-            CASE(2); fm=f(i,j-1,k,l); fp=f(i,j+1,k,l)
-            CASE(3); fm=f(i,j,k-1,l); fp=f(i,j,k+1,l)
-            CASE(4); fm=f(i,j,k,l-1); fp=f(i,j,k,l+1)
-          END SELECT
-          IF(ff>=MAX(fm,fp).OR.ff<=MIN(fm,fp)) THEN
-            slopes4(i,j,k,l)=0.; CYCLE           !--- Local extremum
-            !--- 2nd order slope ; (fm, ff, fp) strictly monotonous
-            slopes4(i,j,k,l)=(fp-fm)/dx
-            !--- Slope limitation
-            slopes4(i,j,k,l) = SIGN(MIN(ABS(slopes4(i,j,k,l)), &
-              ABS(fp-ff)/h(i),ABS(ff-fm)/h(i)),slopes4(i,j,k,l) )
-           END IF
-        END DO
-      END DO
-    END DO
-  END DO
-  DEALLOCATE(xc,h,delta_xc)
-
-END FUNCTION slopes4
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-PURE FUNCTION slopes5(ix, f, x)
-
-!-------------------------------------------------------------------------------
-! Arguments:
-  INTEGER, INTENT(IN) :: ix
-  REAL,    INTENT(IN) :: f(:, :, :, :, :)
-  REAL,    INTENT(IN) :: x(:)
-  REAL :: slopes5(SIZE(f,1),SIZE(f,2),SIZE(f,3),SIZE(f,4),SIZE(f,5))
-!-------------------------------------------------------------------------------
-! Local:
-  INTEGER :: n, i, j, k, l, m, sta(5), sto(5)
-  REAL, ALLOCATABLE :: xc(:)                        ! (n) cell centers
-  REAL, ALLOCATABLE :: h(:), delta_xc(:)            ! (2:n-1)
-  REAL :: fm, ff, fp, dx
-!-------------------------------------------------------------------------------
-  n=SIZE(f,ix); ALLOCATE(xc(n),h(2:n-1),delta_xc(2:n-1))
-  FORALL(i=1:n) xc(i)=(x(i)+x(i+1))/2.
-  FORALL(i=2:n-1)
-    h(i)=ABS(x(i+1)-xc(i)) ; delta_xc(i)=xc(i+1)-xc(i-1)
-  END FORALL
-  slopes5(:,:,:,:,:)=0.
-  sta=[1,1,1,1,1]; sta(ix)=2
-  sto=SHAPE(f);    sto(ix)=n-1
-  DO m=sta(5),sto(5); IF(ix==5) dx=delta_xc(m)
-    DO l=sta(4),sto(4); IF(ix==4) dx=delta_xc(l)
-      DO k=sta(3),sto(3); IF(ix==3) dx=delta_xc(k)
-        DO j=sta(2),sto(2); IF(ix==2) dx=delta_xc(j)
-          DO i=sta(1),sto(1); IF(ix==1) dx=delta_xc(i)
-            ff=f(i,j,k,l,m)
-            SELECT CASE(ix)
-              CASE(1); fm=f(i-1,j,k,l,m); fp=f(i+1,j,k,l,m)
-              CASE(2); fm=f(i,j-1,k,l,m); fp=f(i,j+1,k,l,m)
-              CASE(3); fm=f(i,j,k-1,l,m); fp=f(i,j,k+1,l,m)
-              CASE(4); fm=f(i,j,k,l-1,m); fp=f(i,j,k,l+1,m)
-              CASE(5); fm=f(i,j,k,l,m-1); fp=f(i,j,k,l,m+1)
-            END SELECT
-            IF(ff>=MAX(fm,fp).OR.ff<=MIN(fm,fp)) THEN
-              slopes5(i,j,k,l,m)=0.; CYCLE           !--- Local extremum
-              !--- 2nd order slope ; (fm, ff, fp) strictly monotonous
-              slopes5(i,j,k,l,m)=(fp-fm)/dx
-              !--- Slope limitation
-              slopes5(i,j,k,l,m) = SIGN(MIN(ABS(slopes5(i,j,k,l,m)), &
-                ABS(fp-ff)/h(i),ABS(ff-fm)/h(i)),slopes5(i,j,k,l,m) )
-            END IF
-          END DO
-        END DO
-      END DO
-    END DO
-  END DO
-  DEALLOCATE(xc,h,delta_xc)
-
-END FUNCTION slopes5
-
-!-------------------------------------------------------------------------------
-
-END MODULE slopes_m
Index: LMDZ6/branches/Amaury_dev/libf/misc/sort.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/sort.f90	(revision 5116)
+++ 	(revision )
@@ -1,37 +1,0 @@
-
-! $Header$
-
-!
-!
-SUBROUTINE sort(n,d)
-  !
-  ! P.Le Van
-  !
-  !...  cette routine met le tableau d  dans l'ordre croissant  ....
-  !c   ( pour avoir l'ordre decroissant,il suffit de remplacer l'instruc
-  !  tion  situee + bas  IF(d(j).LE.p)  THEN     par
-  !                       IF(d(j).GE.p)  THEN
-  !
-
-  INTEGER :: n
-  REAL :: d(n) , p
-  INTEGER :: i,j,k
-
-  DO i=1,n-1
-    k=i
-    p=d(i)
-    DO j=i+1,n
-     IF(d(j)<=p) THEN
-       k=j
-       p=d(j)
-     ENDIF
-    ENDDO
-
-   IF(k/=i) THEN
-     d(k)=d(i)
-     d(i)=p
-   ENDIF
-  ENDDO
-
-
-END SUBROUTINE sort
Index: LMDZ6/branches/Amaury_dev/libf/misc/strings_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/strings_mod.F90	(revision 5116)
+++ 	(revision )
@@ -1,1612 +1,0 @@
-MODULE strings_mod
-  IMPLICIT NONE; PRIVATE
-  PUBLIC :: maxlen, init_printout, msg, fmsg, get_in, lunout, prt_level
-  PUBLIC :: strLower, strHead, strStack,  strCount, strReduce,  strClean, strIdx
-  PUBLIC :: strUpper, strTail, strStackm, strParse, strReplace, strFind, find, cat
-  PUBLIC :: dispTable, dispOutliers, dispNameList
-  PUBLIC :: is_numeric, bool2str, int2str, real2str, dble2str
-  PUBLIC :: reduceExpr, str2bool, str2int, str2real, str2dble
-  PUBLIC :: addQuotes, checkList, removeComment
-
-  INTERFACE get_in;     MODULE PROCEDURE getin_s,  getin_i,  getin_r,  getin_l;  END INTERFACE get_in
-  INTERFACE  msg;       MODULE PROCEDURE        msg_1,                    msg_m; END INTERFACE  msg
-  INTERFACE fmsg;       MODULE PROCEDURE       fmsg_1,                   fmsg_m; END INTERFACE fmsg
-  INTERFACE strHead;    MODULE PROCEDURE    strHead_1,                strHead_m; END INTERFACE strHead
-  INTERFACE strTail;    MODULE PROCEDURE    strTail_1,                strTail_m; END INTERFACE strTail
-  INTERFACE strClean;   MODULE PROCEDURE   strClean_1,               strClean_m; END INTERFACE strClean
-  INTERFACE strReduce;  MODULE PROCEDURE  strReduce_1,              strReduce_2; END INTERFACE strReduce
-  INTERFACE strIdx;     MODULE PROCEDURE     strIdx_1,                 strIdx_m; END INTERFACE strIdx
-  INTERFACE strCount;   MODULE PROCEDURE  strCount_m1, strCount_11, strCount_1m; END INTERFACE strCount
-  INTERFACE strReplace; MODULE PROCEDURE strReplace_1,             strReplace_m; END INTERFACE strReplace
-  INTERFACE cat;        MODULE PROCEDURE  horzcat_s00, horzcat_i00, horzcat_r00,  & !horzcat_d00, &
-                                          horzcat_s10, horzcat_i10, horzcat_r10,  & !horzcat_d10, &
-                                          horzcat_s11, horzcat_i11, horzcat_r11,  & !horzcat_d11, &
-                                          horzcat_s21, horzcat_i21, horzcat_r21; END INTERFACE cat !horzcat_d21
-  INTERFACE strFind;      MODULE PROCEDURE strFind_1, strFind_m;                 END INTERFACE strFind
-  INTERFACE find;         MODULE PROCEDURE strFind_1, strFind_m, intFind_1, intFind_m, booFind; END INTERFACE find
-  INTERFACE dispOutliers; MODULE PROCEDURE dispOutliers_1, dispOutliers_2; END INTERFACE dispOutliers
-  INTERFACE reduceExpr;   MODULE PROCEDURE   reduceExpr_1,   reduceExpr_m; END INTERFACE reduceExpr
-  INTERFACE addQuotes;    MODULE PROCEDURE    addQuotes_1,    addQuotes_m; END INTERFACE addQuotes
-
-  INTEGER, PARAMETER :: maxlen    = 256                    !--- Standard maximum length for strings
-  INTEGER,      SAVE :: lunout    = 6                      !--- Printing unit  (default: 6, ie. on screen)
-  INTEGER,      SAVE :: prt_level = 1                      !--- Printing level (default: 1, ie. print all)
-
-CONTAINS
-
-
-!==============================================================================================================================
-SUBROUTINE init_printout(lunout_, prt_level_)
-    INTEGER, INTENT(IN) :: lunout_, prt_level_
-  lunout    = lunout_
-  prt_level = prt_level_
-END SUBROUTINE init_printout
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== Same as getin ; additional last argument: the default value.
-!==============================================================================================================================
-SUBROUTINE getin_s(nam, val, def)
-  USE IOIPSL, ONLY: getin
-    CHARACTER(LEN=*), INTENT(IN)    :: nam
-  CHARACTER(LEN=*), INTENT(INOUT) :: val
-  CHARACTER(LEN=*), INTENT(IN)    :: def
-  val = def; CALL getin(nam, val)
-  IF(val/=def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(val)
-END SUBROUTINE getin_s
-!==============================================================================================================================
-SUBROUTINE getin_i(nam, val, def)
-  USE IOIPSL, ONLY: getin
-  CHARACTER(LEN=*), INTENT(IN)    :: nam
-  INTEGER,          INTENT(INOUT) :: val
-  INTEGER,          INTENT(IN)    :: def
-  val = def; CALL getin(nam, val)
-  IF(val/=def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(int2str(val))
-END SUBROUTINE getin_i
-!==============================================================================================================================
-SUBROUTINE getin_r(nam, val, def)
-  USE IOIPSL,ONLY: getin
-    CHARACTER(LEN=*), INTENT(IN)    :: nam
-  REAL,             INTENT(INOUT) :: val
-  REAL,             INTENT(IN)    :: def
-  val = def; CALL getin(nam, val)
-  IF(val/=def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(real2str(val))
-END SUBROUTINE getin_r
-!==============================================================================================================================
-SUBROUTINE getin_l(nam, val, def)
-  USE IOIPSL, ONLY: getin
-    CHARACTER(LEN=*), INTENT(IN)    :: nam
-  LOGICAL,          INTENT(INOUT) :: val
-  LOGICAL,          INTENT(IN)    :: def
-  val = def; CALL getin(nam, val)
-  IF(val.NEQV.def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(bool2str(val))
-END SUBROUTINE getin_l
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== Display one or several messages, one each line, starting with the current routine name "modname".
-!==============================================================================================================================
-SUBROUTINE msg_1(str, modname, ll, unit)
-    !--- Display a simple message "str". Optional parameters:
-  !    * "modname": module name, displayed in front of the message (with ": " separator) if present.
-  !    * "ll":      message trigger ; message is displayed only if ll==.TRUE.
-  !    * "unit":    write unit (by default: "lunout")
-  CHARACTER(LEN=*),           INTENT(IN) :: str
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
-  LOGICAL,          OPTIONAL, INTENT(IN) :: ll
-  INTEGER,          OPTIONAL, INTENT(IN) :: unit
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: subn
-  INTEGER :: unt
-  subn = '';    IF(PRESENT(modname)) subn = modname
-  IF(PRESENT(ll)) THEN; IF(.NOT.ll) RETURN; END IF
-  unt = lunout; IF(PRESENT(unit)) unt = unit
-  IF(subn == '') WRITE(unt,'(a)') str                                          !--- Simple message
-  IF(subn /= '') WRITE(unt,'(a)') TRIM(subn)//': '//str                        !--- Routine name provided
-END SUBROUTINE msg_1
-!==============================================================================================================================
-SUBROUTINE msg_m(str, modname, ll, unit, nmax)
-    !--- Same as msg_1 with multiple strings that are stacked (separator: coma) on up to "nmax" full lines.
-  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
-  LOGICAL,          OPTIONAL, INTENT(IN) :: ll
-  INTEGER,          OPTIONAL, INTENT(IN) :: unit
-  INTEGER,          OPTIONAL, INTENT(IN) :: nmax
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)
-  CHARACTER(LEN=maxlen) :: subn
-  INTEGER :: unt, nmx, k
-  LOGICAL :: l
-  subn = '';    IF(PRESENT(modname)) subn = modname
-  l   = .TRUE.; IF(PRESENT(ll))     l = ll
-  unt = lunout; IF(PRESENT(unit)) unt = unit
-  nmx = 128;    IF(PRESENT(nmax)) nmx = nmax
-  s = strStackm(str, ', ', nmx)
-  DO k=1,SIZE(s); CALL msg_1(s(k), subn,  l,   unt); END DO
-END SUBROUTINE msg_m
-!==============================================================================================================================
-LOGICAL FUNCTION fmsg_1(str, modname, ll, unit) RESULT(l)
-    CHARACTER(LEN=*),           INTENT(IN) :: str
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
-  LOGICAL,          OPTIONAL, INTENT(IN) :: ll
-  INTEGER,          OPTIONAL, INTENT(IN) :: unit
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: subn
-  INTEGER :: unt
-  subn = '';    IF(PRESENT(modname)) subn = modname
-  l   = .TRUE.; IF(PRESENT(ll))     l = ll
-  unt = lunout; IF(PRESENT(unit)) unt = unit
-  CALL msg_1(str, subn, l, unt)
-END FUNCTION fmsg_1
-!==============================================================================================================================
-LOGICAL FUNCTION fmsg_m(str, modname, ll, unit, nmax) RESULT(l)
-    CHARACTER(LEN=*),           INTENT(IN)  :: str(:)
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
-  LOGICAL,          OPTIONAL, INTENT(IN) :: ll
-  INTEGER,          OPTIONAL, INTENT(IN) :: unit
-  INTEGER,          OPTIONAL, INTENT(IN)  :: nmax
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: subn
-  INTEGER :: unt, nmx
-  subn = '';    IF(PRESENT(modname)) subn = modname
-  l   = .TRUE.; IF(PRESENT(ll))     l = ll
-  unt = lunout; IF(PRESENT(unit)) unt = unit
-  nmx = 128;    IF(PRESENT(nmax)) nmx = nmax
-  CALL msg_m(str, subn, l, unt, nmx)
-END FUNCTION fmsg_m
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== Lower/upper case conversion function. ====================================================================================
-!==============================================================================================================================
-ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strLower(str) RESULT(out)
-    CHARACTER(LEN=*), INTENT(IN) :: str
-  INTEGER :: k
-  out = str
-  DO k=1,LEN_TRIM(str)
-    IF(str(k:k)>='A' .AND. str(k:k)<='Z') out(k:k)=ACHAR(IACHAR(str(k:k))+32)
-  END DO
-END FUNCTION strLower
-!==============================================================================================================================
-ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strUpper(str) RESULT(out)
-    CHARACTER(LEN=*), INTENT(IN) :: str
-  INTEGER :: k
-  out = str
-  DO k=1,LEN_TRIM(str)
-    IF(str(k:k)>='a' .AND. str(k:k)<='z') out(k:k)=ACHAR(IACHAR(str(k:k))-32)
-  END DO
-END FUNCTION strUpper
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== Extract the substring in front of the first (last if lBackward==TRUE) occurrence of "sep" in "str"        ================
-!=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect:                           ================
-!===    * strHead(..,.FALSE.) = 'a'           ${str%%$sep*}                                                    ================
-!===    * strHead(..,.TRUE.)  = 'a_b'         ${str%$sep*}                                                     ================
-!==============================================================================================================================
-CHARACTER(LEN=maxlen) FUNCTION strHead_1(str, sep, lBackward) RESULT(out)
-    CHARACTER(LEN=*),           INTENT(IN) :: str
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
-  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackward
-!------------------------------------------------------------------------------------------------------------------------------
-  IF(PRESENT(sep)) THEN
-    IF(     PRESENT(lBackWard)) out = str(1:INDEX(str,sep,lBackWard)-1)
-    IF(.NOT.PRESENT(lBackWard)) out = str(1:INDEX(str,sep)-1)
-  ELSE
-    IF(     PRESENT(lBackWard)) out = str(1:INDEX(str,'/',lBackWard)-1)
-    IF(.NOT.PRESENT(lBackWard)) out = str(1:INDEX(str,'/')-1)
-  END IF
-  IF(out == '') out = str
-END FUNCTION strHead_1
-!==============================================================================================================================
-FUNCTION strHead_m(str, sep, lBackward) RESULT(out)
-    CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
-  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
-  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackward
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: k
-  IF(PRESENT(sep)) THEN
-    IF(     PRESENT(lBackWard)) out = [(strHead_1(str(k), sep, lBackWard), k=1, SIZE(str))]
-    IF(.NOT.PRESENT(lBackWard)) out = [(strHead_1(str(k), sep),            k=1, SIZE(str))]
-  ELSE
-    IF(     PRESENT(lBackWard)) out = [(strHead_1(str(k), '/', lBackWard), k=1, SIZE(str))]
-    IF(.NOT.PRESENT(lBackWard)) out = [(strHead_1(str(k), '/'),            k=1, SIZE(str))]
-  END IF
-END FUNCTION strHead_m
-!==============================================================================================================================
-!=== Extract the substring following the first (last if lBackward==TRUE) occurrence of "sep" in "str"          ================
-!=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect:                           ================
-!===    * strTail(str, '_', .FALSE.) = 'b_c'         ${str#*$sep}                                              ================
-!===    * strTail(str, '_', .TRUE.)  = 'c'           ${str##*$sep}                                             ================
-!==============================================================================================================================
-CHARACTER(LEN=maxlen) FUNCTION strTail_1(str, sep, lBackWard) RESULT(out)
-    CHARACTER(LEN=*),           INTENT(IN) :: str
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
-  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackWard
-!------------------------------------------------------------------------------------------------------------------------------
-  IF(PRESENT(sep)) THEN
-    IF(     PRESENT(lBackWard)) out = str(INDEX(str,sep,lBackWard)+LEN(sep):LEN_TRIM(str))
-    IF(.NOT.PRESENT(lBackWard)) out = str(INDEX(str,sep)          +LEN(sep):LEN_TRIM(str))
-  ELSE
-    IF(     PRESENT(lBackWard)) out = str(INDEX(str,'/',lBackWard)+1:LEN_TRIM(str))
-    IF(.NOT.PRESENT(lBackWard)) out = str(INDEX(str,'/')          +1:LEN_TRIM(str))
-  END IF
-  IF(out == '') out = str
-END FUNCTION strTail_1
-!==============================================================================================================================
-FUNCTION strTail_m(str, sep, lBackWard) RESULT(out)
-    CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
-  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
-  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackWard
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: k
-  IF(PRESENT(sep)) THEN
-    IF(     PRESENT(lBackWard)) out = [(strTail_1(str(k), sep, lBackWard), k=1, SIZE(str))]
-    IF(.NOT.PRESENT(lBackWard)) out = [(strTail_1(str(k), sep),            k=1, SIZE(str))]
-  ELSE
-    IF(     PRESENT(lBackWard)) out = [(strTail_1(str(k), '/', lBackWard), k=1, SIZE(str))]
-    IF(.NOT.PRESENT(lBackWard)) out = [(strTail_1(str(k), '/'),            k=1, SIZE(str))]
-  END IF
-END FUNCTION strTail_m
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== Concatenates the strings "str(:)" with separator "sep" into a single string using a separator (',' by default). ==========
-!==============================================================================================================================
-FUNCTION strStack(str, sep, mask) RESULT(out)
-    CHARACTER(LEN=:),          ALLOCATABLE :: out
-  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
-  LOGICAL,          OPTIONAL, INTENT(IN) :: mask(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=:), ALLOCATABLE :: s
-  INTEGER :: is, i0
-  IF(SIZE(str) == 0) THEN; out = ''; RETURN; END IF
-  ALLOCATE(s, SOURCE=', '); IF(PRESENT(sep)) s=sep
-  IF(PRESENT(mask)) THEN
-    IF(ALL(.NOT.mask)) THEN; out = ''; RETURN; END IF
-    i0 = 0; DO WHILE(.NOT.mask(i0+1)); i0 = i0+1; END DO
-    out = str(i0); DO is=i0+1,SIZE(str, DIM=1); IF(.NOT.mask(is)) CYCLE; out = TRIM(out)//s//TRIM(str(is)); END DO
-  ELSE
-    out = str(1); DO is=2,SIZE(str, DIM=1); out = TRIM(out)//s//TRIM(str(is)); END DO
-  END IF
-END FUNCTION strStack
-!==============================================================================================================================
-!=== Concatenate the strings "str(:)" with separator "sep" into one or several lines of "nmax" characters max (for display) ===
-!==============================================================================================================================
-FUNCTION strStackm(str, sep, nmax) RESULT(out)
-    CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
-  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
-  INTEGER,          OPTIONAL, INTENT(IN) :: nmax
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: t(:)
-  CHARACTER(LEN=maxlen) :: sp
-  INTEGER :: is, ns, no, mx, n
-  IF(SIZE(str) == 0) THEN; out = ['']; RETURN; END IF
-  sp =', '; IF(PRESENT(sep )) sp = sep
-  ns = 2  ; IF(PRESENT(sep )) ns = LEN(sep)
-  mx = 256; IF(PRESENT(nmax)) mx = nmax
-  no = 1; out = ['']
-  DO is = 1, SIZE(str)
-    n = LEN_TRIM(str(is)); IF(out(no)/='') n = n+ns+LEN_TRIM(out(no))          !--- Line length after "str(is)" inclusion
-    IF(out(no) == '') THEN
-      out(no) = str(is)                                                        !--- Empty new line: set to "str(is)"
-    ELSE IF(n <= mx) THEN
-      out(no) = TRIM(out(no))//sp(1:ns)//TRIM(str(is))                         !--- Append "str(is)" to the current line
-    ELSE
-      ALLOCATE(t(no+1)); t(1:no) = out; no=no+1; t(no) = str(is)               !--- Full line: "str(si)" put in next line
-      CALL MOVE_ALLOC(FROM=t, TO=out)
-    END IF
-  END DO
-END FUNCTION strStackm
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== String cleaning: replace tabulation by spaces, remove NULL characters and comments. ======================================
-!==============================================================================================================================
-SUBROUTINE strClean_1(str)
-    CHARACTER(LEN=*), INTENT(INOUT) :: str
-  INTEGER :: k, n, m
-  n = LEN(str)
-  DO k = n, 1, -1
-    m = IACHAR(str(k:k))
-    IF(m==9) str(k:k) = ' '                           !--- Replace the tabulations with spaces
-    IF(m==0) str(k:n) = str(k+1:n)//' '               !--- Remove the NULL characters
-  END DO
-  m = INDEX(str,'!')-1; IF(m==-1) m = LEN_TRIM(str)   !--- Remove end of line comment
-  str = ADJUSTL(str(1:m))
-END SUBROUTINE strClean_1
-!==============================================================================================================================
-SUBROUTINE strClean_m(str)
-    CHARACTER(LEN=*), INTENT(INOUT) :: str(:)
-  INTEGER :: k
-  DO k = 1, SIZE(str); CALL strClean_1(str(k)); END DO
-END SUBROUTINE strClean_m
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== strReduce_1(str1)     : Remove duplicated elements of str1.    ===========================================================
-!=== strReduce_2(str1,str2): Append str1 with new elements of str2. ===========================================================
-!==============================================================================================================================
-SUBROUTINE strReduce_1(str, nb)
-    CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str(:)
-  INTEGER,          OPTIONAL,    INTENT(OUT)   :: nb
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:)
-  INTEGER :: k, n, n1
-  IF(PRESENT(nb)) nb = 0
-  CALL MOVE_ALLOC(FROM=str, TO=s1); CALL strClean(s1)
-  n1 = SIZE(s1, DIM=1)                                     !--- Total nb. of elements in "s1"
-  n  = COUNT( [( ALL(s1(1:k-1)/=s1(k)), k=1, n1 )] )       !--- Nb of unique elements in "s1"
-  ALLOCATE(str(n))
-  IF(n==0) RETURN
-  str(1) = s1(1)
-  n=1; DO k=2,n1; IF(ANY(s1(1:k-1)==s1(k))) CYCLE; n=n+1; str(n)=s1(k); END DO
-  IF(PRESENT(nb)) nb=n
-END SUBROUTINE strReduce_1
-!==============================================================================================================================
-SUBROUTINE strReduce_2(str1, str2)
-    CHARACTER(LEN=*),   ALLOCATABLE, INTENT(INOUT) :: str1(:)
-  CHARACTER(LEN=*),                INTENT(IN)    :: str2(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:), s2(:)
-  INTEGER :: k
-  IF(SIZE(str2)==0) RETURN
-  s2 = str2; CALL strClean(s2)
-  IF(.NOT.ALLOCATED(s2)) RETURN
-  IF(SIZE(s2) == 0) THEN; DEALLOCATE(s2); RETURN; END IF
-  IF(.NOT.ALLOCATED(str1)) THEN
-    str1 = s2
-  ELSE IF(SIZE(str1)==0) THEN
-    str1 = s2
-  ELSE
-    s1 = str1; CALL strClean(s1)
-    str1 = [s1, PACK(s2, MASK= [( ALL(s1(:) /= s2(k)), k=1, SIZE(s2) )] ) ]
-  END IF
-END SUBROUTINE strReduce_2
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== GET THE INDEX OF THE FIRST APPEARANCE IN THE STRING VECTOR "str(:)" OF THE STRING(s) "s[(:)]" ============================
-!=== OPTIONALY: GET THE NUMBER OF FOUND ELEMENTS "n". NB: UNFOUND => INDEX=0                       ============================
-!==============================================================================================================================
-INTEGER FUNCTION strIdx_1(str, s) RESULT(out)
-    CHARACTER(LEN=*), INTENT(IN) :: str(:), s
-  DO out = 1, SIZE(str); IF(str(out) == s) EXIT; END DO
-  IF(out == 1+SIZE(str) .OR. SIZE(str)==0) out = 0
-END FUNCTION strIdx_1
-!==============================================================================================================================
-FUNCTION strIdx_m(str, s, n) RESULT(out)
-    CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s(:)
-  INTEGER, OPTIONAL, INTENT(OUT) :: n
-  INTEGER,           ALLOCATABLE :: out(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: k
-  out = [(strIdx_1(str(:), s(k)), k=1, SIZE(s))]
-  IF(PRESENT(n)) n = COUNT(out(:)/=0)
-END FUNCTION strIdx_m
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== GET THE INDEX LIST OF THE ELEMENTS OF "str(:)" EQUAL TO "s" AND OPTIONALY, ITS LENGTH "n" ================================
-!==============================================================================================================================
-FUNCTION strFind_1(str, s, n) RESULT(out)
-    CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s
-  INTEGER, OPTIONAL, INTENT(OUT) :: n
-  INTEGER,           ALLOCATABLE :: out(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: k
-  out = PACK( [(k, k=1, SIZE(str(:), DIM=1))], MASK = str(:) == s )
-  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
-END FUNCTION strFind_1
-!==============================================================================================================================
-FUNCTION strFind_m(str, s, n) RESULT(out)
-    CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s(:)
-  INTEGER, OPTIONAL, INTENT(OUT) :: n
-  INTEGER,           ALLOCATABLE :: out(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: k
-  out = [(strFind_1(str, s(k)), k=1, SIZE(s))]
-  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
-END FUNCTION strFind_m
-!==============================================================================================================================
-FUNCTION intFind_1(i,j,n) RESULT(out)
-    INTEGER,           INTENT(IN)  :: i(:), j
-  INTEGER, OPTIONAL, INTENT(OUT) :: n
-  INTEGER,           ALLOCATABLE :: out(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: k
-  out = PACK( [(k, k=1, SIZE(i(:), DIM=1))], MASK = i(:) == j )
-  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
-END FUNCTION intFind_1
-!==============================================================================================================================
-FUNCTION intFind_m(i,j,n) RESULT(out)
-    INTEGER,           INTENT(IN)  :: i(:), j(:)
-  INTEGER, OPTIONAL, INTENT(OUT) :: n
-  INTEGER,           ALLOCATABLE :: out(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: k
-  out = [(intFind_1(i, j(k)), k=1, SIZE(j))]
-  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
-END FUNCTION intFind_m
-!==============================================================================================================================
-FUNCTION booFind(l,n) RESULT(out)
-    LOGICAL,           INTENT(IN)  :: l(:)
-  INTEGER, OPTIONAL, INTENT(OUT) :: n
-  INTEGER,           ALLOCATABLE :: out(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: k
-  out = PACK( [(k, k=1, SIZE(l(:), DIM=1))], MASK = l(:) )
-  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
-END FUNCTION booFind
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== GET THE INDEX IN "rawList" OF THE 1ST APPEARANCE OF ONE OF THE "del(:)" SEPARATORS (0 IF NONE OF THEM ARE PRESENT)
-!===  IF lSc == .TRUE.:  * SKIP HEAD SIGNS OR EXPONENTS SIGNS THAT SHOULD NOT BE CONFUSED WITH SEPARATORS
-!===                     * THEN TEST WHETHER THE STRING FROM START TO THE FOUND SEPARATOR IS A CORRECTLY FORMATTED NUMBER
-!==============================================================================================================================
-LOGICAL FUNCTION strIdx_prv(rawList, del, ibeg, idx, idel, lSc) RESULT(lerr)
-    CHARACTER(LEN=*),  INTENT(IN)  :: rawList                          !--- String in which delimiters have to be identified
-  CHARACTER(LEN=*),  INTENT(IN)  :: del(:)                           !--- List of delimiters
-  INTEGER,           INTENT(IN)  :: ibeg                             !--- Start index
-  INTEGER,           INTENT(OUT) :: idx                              !--- Index of the first identified delimiter in "rawList"
-  INTEGER,           INTENT(OUT) :: idel                             !--- Index of the identified delimiter (0 if idx==0)
-  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc                              !--- Care about nbs with front sign or in scient. notation
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: idx0                                                    !--- Used to display an identified non-numeric string
-  lerr = .FALSE.
-  idx = strIdx1(rawList, del, ibeg, idel)                            !--- idx/=0: del(idel) is at position "idx" in "rawList"
-  IF(.NOT.PRESENT(lSc))               RETURN                         !--- No need to check exceptions for numbers => finished
-  IF(.NOT.        lSc )               RETURN                         !--- No need to check exceptions for numbers => finished
-
-  !=== No delimiter found: the whole string must be a valid number
-  IF(idx == 0) THEN                                                  !--- No element of "del" in "rawList"
-    lerr = .NOT.is_numeric(rawList(ibeg:LEN_TRIM(rawList)))          !--- String must be a number
-    IF(lerr) idx = LEN_TRIM(rawList); RETURN                         !--- Set idx so that rawList(ibeg:idx-1) = whole string
-  END IF
-
-  lerr = idx == 1 .AND. INDEX('+-',del(idel)) /= 0; IF(lerr) RETURN  !--- The front delimiter is different from +/-: error
-  IF(    idx /= 1 .AND. is_numeric(rawList(ibeg:idx-1)))     RETURN  !--- The input string head is a valid number
-
-  !=== The string part in front of the 1st delimiter is not a valid number: search for next delimiter index "idx"
-  idx0 = idx ; idx = strIdx1(rawList, del, idx+1, idel)              !--- Keep start index because idx is recycled
-  IF(idx == 0) THEN
-    lerr = .NOT.is_numeric(rawList(ibeg:LEN_TRIM(rawList)))          !--- No other delimiter: whole string must be a valid numb
-    IF(lerr) idx = idx0; RETURN
-  END IF
-  lerr = .NOT.is_numeric(rawList(ibeg:idx-1))
-
-CONTAINS
-
-!------------------------------------------------------------------------------------------------------------------------------
-INTEGER FUNCTION strIdx1(str, del, ib, id) RESULT(i)
-!--- Get the index of the first appereance of one of the delimiters "del(:)" in "str" starting from position "ib".
-!--- "id" is the index in "del(:)" of the first delimiter found.
-    CHARACTER(LEN=*),  INTENT(IN)  :: str, del(:)
-  INTEGER,           INTENT(IN)  :: ib
-  INTEGER,           INTENT(OUT) :: id
-!------------------------------------------------------------------------------------------------------------------------------
-  DO i = ib, LEN_TRIM(str); id = strIdx(del, str(i:i)); IF(id /= 0) EXIT; END DO
-  IF(i > LEN_TRIM(str)) THEN; i = 0; id = 0; END IF
-END FUNCTION strIdx1
-
-END FUNCTION strIdx_prv
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== Count the number of elements separated by "delimiter" in list "rawList". =================================================
-!==============================================================================================================================
-LOGICAL FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr)
-    CHARACTER(LEN=*),  INTENT(IN)  :: rawList
-  CHARACTER(LEN=*),  INTENT(IN)  :: delimiter
-  INTEGER,           INTENT(OUT) :: nb
-  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc
-!------------------------------------------------------------------------------------------------------------------------------
-  LOGICAL :: ll
-  ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
-  lerr = strCount_1m(rawList, [delimiter], nb, ll)
-END FUNCTION strCount_11
-!==============================================================================================================================
-LOGICAL FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr)
-    CHARACTER(LEN=*),     INTENT(IN)  :: rawList(:)
-  CHARACTER(LEN=*),     INTENT(IN)  :: delimiter
-  INTEGER, ALLOCATABLE, INTENT(OUT) :: nb(:)
-  LOGICAL,    OPTIONAL, INTENT(IN)  :: lSc
-!------------------------------------------------------------------------------------------------------------------------------
-  LOGICAL :: ll
-  INTEGER :: id
-  ll  = .FALSE.; IF(PRESENT(lSc)) ll = lSc .AND. INDEX('+-', delimiter) /= 0
-  lerr = .TRUE.
-  ALLOCATE(nb(SIZE(rawList)))
-  DO id = 1, SIZE(rawList)
-    lerr = lerr .AND. strCount_1m(rawList(id), [delimiter], nb(id), ll)
-  END DO
-END FUNCTION strCount_m1
-!==============================================================================================================================
-LOGICAL FUNCTION strCount_1m(rawList, delimiter, nb, lSc) RESULT(lerr)
-    CHARACTER(LEN=*),  INTENT(IN)  :: rawList
-  CHARACTER(LEN=*),  INTENT(IN)  :: delimiter(:)
-  INTEGER,           INTENT(OUT) :: nb
-  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER              :: ib, ie, jd, nr
-  LOGICAL              :: ll
-  CHARACTER(LEN=1024)  :: r
-  lerr = .FALSE.
-  ll   = .FALSE.; IF(PRESENT(lSc)) ll = lSc
-  r  = TRIM(ADJUSTL(rawList))
-  nr = LEN_TRIM(r); IF(nr == 0) RETURN
-  nb = 1; ib = 1
-  DO
-    lerr = strIdx_prv(r, delimiter, ib, ie, jd, ll)
-    IF(fmsg('"'//TRIM(r(ib:ie-1))//'" is not numeric', ll=lerr)) RETURN
-    IF(ie == 0 .OR. jd == 0) EXIT
-    ib = ie + LEN(delimiter(jd))
-    DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO     !--- Skip spaces before next chain
-    nb = nb + 1
-  END DO
-END FUNCTION strCount_1m
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== Purpose: Parse "delimiter"-separated list "rawList" into the pair keys(:), vals(:).   ====================================
-!===          Corresponding "vals" remains empty if the element does not contain "=" sign. ====================================
-!==============================================================================================================================
-LOGICAL FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr)
-    CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter
-  CHARACTER(LEN=maxlen), ALLOCATABLE,           INTENT(OUT) :: keys(:)
-  INTEGER,                            OPTIONAL, INTENT(OUT) :: n
-  CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: vals(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=1024) :: r
-  INTEGER :: nr, nk
-  lerr = .FALSE.
-  r  = TRIM(ADJUSTL(rawList))
-  nr = LEN_TRIM(r); IF(nr == 0) THEN; keys = ['']; RETURN; END IF
-  nk = countK()                                                      !--- COUNT THE ELEMENTS
-  CALL parseK(keys)                                                  !--- PARSE THE KEYS
-  IF(PRESENT(vals)) CALL parseV(vals)                                !--- PARSE <key>=<val> PAIRS
-  IF(PRESENT(n)) n = nk                                              !--- RETURN THE NUMBER OF KEYS
-
-CONTAINS
-
-!------------------------------------------------------------------------------------------------------------------------------
-INTEGER FUNCTION countK() RESULT(nkeys)
-!--- Get the number of elements after parsing.
-  !------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: ib, ie, nl
-  nkeys = 1; ib = 1; nl = LEN(delimiter)
-  DO
-    ie = INDEX(rawList(ib:nr), delimiter)+ib-1                       !--- Determine the next separator start index
-    IF(ie == ib-1) EXIT
-    ib = ie + nl
-    DO WHILE(ANY([0, 9, 32] == IACHAR(r(ib:ib))) .AND. ib < nr)      !--- Skip blanks (ascii): NULL (0), TAB (9), SPACE (32)
-      ib = ib + 1
-    END DO     !--- Skip spaces before next chain
-    nkeys = nkeys+1
-  END DO
-END FUNCTION countK
-
-!------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE parseK(keys)
-!--- Parse the string separated by "delimiter" from "rawList" into "keys(:)"
-    CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: keys(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: ib, ie, ik
-  ALLOCATE(keys(nk))
-  ib = 1
-  DO ik = 1, nk
-    ie = INDEX(rawList(ib:nr), delimiter)+ib-1                       !--- Determine the next separator start index
-    IF(ie == ib-1) EXIT
-    keys(ik) = r(ib:ie-1)                                            !--- Get the ikth key
-    ib = ie + LEN(delimiter)
-    DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO     !--- Skip spaces before next chain
-  END DO
-  keys(ik) = r(ib:nr)                                                !--- Get the last key
-END SUBROUTINE parseK
-
-!------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE parseV(vals)
-!--- Parse the <key>=<val> pairs in "keys(:)" into "keys" and "vals"
-    CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: vals(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: key
-  INTEGER :: ik, ix
-  ALLOCATE(vals(nk))
-  DO ik = 1, nk; key = keys(ik)
-    vals(ik) = ''
-    ix = INDEX(key, '='); IF(ix == 0) CYCLE                          !--- First "=" index in "key"
-    vals(ik) = ADJUSTL(key(ix+1:LEN_TRIM(key)))
-    keys(ik) = ADJUSTL(key(1:ix-1))
-  END DO
-END SUBROUTINE parseV
-
-END FUNCTION strParse
-!==============================================================================================================================
-LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr)
-    CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter(:)
-  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: keys(:)  !--- Parsed keys vector
-  INTEGER,               OPTIONAL,              INTENT(OUT) :: n        !--- Length of the parsed vector
-  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: vals(:)  !--- Values for <name>=<value> keys
-  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lSc      !--- Take care about numbers in scientific notation
-  INTEGER,               OPTIONAL, ALLOCATABLE, INTENT(OUT) :: id(:)    !--- Indexes of the separators in "delimiter(:)" vector
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=1024) :: r
-  INTEGER :: nr, ik, nk, ib, ie, jd
-  LOGICAL :: ll
-  ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
-  lerr = strCount_1m(rawList, delimiter, nk, ll)
-  CALL msg("Couldn't parse list: non-numerical strings were found", ll=lerr); IF(lerr) RETURN
-
-  !--- FEW ALLOCATIONS
-  ALLOCATE(keys(nk))
-  IF(PRESENT(vals)) ALLOCATE(vals(nk))
-  IF(PRESENT(id))   ALLOCATE(id(nk-1))
-  IF(PRESENT(n)) n = nk
-
-  !--- PARSING
-  r  = TRIM(ADJUSTL(rawList))
-  nr = LEN_TRIM(r); IF(nr == 0) RETURN
-  ib = 1
-  DO ik = 1, nk-1
-    lerr = strIdx_prv(r, delimiter, ib, ie, jd, ll)
-    CALL msg('Non-numeric values found', ll=lerr); IF(lerr) RETURN
-    keys(ik) = r(ib:ie-1)
-    IF(PRESENT(vals)) CALL parseKeys(keys(ik), vals(ik))             !--- Parse a <key>=<val> pair
-    IF(PRESENT(id  )) id(ik) = jd                                    !--- Index in "delimiter(:)" of the "ik"th delimiter
-    ib = ie + LEN_TRIM( delimiter(jd) )                              !--- Length of the current delimiter
-    DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO     !--- Skip spaces before next chain
-  END DO
-  keys(nk) = r(ib:nr)
-  IF(PRESENT(vals)) CALL parseKeys(keys(nk), vals(nk))               !--- Parse a <key>=<val> pair
-
-CONTAINS
-
-!------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE parseKeys(key, val)
-    CHARACTER(LEN=*), INTENT(INOUT) :: key
-  CHARACTER(LEN=*), INTENT(OUT)   :: val
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: ix
-  ix = INDEX(key, '='); IF(ix == 0) RETURN                           !--- First "=" index in "key"
-  val = ADJUSTL(key(ix+1:LEN_TRIM(key)))
-  key = ADJUSTL(key(1:ix-1))
-END SUBROUTINE parseKeys
-
-END FUNCTION strParse_m
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== String substitution: replace "key" by "val" each time it appears in "str".
-!==============================================================================================================================
-SUBROUTINE strReplace_1(str, key, val, lsurr)
-    CHARACTER(LEN=*),  INTENT(INOUT) :: str        !--- Main string
-  CHARACTER(LEN=*),  INTENT(IN)    :: key, val   !--- "key" will be replaced by "val"
-  LOGICAL, OPTIONAL, INTENT(IN)    :: lsurr      !--- TRUE => key must be surrounded by special characters to be substituted
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: i0, ix, nk, ns
-  LOGICAL :: lsur, lb, le
-  lsur = .FALSE.; IF(PRESENT(lsurr)) lsur = lsurr
-  nk = LEN_TRIM(key)
-  i0 = 1
-  DO
-    ns = LEN_TRIM(str)
-    ix = INDEX(str(i0:ns), TRIM(key))            !--- First appearance index of "key" in "s", starting from index "i0"
-    IF(ix == 0) EXIT
-    ix = ix + i0 -1
-    IF(lsur) THEN                                !--- Key must be surrounded by special characters
-      !--- lb=.TRUE.: key is at the very beginning of "str" or located after  a special character
-      lb = ix     ==1;  IF(.NOT.lb) lb = INDEX('+-*/()^', str(ix-1 :ix-1 ))/=0
-      !--- le=.TRUE.: key is at the very end       of "str" or located before a special character
-      le = ix+nk-1==ns; IF(.NOT.le) le = INDEX('+-*/()^', str(ix+nk:ix+nk))/=0
-      IF(.NOT.(lb.AND.le)) THEN; i0 = i0 + nk; CYCLE; END IF
-    END IF
-    str = str(1:ix-1)//TRIM(val)//str(ix+nk:ns)
-  END DO
-END SUBROUTINE strReplace_1
-!==============================================================================================================================
-SUBROUTINE strReplace_m(str, key, val, lsurr)
-    CHARACTER(LEN=*),  INTENT(INOUT) :: str(:)     !--- Main strings vector
-  CHARACTER(LEN=*),  INTENT(IN)    :: key, val   !--- "key" will be replaced by "val"
-  LOGICAL, OPTIONAL, INTENT(IN)    :: lsurr      !--- TRUE => key must be surrounded by special characters to be substituted
-  INTEGER :: k
-  LOGICAL :: ll
-  ll=.FALSE.; IF(PRESENT(lsurr)) ll=lsurr
-  DO k=1, SIZE(str); CALL strReplace_1(str(k),key,val,ll); END DO
-END SUBROUTINE strReplace_m
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== Contatenate horizontally scalars/vectors of strings/integers/reals into a vector/array ===================================
-!==============================================================================================================================
-FUNCTION horzcat_s00(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
-    CHARACTER(LEN=*),                   INTENT(IN) :: s0
-  CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1, s2, s3, s4, s5, s6, s7, s8, s9
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
-  CHARACTER(LEN=maxlen), POINTER     :: s
-  INTEGER                            :: nrow, iv
-  LOGICAL                            :: pre(9)
-!------------------------------------------------------------------------------------------------------------------------------
-  pre(:) = [PRESENT(s1),PRESENT(s2),PRESENT(s3),PRESENT(s4),PRESENT(s5),PRESENT(s6),PRESENT(s7),PRESENT(s8),PRESENT(s9)]
-  nrow = 1+COUNT(pre)
-  ALLOCATE(out(nrow))
-  out(1) = s0
-  DO iv = 2, nrow; IF(.NOT.pre(iv-1)) CYCLE
-    SELECT CASE(iv-1)
-      CASE(1); s=> s1; CASE(2); s=> s2; CASE(3); s=> s3; CASE(4); s=> s4; CASE(5); s=> s5
-      CASE(6); s=> s6; CASE(7); s=> s7; CASE(8); s=> s8; CASE(9); s=> s9
-    END SELECT
-    out(iv) = s
-  END DO
-END FUNCTION horzcat_s00
-!==============================================================================================================================
-FUNCTION horzcat_s10(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
-    CHARACTER(LEN=*),           INTENT(IN) :: s0(:), s1
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s2, s3, s4, s5, s6, s7, s8, s9
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:), tmp(:)
-  INTEGER :: nc
-  nc = SIZE(s0)
-  tmp = horzcat_s00(s0(nc), s1, s2, s3, s4, s5, s6, s7, s8, s9)
-  IF(nc == 1) out = tmp
-  IF(nc /= 1) out = [s0(1:nc-1), tmp]
-END FUNCTION horzcat_s10
-!==============================================================================================================================
-FUNCTION horzcat_s11(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
-    CHARACTER(LEN=*),                   INTENT(IN) :: s0(:)
-  CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1(:), s2(:), s3(:), s4(:), s5(:), s6(:), s7(:), s8(:), s9(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:)
-  CHARACTER(LEN=maxlen), POINTER     :: s(:)
-  INTEGER                            :: nrow, ncol, iv, n
-  LOGICAL                            :: pre(9)
-!------------------------------------------------------------------------------------------------------------------------------
-  pre(:) = [PRESENT(s1),PRESENT(s2),PRESENT(s3),PRESENT(s4),PRESENT(s5),PRESENT(s6),PRESENT(s7),PRESENT(s8),PRESENT(s9)]
-  nrow = SIZE(s0)
-  ncol = 1+COUNT(pre)
-  ALLOCATE(out(nrow, ncol))
-  out(:,1) = s0
-  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
-    SELECT CASE(iv-1)
-      CASE(1); s=> s1; CASE(2); s=> s2; CASE(3); s=> s3; CASE(4); s=> s4; CASE(5); s=> s5
-      CASE(6); s=> s6; CASE(7); s=> s7; CASE(8); s=> s8; CASE(9); s=> s9
-    END SELECT
-    n = SIZE(s, DIM=1)
-    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
-    out(:,iv) = s(:)
-  END DO
-END FUNCTION horzcat_s11
-!==============================================================================================================================
-FUNCTION horzcat_s21(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
-    CHARACTER(LEN=*),           INTENT(IN) :: s0(:,:), s1(:)
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s2(:), s3(:), s4(:), s5(:), s6(:), s7(:), s8(:), s9(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:), tmp(:,:)
-  INTEGER :: nc
-  nc  = SIZE(s0, 2)
-  tmp = horzcat_s11(s0(:,nc), s1, s2, s3, s4, s5, s6, s7, s8, s9)
-  IF(nc == 1) out = tmp
-  IF(nc /= 1) out = RESHAPE([PACK(s0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(s0, 1), nc + SIZE(tmp, 2)-1])
-END FUNCTION horzcat_s21
-!==============================================================================================================================
-FUNCTION horzcat_i00(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
-    INTEGER,                   INTENT(IN) :: i0
-  INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1, i2, i3, i4, i5, i6, i7, i8, i9
-  INTEGER, ALLOCATABLE :: out(:)
-  INTEGER, POINTER     :: i
-  INTEGER              :: ncol, iv
-  LOGICAL              :: pre(9)
-!------------------------------------------------------------------------------------------------------------------------------
-  pre(:) = [PRESENT(i1),PRESENT(i2),PRESENT(i3),PRESENT(i4),PRESENT(i5),PRESENT(i6),PRESENT(i7),PRESENT(i8),PRESENT(i9)]
-  ncol = SIZE(pre)
-  ALLOCATE(out(ncol))
-  out(1) = i0
-  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
-    SELECT CASE(iv-1)
-      CASE(1); i=> i1; CASE(2); i=> i2; CASE(3); i=> i3; CASE(4); i=> i4; CASE(5); i=> i5
-      CASE(6); i=> i6; CASE(7); i=> i7; CASE(8); i=> i8; CASE(9); i=> i9
-    END SELECT
-    out(iv) = i
-  END DO
-END FUNCTION horzcat_i00
-!==============================================================================================================================
-FUNCTION horzcat_i10(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
-    INTEGER,           INTENT(IN) :: i0(:), i1
-  INTEGER, OPTIONAL, INTENT(IN) :: i2, i3, i4, i5, i6, i7, i8, i9
-  INTEGER, ALLOCATABLE :: out(:), tmp(:)
-  INTEGER :: nc
-  nc = SIZE(i0)
-  tmp = horzcat_i00(i0(nc), i1, i2, i3, i4, i5, i6, i7, i8, i9)
-  IF(nc == 1) out = tmp
-  IF(nc /= 1) out = [i0(1:nc-1), tmp]
-END FUNCTION horzcat_i10
-!==============================================================================================================================
-FUNCTION horzcat_i11(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
-    INTEGER,                   INTENT(IN) :: i0(:)
-  INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1(:), i2(:), i3(:), i4(:), i5(:), i6(:), i7(:), i8(:), i9(:)
-  INTEGER, ALLOCATABLE :: out(:,:)
-  INTEGER, POINTER     :: i(:)
-  INTEGER              :: nrow, ncol, iv, n
-  LOGICAL              :: pre(9)
-!------------------------------------------------------------------------------------------------------------------------------
-  pre(:) = [PRESENT(i1),PRESENT(i2),PRESENT(i3),PRESENT(i4),PRESENT(i5),PRESENT(i6),PRESENT(i7),PRESENT(i8),PRESENT(i9)]
-  nrow = SIZE(i0)
-  ncol = 1+COUNT(pre)
-  ALLOCATE(out(nrow, ncol))
-  out(:,1) = i0
-  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
-    SELECT CASE(iv-1)
-      CASE(1); i=> i1; CASE(2); i=> i2; CASE(3); i=> i3; CASE(4); i=> i4; CASE(5); i=> i5
-      CASE(6); i=> i6; CASE(7); i=> i7; CASE(8); i=> i8; CASE(9); i=> i9
-    END SELECT
-    n = SIZE(i, DIM=1)
-    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
-    out(:,iv) = i(:)
-  END DO
-END FUNCTION horzcat_i11
-!==============================================================================================================================
-FUNCTION horzcat_i21(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
-    INTEGER,           INTENT(IN) :: i0(:,:), i1(:)
-  INTEGER, OPTIONAL, INTENT(IN) :: i2(:), i3(:), i4(:), i5(:), i6(:), i7(:), i8(:), i9(:)
-  INTEGER, ALLOCATABLE :: out(:,:), tmp(:,:)
-  INTEGER :: nc
-  nc  = SIZE(i0, 2)
-  tmp = horzcat_i11(i0(:,nc), i1, i2, i3, i4, i5, i6, i7, i8, i9)
-  IF(nc == 1) out = tmp
-  IF(nc /= 1) out = RESHAPE([PACK(i0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(i0, 1), nc + SIZE(tmp, 2)-1])
-END FUNCTION horzcat_i21
-!==============================================================================================================================
-FUNCTION horzcat_r00(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
-    REAL,                   INTENT(IN) :: r0
-  REAL, OPTIONAL, TARGET, INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
-  REAL, ALLOCATABLE :: out(:)
-  REAL, POINTER     :: r
-  INTEGER           :: ncol, iv
-  LOGICAL           :: pre(9)
-!------------------------------------------------------------------------------------------------------------------------------
-  pre(:) = [PRESENT(r1),PRESENT(r2),PRESENT(r3),PRESENT(r4),PRESENT(r5),PRESENT(r6),PRESENT(r7),PRESENT(r8),PRESENT(r9)]
-  ncol = 1+COUNT(pre)
-  ALLOCATE(out(ncol))
-  out(1) = r0
-  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
-    SELECT CASE(iv-1)
-      CASE(1); r=> r1; CASE(2); r=> r2; CASE(3); r=> r3; CASE(4); r=> r4; CASE(5); r=> r5
-      CASE(6); r=> r6; CASE(7); r=> r7; CASE(8); r=> r8; CASE(9); r=> r9
-    END SELECT
-    out(iv) = r
-  END DO
-END FUNCTION horzcat_r00
-!==============================================================================================================================
-FUNCTION horzcat_r10(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
-    REAL,           INTENT(IN) :: r0(:), r1
-  REAL, OPTIONAL, INTENT(IN) :: r2, r3, r4, r5, r6, r7, r8, r9
-  REAL, ALLOCATABLE :: out(:), tmp(:)
-  INTEGER :: nc
-  nc  = SIZE(r0)
-  tmp = horzcat_r00(r0(nc), r1, r2, r3, r4, r5, r6, r7, r8, r9)
-  IF(nc == 1) out = tmp
-  IF(nc /= 1) out = [r0(1:nc-1), tmp]
-END FUNCTION horzcat_r10
-!==============================================================================================================================
-FUNCTION horzcat_r11(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
-    REAL,                   INTENT(IN) :: r0(:)
-  REAL, OPTIONAL, TARGET, INTENT(IN) :: r1(:), r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
-  REAL, ALLOCATABLE :: out(:,:)
-  REAL, POINTER     :: r(:)
-  INTEGER           :: nrow, ncol, iv, n
-  LOGICAL           :: pre(9)
-!------------------------------------------------------------------------------------------------------------------------------
-  pre(:) = [PRESENT(r1),PRESENT(r2),PRESENT(r3),PRESENT(r4),PRESENT(r5),PRESENT(r6),PRESENT(r7),PRESENT(r8),PRESENT(r9)]
-  nrow = SIZE(r0)
-  ncol = 1+COUNT(pre)
-  ALLOCATE(out(nrow, ncol))
-  out(:,1) = r0
-  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
-    SELECT CASE(iv-1)
-      CASE(1); r=> r1; CASE(2); r=> r2; CASE(3); r=> r3; CASE(4); r=> r4; CASE(5); r=> r5
-      CASE(6); r=> r5; CASE(7); r=> r7; CASE(8); r=> r8; CASE(9); r=> r9
-    END SELECT
-    n = SIZE(r, DIM=1)
-    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
-    out(:,iv) = r(:)
-  END DO
-END FUNCTION horzcat_r11
-!==============================================================================================================================
-FUNCTION horzcat_r21(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
-    REAL,           INTENT(IN) :: r0(:,:), r1(:)
-  REAL, OPTIONAL, INTENT(IN) :: r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
-  REAL, ALLOCATABLE :: out(:,:), tmp(:,:)
-  INTEGER :: nc
-  nc  = SIZE(r0, 2)
-  tmp = horzcat_r11(r0(:,nc), r1, r2, r3, r4, r5, r6, r7, r8, r9)
-  IF(nc == 1) out = tmp
-  IF(nc /= 1) out = RESHAPE([PACK(r0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(r0, 1), nc + SIZE(tmp, 2)-1])
-END FUNCTION horzcat_r21
-!==============================================================================================================================
-FUNCTION horzcat_d00(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
-    DOUBLE PRECISION,                   INTENT(IN) :: d0
-  DOUBLE PRECISION, OPTIONAL, TARGET, INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
-  DOUBLE PRECISION, ALLOCATABLE :: out(:)
-  DOUBLE PRECISION, POINTER     :: d
-  INTEGER                       :: ncol, iv
-  LOGICAL                       :: pre(9)
-!------------------------------------------------------------------------------------------------------------------------------
-  pre(:) = [PRESENT(d1),PRESENT(d2),PRESENT(d3),PRESENT(d4),PRESENT(d5),PRESENT(d6),PRESENT(d7),PRESENT(d8),PRESENT(d9)]
-  ncol = 1+COUNT(pre)
-  ALLOCATE(out(ncol))
-  out(1) = d0
-  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
-    SELECT CASE(iv-1)
-      CASE(1); d=> d1; CASE(2); d=> d2; CASE(3); d=> d3; CASE(4); d=> d4; CASE(5); d=> d5
-      CASE(6); d=> d6; CASE(7); d=> d7; CASE(8); d=> d8; CASE(9); d=> d9
-    END SELECT
-    out(iv) = d
-  END DO
-END FUNCTION horzcat_d00
-!==============================================================================================================================
-FUNCTION horzcat_d10(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
-    DOUBLE PRECISION,           INTENT(IN) :: d0(:), d1
-  DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: d2, d3, d4, d5, d6, d7, d8, d9
-  DOUBLE PRECISION, ALLOCATABLE :: out(:), tmp(:)
-  INTEGER :: nc
-  nc = SIZE(d0)
-  tmp = horzcat_d00(d0(nc), d1, d2, d3, d4, d5, d6, d7, d8, d9)
-  IF(nc == 1) out = tmp
-  IF(nc /= 1) out = [d0(1:nc-1), tmp]
-END FUNCTION horzcat_d10
-!==============================================================================================================================
-FUNCTION horzcat_d11(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
-    DOUBLE PRECISION,                   INTENT(IN) :: d0(:)
-  DOUBLE PRECISION, OPTIONAL, TARGET, INTENT(IN) :: d1(:), d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
-  DOUBLE PRECISION, ALLOCATABLE :: out(:,:)
-  DOUBLE PRECISION, POINTER     :: d(:)
-  INTEGER                       :: nrow, ncol, iv, n
-  LOGICAL                       :: pre(9)
-!------------------------------------------------------------------------------------------------------------------------------
-  nrow = SIZE(d0)
-  pre(:) = [PRESENT(d1),PRESENT(d2),PRESENT(d3),PRESENT(d4),PRESENT(d5),PRESENT(d6),PRESENT(d7),PRESENT(d8),PRESENT(d9)]
-  ncol = 1+COUNT(pre)
-  ALLOCATE(out(nrow, ncol))
-  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
-    SELECT CASE(iv-1)
-      CASE(1); d=> d1; CASE(2); d=> d2; CASE(3); d=> d3; CASE(4); d=> d4; CASE(5); d=> d5
-      CASE(6); d=> d6; CASE(7); d=> d7; CASE(8); d=> d8; CASE(9); d=> d9
-    END SELECT
-    n = SIZE(d, DIM=1)
-    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
-    out(:,iv) = d(:)
-  END DO
-END FUNCTION horzcat_d11
-!==============================================================================================================================
-FUNCTION horzcat_d21(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
-    DOUBLE PRECISION,           INTENT(IN) :: d0(:,:), d1(:)
-  DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
-  DOUBLE PRECISION, ALLOCATABLE :: out(:,:), tmp(:,:)
-  INTEGER :: nc
-  nc  = SIZE(d0, 2)
-  tmp = horzcat_d11(d0(:,nc), d1, d2, d3, d4, d5, d6, d7, d8, d9)
-  IF(nc == 1) out = tmp
-  IF(nc /= 1) out = RESHAPE([PACK(d0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(d0, 1), nc + SIZE(tmp, 2)-1])
-END FUNCTION horzcat_d21
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!--- Display a clean table composed of successive vectors of same length.
-!=== The profile "p" describe in which order to pick up the columns from "s", "i" and "r" for display.
-!===  * nRowMax lines are displayed (default: all lines)
-!===  * nColMax characters (default: as long as needed) are displayed at most on a line. If the effective total length is
-!===    higher, several partial tables are displayed ; the nHead (default: 1) first columns are included in each sub-table.
-!==============================================================================================================================
-LOGICAL FUNCTION dispTable(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr)
-    CHARACTER(LEN=*),           INTENT(IN)  :: p             !--- DISPLAY MAP: s/i/r
-  CHARACTER(LEN=*),           INTENT(IN)  :: titles(:)     !--- TITLES (ONE EACH COLUMN)
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: s(:,:)        !--- STRINGS
-  INTEGER,          OPTIONAL, INTENT(IN)  :: i(:,:)        !--- INTEGERS
-  REAL,             OPTIONAL, INTENT(IN)  :: r(:,:)        !--- REALS
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: rFmt          !--- Format for reals
-  INTEGER,          OPTIONAL, INTENT(IN)  :: nRowMax       !--- Display at most "nRowMax" rows
-  INTEGER,          OPTIONAL, INTENT(IN)  :: nColMax       !--- Display at most "nColMax" characters each line
-  INTEGER,          OPTIONAL, INTENT(IN)  :: nHead         !--- Head columns repeated for multiple tables display
-  INTEGER,          OPTIONAL, INTENT(IN)  :: unit          !--- Output unit (default: screen)
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: sub           !--- Subroutine name
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=2048) :: row
-  CHARACTER(LEN=maxlen)  :: rFm, el, subn
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: d(:,:)
-  CHARACTER(LEN=1) :: s1, sp
-  INTEGER :: is, ii, ir, it, k, nmx,  unt, ic, np
-  INTEGER :: ns, ni, nr, nt, l, ncol, nHd, ib, l0
-  INTEGER, ALLOCATABLE :: n(:), ncmx(:)
-  INTEGER, PARAMETER   :: nm=1                             !--- Space between values & columns
-  LOGICAL :: ls, li, lr
-  subn = '';    IF(PRESENT(sub)) subn = sub
-  rFm = '*';    IF(PRESENT(rFmt)) rFm = rFmt               !--- Specified format for reals
-  unt = lunout; IF(PRESENT(unit)) unt = unit               !--- Specified output unit
-  np = LEN_TRIM(p); ns = 0; ni = 0; nr = 0; ncol = 0
-  ls = PRESENT(s); li = PRESENT(i); lr = PRESENT(r)
-  lerr = .FALSE.; IF(.NOT.ANY([ls,li,lr])) RETURN          !--- Nothing to do
-  sp = '|'                                                 !--- Separator
-
-  !--- CHECK ARGUMENTS COHERENCE
-  lerr = np /= SIZE(titles); IF(fmsg('display map "p" length and titles list mismatch', subn, lerr)) RETURN
-  IF(ls) THEN
-    ns = SIZE(s, 1); ncol = ncol + SIZE(s, 2); lerr = COUNT([(p(ic:ic)=='s', ic=1, np)]) /= SIZE(s, 2)
-  END IF
-  IF(li) THEN
-    ni = SIZE(i, 1); ncol = ncol + SIZE(i, 2); lerr = COUNT([(p(ic:ic)=='i', ic=1, np)]) /= SIZE(i, 2)
-  END IF
-  IF(lr) THEN
-    nr = SIZE(r, 1); ncol = ncol + SIZE(r, 2); lerr = COUNT([(p(ic:ic)=='r', ic=1, np)]) /= SIZE(r, 2)
-  END IF
-  IF(fmsg('display map "p" length and arguments number mismatch', subn, lerr)) RETURN
-  lerr = ncol /= SIZE(titles); IF(fmsg('"titles" length and arguments number mismatch', subn, lerr)) RETURN
-  lerr = ls.AND.li.AND.ns/=ni; IF(fmsg('string and integer arguments lengths mismatch', subn, lerr)) RETURN
-  lerr = ls.AND.lr.AND.ns/=nr; IF(fmsg(   'string and real arguments lengths mismatch', subn, lerr)) RETURN
-  lerr = li.AND.lr.AND.ni/=nr; IF(fmsg(  'integer and real arguments lengths mismatch', subn, lerr)) RETURN
-  nmx = MAX(ns,ni,nr)+1; IF(PRESENT(nRowMax)) nmx = MIN(nmx,nRowMax+1)
-
-  !--- Allocate the assembled quantities array
-  ALLOCATE(d(nmx,ncol), n(ncol))
-
-  !--- Assemble the vectors into a strings array in the order indicated by "pattern"
-  is =  1; ii = 1; ir = 1
-  DO ic = 1, ncol
-    d(1,ic) = TRIM(titles(ic))
-    SELECT CASE(p(ic:ic))
-      CASE('s'); d(2:nmx,ic) =          s(:,is)     ; is = is + 1
-      CASE('i'); d(2:nmx,ic) =  int2str(i(:,ii)    ); ii = ii + 1
-      CASE('r'); d(2:nmx,ic) = real2str(r(:,ir),rFm); ir = ir + 1
-    END SELECT
-  END DO
-  CALL cleanZeros(d)
-  DO ic = 1, ncol
-    n(ic)=0; DO ir=1, nmx; n(ic)=MAX(n(ic), LEN_TRIM(d(ir,ic))); END DO
-  END DO
-  n(:) = n(:) + 2*nm
-
-  !--- Build the vector of max column index in case the rows are too long (table must be displayed in multiple parts)
-  nHd = 1; IF(PRESENT(nHead)) nHd = nHead
-  IF(.NOT.PRESENT(nColMax)) THEN
-    nt = 1; ncmx = [ncol]
-  ELSE
-    nt = 1; l0 = SUM(n(1:nHd)+1)+1
-    IF(PRESENT(sub)) l0=l0+LEN_TRIM(subn)+1
-    !--- Count the number of table parts
-    l = l0; DO ic = nHd+1, ncol; l = l+n(ic)+1; IF(l>=nColMax) THEN; nt = nt+1; l = l0+n(ic)+1; END IF; END DO
-    !--- Get the index of the last column for each table part
-    ALLOCATE(ncmx(nt)); k = 1
-    l = l0; DO ic = nHd+1, ncol; l = l+n(ic)+1; IF(l>=nColMax) THEN; ncmx(k) = ic-1; l = l0+n(ic)+1; k = k+1; END IF; END DO
-    ncmx(nt) = ncol
-  END IF
-
-  !--- Display the strings array as a table
-  DO it = 1, nt
-    DO ir = 1, nmx; row = ''
-      DO ic = 1, nHd; el = d(ir,ic)
-        s1 = sp
-        row = TRIM(row)//REPEAT(' ',nm)//TRIM(el)//REPEAT(' ',n(ic)-LEN_TRIM(el)-nm)//s1
-      END DO
-      ib = nHd+1; IF(it>1) ib = ncmx(it-1)+1
-      DO ic = ib, ncmx(it); el = d(ir,ic)
-        s1 = sp
-        row = TRIM(row)//REPEAT(' ',nm)//TRIM(el)//REPEAT(' ',n(ic)-LEN_TRIM(el)-nm)//s1
-      END DO
-      nr = LEN_TRIM(row)-1                                           !--- Final separator removed
-      CALL msg(row(1:nr), subn, unit=unt)
-      IF(ir /= 1) CYCLE                                              !--- Titles only are underlined
-      row=''; DO ic=1,nHd; row=TRIM(row)//REPEAT('-',n(ic))//'+'; END DO
-      DO ic = ib,ncmx(it); row=TRIM(row)//REPEAT('-',n(ic))//'+'; END DO
-      CALL msg(row(1:LEN_TRIM(row)-1), subn, unit=unt)
-    END DO
-    CALL msg('', subn, unit=unt)
-  END DO
-
-END FUNCTION dispTable
-!==============================================================================================================================
-
-!==============================================================================================================================
-LOGICAL FUNCTION dispNamelist(unt, p, titles, s, i, r, rFmt, llast) RESULT(lerr)
-    INTEGER,                    INTENT(IN)  :: unt           !--- Output unit
-  CHARACTER(LEN=*),           INTENT(IN)  :: p             !--- DISPLAY MAP: s/i/r
-  CHARACTER(LEN=*),           INTENT(IN)  :: titles(:)     !--- TITLES (ONE EACH COLUMN)
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: s(:,:)        !--- STRINGS
-  INTEGER,          OPTIONAL, INTENT(IN)  :: i(:,:)        !--- INTEGERS
-  REAL,             OPTIONAL, INTENT(IN)  :: r(:,:)        !--- REALS
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: rFmt          !--- Format for reals
-  LOGICAL,          OPTIONAL, INTENT(IN)  :: llast         !--- Last variable: no final ','
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)  :: rFm, el
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: d(:,:)
-  CHARACTER(LEN=:),      ALLOCATABLE :: sp, row
-  INTEGER :: is, ii, ir, nrow, ic
-  INTEGER :: ns, ni, nr, ncol, np
-  INTEGER, ALLOCATABLE :: n(:)
-  LOGICAL :: ls, li, lr, la
-  rFm = '*';    IF(PRESENT(rFmt)) rFm = rFmt               !--- Specified format for reals
-  ls = PRESENT(s); li = PRESENT(i); lr = PRESENT(r)
-  lerr = .FALSE.; IF(.NOT.ANY([ls,li,lr])) RETURN          !--- Nothing to do
-  la = .FALSE.; IF(PRESENT(llast)) la = llast
-
-  !--- CHECK ARGUMENTS COHERENCE
-  ns = 0; ni = 0; nr = 0; np = LEN_TRIM(p); ncol = 0
-  IF(ls) THEN; ns = SIZE(s, DIM=1); ncol = ncol + SIZE(s, DIM=2)
-    lerr = COUNT([(p(ic:ic)=='s', ic=1, np)]) /= SIZE(s, DIM=2)
-  END IF
-  IF(li) THEN; ni = SIZE(i, DIM=1); ncol = ncol + SIZE(i, DIM=2)
-    lerr = COUNT([(p(ic:ic)=='i', ic=1, np)]) /= SIZE(i, DIM=2)
-  END IF
-  IF(lr) THEN; nr = SIZE(r, DIM=1); ncol = ncol + SIZE(r, DIM=2)
-    lerr = COUNT([(p(ic:ic)=='r', ic=1, np)]) /= SIZE(r, DIM=2)
-  END IF
-  IF(fmsg('display map "p" length and arguments number mismatch', ll=lerr)) RETURN
-  lerr = ncol /= SIZE(titles); IF(fmsg('"titles" length and arguments number mismatch', ll=lerr)) RETURN
-  lerr = ls.AND.li.AND.ns/=ni; IF(fmsg('string and integer arguments lengths mismatch', ll=lerr)) RETURN
-  lerr = ls.AND.lr.AND.ns/=nr; IF(fmsg(   'string and real arguments lengths mismatch', ll=lerr)) RETURN
-  lerr = li.AND.lr.AND.ni/=nr; IF(fmsg(  'integer and real arguments lengths mismatch', ll=lerr)) RETURN
-
-  !--- Allocate the assembled quantities array
-  nrow = MAX(ns,ni,nr)+1
-  ALLOCATE(d(nrow,ncol), n(ncol))
-
-  !--- Assemble the vectors into a strings array in the order indicated by "pattern"
-  is =  1; ii = 1; ir = 1
-  DO ic = 1, ncol
-    d(1,ic) = TRIM(titles(ic))
-    SELECT CASE(p(ic:ic))
-      CASE('s'); d(2:nrow,ic) =          s(:,is)     ; is = is + 1
-      CASE('i'); d(2:nrow,ic) =  int2str(i(:,ii)    ); ii = ii + 1
-      CASE('r'); d(2:nrow,ic) = real2str(r(:,ir),rFm); ir = ir + 1
-    END SELECT
-  END DO
-  CALL cleanZeros(d)
-  DO ic = 1, ncol
-    n(ic) = 0; DO ir=1, nrow; n(ic)=MAX(n(ic), LEN_TRIM(d(ir,ic))); END DO
-    IF(needQuotes(d(2,ic)) .AND. ic/=1) n(ic) = n(ic) + 2 !--- For quotes, using second line only
-  END DO
-
-  !--- Display the strings array as a table
-  DO ir = 1, nrow
-    row = ''; sp = '   '; IF(TRIM(d(ir,1)) /= '') sp = ' = '
-    DO ic = 1, ncol
-      el = d(ir,ic); IF(ic /= 1) el = addQuotes_1(el)
-      row = row//TRIM(el)//REPEAT(' ',n(ic)-LEN_TRIM(el))//sp
-      sp = '   '; IF(ic /= ncol-1) CYCLE
-      IF(TRIM(d(MIN(ir+1,nrow),1)) /= '' .AND. (ir /= nrow .OR. .NOT.la)) sp = ' , '
-    END DO
-    WRITE(unt,'(a)')TRIM(row)
-  END DO
-
-  !--- End of section
-  IF(la) THEN
-    WRITE(unt,'(a)')'/'
-    WRITE(unt,'(a)')
-  END IF
-
-END FUNCTION dispNameList
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-LOGICAL FUNCTION dispOutliers_1(ll, a, n, err_msg, nam, subn, nRowmax, nColMax, nHead, unit) RESULT(lerr)
-  ! Display outliers list in tables
-! If "nam" is supplied, it means the last index is for tracers => one table each tracer for rank > 2.
-  LOGICAL,                    INTENT(IN)  :: ll(:)                   !--- Linearized mask of outliers
-  REAL,                       INTENT(IN)  ::  a(:)                   !--- Linearized array of values
-  INTEGER,                    INTENT(IN)  ::  n(:)                   !--- Profile before linearization
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: err_msg, nam(:), subn   !--- Error message, variables and calling SUBROUTINE names
-  INTEGER,          OPTIONAL, INTENT(IN)  :: nRowMax                 !--- Maximum number of lines to display    (default: all)
-  INTEGER,          OPTIONAL, INTENT(IN)  :: nColMax                 !--- Maximum number of characters per line (default: 2048)
-  INTEGER,          OPTIONAL, INTENT(IN)  :: nHead                   !--- Number of front columns to duplicate  (default: 1)
-  INTEGER,          OPTIONAL, INTENT(IN)  :: unit                    !--- Output unit                           (def: lunout)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen),      ALLOCATABLE :: ttl(:)
-  LOGICAL,                    ALLOCATABLE :: m(:)
-  INTEGER,                    ALLOCATABLE :: ki(:), kj(:)
-  INTEGER                                 :: i, j, k, rk, rk1, ib, ie, itr, nm, unt, nRmx, nCmx, nHd, nv
-  CHARACTER(LEN=maxlen)                   :: mes, sub, fm='(f12.9)', v, s
-  CHARACTER(LEN=maxlen),      ALLOCATABLE :: vnm(:)
-
-  lerr = ANY(ll); IF(.NOT.lerr) RETURN                               !--- No outliers -> finished
-
-  mes = 'outliers found'; IF(PRESENT(err_msg)) mes = err_msg         !--- Error message
-  vnm = ['a'];            IF(PRESENT(nam ))    vnm = nam             !--- Variables names
-  sub = 'dispOutliers';   IF(PRESENT(subn))    sub = subn            !--- Calling SUBROUTINE name
-  nRmx= SIZE(a);          IF(PRESENT(nRowMax)) nRmx=MIN(nRmx,nRowMax)!-- Maximum number of lines to print
-  nCmx= 2048;             IF(PRESENT(nColMax)) nCmx=MIN(nCmx,nColMax)!-- Maximum number of characters each line
-  nHd = 1;                IF(PRESENT(nHead))   nHd = nHead           !--- Number of front columns to duplicate
-  unt = lunout;           IF(PRESENT(unit))    unt = unit            !--- Unit to print messages
-
-  rk = SIZE(n); nv = SIZE(vnm)
-  lerr = nv/=1 .AND. nv/=n(rk); CALL msg('SIZE(nam) /= 1 and /= last "n" element', sub, lerr); IF(lerr) RETURN
-  lerr = SIZE(a) /=   SIZE(ll); CALL msg('ll" and "a" sizes mismatch',             sub, lerr); IF(lerr) RETURN
-  lerr = SIZE(a) /= PRODUCT(n); CALL msg('profile "n" does not match "a" and "ll', sub, lerr); IF(lerr) RETURN
-  CALL msg(mes, sub, unit=unt)
-
-  !--- SCALAR CASE: single value to display
-  IF(rk==1.AND.n(1)==1) THEN
-    IF(ll(1)) WRITE(unt,'(a," = ",f12.9)')TRIM(nam(1)),a(1); RETURN
-  END IF
-
-  rk1 = rk; IF(nv==1) rk1 = rk-1                                    !--- Rank of each displayed table
-  SELECT CASE(rk1)                                                  !--- Indices list
-    CASE(1,2); ki = [ (i,i=1,n(1)) ]
-    CASE(3);   ki = [((i,i=1,n(1)),j=1,n(2))]; kj = [((j,i=1,n(1)),j=1,n(2))]
-    CASE DEFAULT; WRITE(unt,*)'Sorry: routine "dispOutliers" is limited to rank 3'; RETURN
-  END SELECT
-
-  !--- VECTOR CASE:  table " name | value " (known names)  /  )  /  " i | a(i) " (unknown names)
-  IF(rk==1) THEN
-    ALLOCATE(ttl(2)); ttl(2) = TRIM(vnm(1))//'(i)'; ttl(1) = 'i'
-    IF(nv == 1) lerr = dispTable('sr', ttl,               s=cat(PACK(nam,ll)), r=cat(PACK(a,ll)), &
-                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
-    IF(nv /= 1) lerr = dispTable('ir', ['name ','value'], i=cat(PACK(ki,m)),   r=cat(PACK(a,ll)), &
-                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
-    CALL msg("can't display outliers table", sub, lerr, unt)
-    RETURN
-  END IF
-
-  !--- OTHER CASES: one table for each tracer (last index)
-  ttl = [(ACHAR(k), k = 105, 104+rk)]                                !--- Titles list ('i', 'j', 'k'...)
-  s = strStack( ttl(1:rk-1) )                                        !--- Tracer name dummy indexes: (i, j, k, ...
-
-  DO itr=1,n(rk)
-    nm = PRODUCT(n(1:rk-1))                                          !--- number of elements per tracer
-    ie = itr*nm; ib = ie-nm+1; m=ll(ib:ie)                           !--- section bounds for tracer "itr" ; outlayers mask
-    IF(.NOT.ANY(m)) CYCLE                                            !--- no outlayers for tracer "itr"
-    v = TRIM(vnm(MIN(itr,SIZE(vnm))))//'('//TRIM(s)                  !--- "<name>("
-    IF(nv == 1) ttl(rk) = TRIM(v)//','//int2str(itr)//')'            !--- "<name>(i,j,itr)" (single name)
-    IF(nv /= 1) ttl(rk) = TRIM(v)//')'                               !--- "<nam(itr)>(i,j)" (one name each table/itr index)
-    IF(rk==2) lerr = dispTable('ir',  ttl, i=cat(PACK(ki,m)),            r=cat(PACK(a(ib:ie),m)), &
-                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
-    IF(rk==3) lerr = dispTable('iir', ttl, i=cat(PACK(ki,m),PACK(kj,m)), r=cat(PACK(a(ib:ie),m)), &
-                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
-    CALL msg("can't display outliers table", sub, lerr, unt)
-    IF(lerr) RETURN
-  END DO
-END FUNCTION dispOutliers_1
-!==============================================================================================================================
-LOGICAL FUNCTION dispOutliers_2(ll, a, n, err_msg, nam, subn, nRowMax, nColMax, nHead, unit) RESULT(lerr)
-  ! Display outliers list in tables
-! If "nam" is supplied and, it means the last index is for tracers => one table each tracer for rank > 2.
-  LOGICAL,                    INTENT(IN)  :: ll(:)                   !--- Linearized mask of outliers
-  REAL,                       INTENT(IN)  ::  a(:,:)                 !--- Linearized arrays of values stacked along 2nd dim.
-  INTEGER,                    INTENT(IN)  ::  n(:)                   !--- Profile before linearization
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: err_msg, nam(:), subn   !--- Error message, variables and calling SUBROUTINE names
-  INTEGER,          OPTIONAL, INTENT(IN)  :: nRowMax                 !--- Maximum number of lines to display    (default: all)
-  INTEGER,          OPTIONAL, INTENT(IN)  :: nColMax                 !--- Maximum number of characters per line (default: 2048)
-  INTEGER,          OPTIONAL, INTENT(IN)  :: nHead                   !--- Number of front columns to duplicate  (default: 1)
-  INTEGER,          OPTIONAL, INTENT(IN)  :: unit                    !--- Output unit                           (def: lunout)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)                   :: mes, sub, fm='(f12.9)', prf
-  CHARACTER(LEN=maxlen),      ALLOCATABLE :: ttl(:), vnm(:)
-  INTEGER,                    ALLOCATABLE :: ki(:), kj(:), kl(:)
-  INTEGER                                 :: i, j, k, rk, nv, unt, nRmx, nCmx, nHd
-  REAL,                       ALLOCATABLE :: val(:,:)
-
-  lerr = ANY(ll); IF(.NOT.lerr) RETURN                               !--- No outliers -> finished
-  rk = SIZE(n); nv = SIZE(a,2)
-  mes = 'outliers found';        IF(PRESENT(err_msg)) mes = err_msg  !--- Error message
-  vnm = [(ACHAR(k+96),k=1,nv)];  IF(PRESENT(nam ))    vnm = nam      !--- Variables names
-  sub = 'dispOutliers';          IF(PRESENT(subn))    sub = subn     !--- Calling SUBROUTINE name
-  nRmx= SIZE(a);          IF(PRESENT(nRowMax)) nRmx=MIN(nRmx,nRowMax)!-- Maximum number of lines to print
-  nCmx= 2048;             IF(PRESENT(nColMax)) nCmx=MIN(nCmx,nColMax)!-- Maximum number of characters each line
-  nHd = 1;                IF(PRESENT(nHead))   nHd = nHead           !--- Number of front columns to duplicate
-  unt = lunout;                  IF(PRESENT(unit))    unt = unit     !--- Unit to print messages
-  lerr= SIZE(vnm) /= nv;         IF(fmsg('SIZE(nam) /= SIZE(a,2)',                  sub, lerr, unt)) RETURN
-  lerr= SIZE(a,1) /= SIZE(ll);   IF(fmsg('"ll" and "a" sizes mismatch',             sub, lerr, unt)) RETURN
-  lerr= SIZE(a,1) /= PRODUCT(n); IF(fmsg('profile "n" does not match "a" and "ll"', sub, lerr, unt)) RETURN
-
-  SELECT CASE(rk)                                                   !--- Indices list
-    CASE(0); IF(ll(1)) THEN; WRITE(unt,'(a,", ",a," = ",2f12.9)')TRIM(vnm(1)),TRIM(vnm(2)),a(1,1),a(1,2); RETURN; END IF
-    CASE(1); ki = [  (i,i=1,n(1)) ]
-    CASE(2); ki = [ ((i,i=1,n(1)),j=1,n(2))];           kj = [ ((j,i=1,n(1)),j=1,n(2))]
-    CASE(3); ki = [(((i,i=1,n(1)),j=1,n(2)),k=1,n(3))]; kj = [(((j,i=1,n(1)),j=1,n(2)),k=1,n(3))]
-             kl = [(((k,i=1,n(1)),j=1,n(2)),k=1,n(3))]
-    CASE DEFAULT; WRITE(unt,*)'Sorry: routine "dispOutliers_2" is limited to rank 3'; RETURN
-  END SELECT
-
-  ttl = [(ACHAR(k), k = 105, 104+rk), vnm]                           !--- Titles list ('i', 'j', 'k'...'var1', 'var2', ...)
-  prf = REPEAT('i',rk)//REPEAT('r',nv)                               !--- Profile
-  ALLOCATE(val(COUNT(ll),nv)); DO k=1, nv; val(:,k) = PACK(a(:,k),ll); END DO
-  IF(rk == 1) lerr = dispTable(prf, ttl, i = cat(PACK(ki,ll)),                         r = val, &
-                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
-  IF(rk == 2) lerr = dispTable(prf, ttl, i = cat(PACK(ki,ll),PACK(kj,ll)),             r = val, &
-                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
-  IF(rk == 3) lerr = dispTable(prf, ttl, i = cat(PACK(ki,ll),PACK(kj,ll),PACK(kl,ll)), r = val, &
-                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
-  CALL msg("can't display outliers table", sub, lerr, unt)
-END FUNCTION dispOutliers_2
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== Reduce an algebrical expression (basic operations and parenthesis) to a single number (string format) ====================
-!==============================================================================================================================
-LOGICAL FUNCTION reduceExpr_1(str, val) RESULT(lerr)
-    CHARACTER(LEN=*),      INTENT(IN)  :: str
-  CHARACTER(LEN=maxlen), INTENT(OUT) :: val
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)              :: v
-  CHARACTER(LEN=1024)                :: s, vv
-  CHARACTER(LEN=1024), ALLOCATABLE :: vl(:)
-  INTEGER,             ALLOCATABLE :: ip(:)
-  INTEGER :: nl, nn, i, j, im, ix
-  LOGICAL :: ll
-  s = str
-
-  !--- Check wether the parenthesis are correctly formed
-  ll = strCount(s,'(',nl)
-  ll = strCount(s,')',nn)
-  lerr = nl /= nn
-  IF(fmsg('Mismatching number of opening and closing parenthesis: '//TRIM(s), ll=lerr)) RETURN
-  nl = 2*nl-1
-
-  !--- Build vectors ; vl: parenthesis-separated elements ; ip: parenthesis types (1: opening, 2: closing)
-  ALLOCATE(ip(nl-1),vl(nl))
-  j = 1; im = 1
-  DO i = 1, LEN_TRIM(str)
-    ix = INDEX('()', str(i:i))
-    IF(ix == 0) CYCLE
-    ip(j) = ix
-    vl(j) = str(im:i-1)
-    j = j + 1; im = i + 1
-  END DO
-  vl(j) = str(im:LEN_TRIM(str))
-
-  !--- Search for each opening/closing parenthesis pair
-  DO WHILE(nl > 1)
-    i = 1; DO WHILE(ip(i) /= 1 .OR. ip(i+1) /= 2); i = i + 1; END DO !IF(i > SIZE(ip)+1) EXIT;END DO
-    lerr = reduceExpr_basic(vl(i+1), v); IF(lerr) RETURN
-    v = TRIM(vl(i))//TRIM(v); IF(i+2<=nl) v=TRIM(v)//TRIM(vl(i+2))
-    vv = v//REPEAT(' ',768)
-    IF(i == 1) THEN;         ip =  ip(3:nl-1);                vl = [            vv, vl(4  :nl)]
-    ELSE IF(i == nl-1) THEN; ip =  ip(1:nl-2);                vl = [vl(1:nl-3), vv            ]
-    ELSE;                    ip = [ip(1: i-1), ip(i+2:nl-1)]; vl = [vl(1: i-1), vv, vl(i+3:nl)]; END IF
-    nl = SIZE(vl)
-  END DO
-  lerr = reduceExpr_basic(vl(1), val)
-END FUNCTION reduceExpr_1
-
-
-!==============================================================================================================================
-!=== Reduce a simple algebrical expression (basic operations, no parenthesis) to a single number (string format) ==============
-!==============================================================================================================================
-LOGICAL FUNCTION reduceExpr_basic(str, val) RESULT(lerr)
-    CHARACTER(LEN=*),      INTENT(IN)  :: str
-  CHARACTER(LEN=*),      INTENT(OUT) :: val
-  DOUBLE PRECISION,      ALLOCATABLE :: vl(:)
-  INTEGER,               ALLOCATABLE :: id(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: ky(:)
-  CHARACTER(LEN=1),      ALLOCATABLE :: op(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=1024) :: s
-  DOUBLE PRECISION :: v, vm, vp
-  INTEGER      :: i, ni, io
-  lerr = .FALSE.
-  IF(is_numeric(str)) THEN; val=TRIM(str); RETURN; END IF
-  op = ['^','/','*','+','-']                                                   !--- List of recognized operations
-  s = str
-  lerr = strParse_m(s, op, ky, lSc=.TRUE., id = id)                            !--- Parse the values
-  IF(lerr) RETURN                                                              !--- Problem with the parsing
-  vl = str2dble(ky)                                                            !--- Conversion to doubles
-  lerr = ANY(vl >= HUGE(1.d0))
-  CALL msg('Some values are non-numeric in: '//TRIM(s), ll=lerr)
-  IF(lerr) RETURN                                                              !--- Non-numerical values found
-  DO io = 1, SIZE(op)                                                          !--- Loop on known operators (order matters !)
-    DO i = SIZE(id), 1, -1                                                     !--- Loop on found operators
-      ni = SIZE(id)
-      IF(id(i) /= io) CYCLE                                                    !--- Current found operator is not op(io)
-      vm = vl(i); vp = vl(i+1)                                                 !--- Couple of values used for current operation
-      SELECT CASE(op(io))                                                      !--- Perform operation on the two values
-        CASE('^'); v = vm**vp
-        CASE('/'); v = vm/vp
-        CASE('*'); v = vm*vp
-        CASE('+'); v = vm+vp
-        CASE('-'); v = vm-vp
-      END SELECT
-      IF(i == ni) THEN; vl = [vl(1:ni-1), v]; ELSE; vl = [vl(1:i-1), v, vl(i+2:ni+1)]; END IF
-      IF(i == ni) THEN; id =  id(1:ni-1);     ELSE; id = [id(1:i-1),    id(i+1:ni  )]; END IF
-    END DO
-  END DO
-  val = dble2str(vl(1))
-
-END FUNCTION reduceExpr_basic
-!==============================================================================================================================
-
-!==============================================================================================================================
-FUNCTION reduceExpr_m(str, val) RESULT(lerr)
-    LOGICAL,               ALLOCATABLE              :: lerr(:)
-  CHARACTER(LEN=*),                   INTENT(IN)  :: str(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: i
-  ALLOCATE(lerr(SIZE(str)),val(SIZE(str)))
-  lerr(:) = [(reduceExpr_1(str(i), val(i)), i=1, SIZE(str))]
-END FUNCTION reduceExpr_m
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== Check whether a string is a number or not ================================================================================
-!==============================================================================================================================
-ELEMENTAL LOGICAL FUNCTION is_numeric(str) RESULT(out)
-    CHARACTER(LEN=*), INTENT(IN) :: str
-  REAL    :: x
-  INTEGER :: e
-  CHARACTER(LEN=12) :: fmt
-  IF(TRIM(str) == '') THEN; out = .FALSE.; RETURN; END IF
-  WRITE(fmt,'("(f",i0,".0)")') LEN_TRIM(str)
-  READ(str,fmt,IOSTAT=e) x
-  out = e==0 .AND. INDEX('Ee',str(LEN_TRIM(str):LEN_TRIM(str)))==0
-END FUNCTION is_numeric
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== Convert a string into a logical/integer integer or an integer/real into a string =========================================
-!==============================================================================================================================
-ELEMENTAL INTEGER FUNCTION str2bool(str) RESULT(out)  !--- Result: 0/1 for .FALSE./.TRUE., -1 if not a valid boolean
-    CHARACTER(LEN=*), INTENT(IN) :: str
-  INTEGER :: ierr
-  LOGICAL :: lout
-  READ(str,*,IOSTAT=ierr) lout
-  out = -HUGE(1)
-  IF(ierr /= 0) THEN
-    IF(ANY(['.FALSE.', 'false  ', 'no     ', 'f      ', 'n      '] == strLower(str))) out = 0
-    IF(ANY(['.TRUE. ', 'true   ', 'yes    ', 't      ', 'y      '] == strLower(str))) out = 1
-  ELSE
-    out = 0; IF(lout) out = 1
-  END IF
-END FUNCTION str2bool
-!==============================================================================================================================
-ELEMENTAL INTEGER FUNCTION str2int(str) RESULT(out)
-    CHARACTER(LEN=*), INTENT(IN) :: str
-  INTEGER :: ierr
-  READ(str,*,IOSTAT=ierr) out
-  IF(ierr/=0) out = -HUGE(1)
-END FUNCTION str2int
-!==============================================================================================================================
-ELEMENTAL REAL FUNCTION str2real(str) RESULT(out)
-    CHARACTER(LEN=*), INTENT(IN) :: str
-  INTEGER :: ierr
-  READ(str,*,IOSTAT=ierr) out
-  IF(ierr/=0) out = -HUGE(1.)
-END FUNCTION str2real
-!==============================================================================================================================
-ELEMENTAL DOUBLE PRECISION FUNCTION str2dble(str) RESULT(out)
-    CHARACTER(LEN=*), INTENT(IN) :: str
-  INTEGER :: ierr
-  READ(str,*,IOSTAT=ierr) out
-  IF(ierr/=0) out = -HUGE(1.d0)
-END FUNCTION str2dble
-!==============================================================================================================================
-ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION bool2str(b) RESULT(out)
-    LOGICAL, INTENT(IN) :: b
-  WRITE(out,*)b
-  out = ADJUSTL(out)
-END FUNCTION bool2str
-!==============================================================================================================================
-ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION int2str(i, nDigits) RESULT(out)
-    INTEGER,           INTENT(IN) :: i
-  INTEGER, OPTIONAL, INTENT(IN) :: nDigits
-!------------------------------------------------------------------------------------------------------------------------------
-  WRITE(out,*)i
-  out = ADJUSTL(out)
-  IF(.NOT.PRESENT(nDigits)) RETURN
-  IF(nDigits > LEN_TRIM(out)) out = REPEAT('0', nDigits - LEN_TRIM(out))//TRIM(out)
-END FUNCTION int2str
-!==============================================================================================================================
-ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION real2str(r,fmt) RESULT(out)
-    REAL,                       INTENT(IN) :: r
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
-!------------------------------------------------------------------------------------------------------------------------------
-  IF(     PRESENT(fmt)) WRITE(out,fmt)r
-  IF(.NOT.PRESENT(fmt)) WRITE(out, * )r
-  out = ADJUSTL(out)
-END FUNCTION real2str
-!==============================================================================================================================
-ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION dble2str(d,fmt) RESULT(out)
-    DOUBLE PRECISION,           INTENT(IN) :: d
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
-!------------------------------------------------------------------------------------------------------------------------------
-  IF(     PRESENT(fmt)) WRITE(out,fmt)d
-  IF(.NOT.PRESENT(fmt)) WRITE(out, * )d
-  out = ADJUSTL(out)
-END FUNCTION dble2str
-!==============================================================================================================================
-ELEMENTAL SUBROUTINE cleanZeros(s)
-    CHARACTER(LEN=*), INTENT(INOUT) :: s
-  INTEGER :: ls, ix, i
-  IF(is_numeric(s)) THEN
-    ls = LEN_TRIM(s)
-    ix = MAX(INDEX(s,'E'),INDEX(s,'e'),INDEX(s,'D'),INDEX(s,'d'))
-    IF(ix == 0) THEN
-      DO ix = ls,1,-1; IF(s(ix:ix) /= '0') EXIT; END DO; s=s(1:ix+1)
-    ELSE IF(INDEX(s,'.')/=0) THEN
-      i = ix-1; DO WHILE(s(i:i) == '0'); i = i-1; END DO; s=s(1:i)//s(ix:ls)
-    END IF
-  END IF
-END SUBROUTINE cleanZeros
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-FUNCTION addQuotes_1(s) RESULT(out)
-    CHARACTER(LEN=*), INTENT(IN)  :: s
-  CHARACTER(LEN=:), ALLOCATABLE :: out
-  IF(needQuotes(s)) THEN; out = "'"//TRIM(s)//"'"; ELSE; out = s; END IF
-END FUNCTION addQuotes_1
-!==============================================================================================================================
-FUNCTION addQuotes_m(s) RESULT(out)
-    CHARACTER(LEN=*), INTENT(IN)  :: s(:)
-  CHARACTER(LEN=:), ALLOCATABLE :: out(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: k, n
-  n = MAXVAL(LEN_TRIM(s), MASK=.TRUE.)
-  ALLOCATE(CHARACTER(LEN=n) :: out(SIZE(s)))
-  DO k=1,SIZE(s)
-    IF(needQuotes(s(k))) THEN; out(k) = "'"//TRIM(s(k))//"'"; ELSE; out(k) = s(k); END IF
-  END DO
-END FUNCTION addQuotes_m
-!==============================================================================================================================
-ELEMENTAL LOGICAL FUNCTION needQuotes(s) RESULT(out)
-    CHARACTER(LEN=*), INTENT(IN) :: s
-  CHARACTER(LEN=1) :: b, e
-!------------------------------------------------------------------------------------------------------------------------------
-  out = .TRUE.; IF(TRIM(s) == '') RETURN
-  b = s(1:1); e = s(MAX(1,LEN_TRIM(s)):MAX(1,LEN_TRIM(s)))
-  out = .NOT.is_numeric(s) .AND. (b /= "'" .OR. e /= "'") .AND. ( b /= '"' .OR. e /= '"')
-END FUNCTION needQuotes
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== DISPLAY "<message>: the following <items> are <reason>" FOLLOWED BY THE LIST OF <str> FOR WHICH <lerr>==T. ===============
-!==============================================================================================================================
-LOGICAL FUNCTION checkList(str, lerr, message, items, reason, nmax) RESULT(out)
-  ! Purpose: Messages in case a list contains wrong elements (indicated by lerr boolean vector).
-! Note:    Return value "out" is .TRUE. if there are errors (ie at least one element of "lerr" is TRUE).
-  CHARACTER(LEN=*),   INTENT(IN)  :: str(:)
-  LOGICAL,            INTENT(IN)  :: lerr(:)
-  CHARACTER(LEN=*),   INTENT(IN)  :: message, items, reason
-  INTEGER,  OPTIONAL, INTENT(IN)  :: nmax
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)
-  INTEGER :: i, nmx
-  nmx = 256; IF(PRESENT(nmax)) nmx=nmax
-  out = ANY(lerr); IF(.NOT.out) RETURN
-  CALL msg(TRIM(message)//': the following '//TRIM(items)//' are '//TRIM(reason)//':')
-  s = strStackm(PACK(str, MASK=lerr), ', ',nmx)
-  DO i=1,SIZE(s,DIM=1); CALL msg(s(i)); END DO
-END FUNCTION checkList
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== Remove comment in line "str", ie all the characters from the first "#" sign found in "str". ==============================
-!==============================================================================================================================
-SUBROUTINE removeComment(str)
-    CHARACTER(LEN=*), INTENT(INOUT) :: str
-  INTEGER :: ix
-  ix = INDEX(str,'# '); IF(ix /= 0) str = str(1:ix-1)//REPEAT(' ',LEN(str)-ix+1)
-END SUBROUTINE removeComment
-!==============================================================================================================================
-
-
-END MODULE strings_mod
Index: LMDZ6/branches/Amaury_dev/libf/misc/vampir.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/vampir.F90	(revision 5116)
+++ 	(revision )
@@ -1,86 +1,0 @@
-module Vampir
-
-  INTEGER,parameter :: VTcaldyn=1
-  INTEGER,parameter :: VTintegre=2
-  INTEGER,parameter :: VTadvection=3
-  INTEGER,parameter :: VTdissipation=4
-  INTEGER,parameter :: VThallo=5
-  INTEGER,parameter :: VTphysiq=6
-  INTEGER,parameter :: VTinca=7
-  
-  INTEGER,parameter :: nb_inst=7
-  INTEGER :: MPE_begin(nb_inst)
-  INTEGER :: MPE_end(nb_inst)
-  
-contains
-
-  SUBROUTINE InitVampir
-    IMPLICIT NONE
-
-#ifdef USE_VT
-    include 'VT.inc'
-    INTEGER :: ierr
-    
-    CALL VTSYMDEF(VTcaldyn,"caldyn","caldyn",ierr)
-    CALL VTSYMDEF(VTintegre,"integre","integre",ierr)
-    CALL VTSYMDEF(VTadvection,"advection","advection",ierr)
-    CALL VTSYMDEF(VTdissipation,"dissipation","dissipation",ierr)
-    CALL VTSYMDEF(VThallo,"hallo","hallo",ierr)
-    CALL VTSYMDEF(VTphysiq,"physiq","physiq",ierr)
-    CALL VTSYMDEF(VTinca,"inca","inca",ierr)
-#endif
-
-#ifdef USE_MPE
-    include 'mpe_logf.h' 
-    INTEGER :: ierr,i
-    
-    DO i=1,nb_inst
-      ierr = MPE_Log_get_state_eventIDs( MPE_begin(i), MPE_end(i) )
-    ENDDO
-    
-    ierr = MPE_Describe_state( MPE_begin(VTcaldyn), MPE_end(VTcaldyn),"caldyn", "yellow" )
-    ierr = MPE_Describe_state( MPE_begin(VTintegre), MPE_end(VTintegre),"integre", "blue" )
-    ierr = MPE_Describe_state( MPE_begin(VTadvection), MPE_end(VTadvection),"advection", "green" )
-    ierr = MPE_Describe_state( MPE_begin(VTdissipation), MPE_end(VTdissipation),"dissipation", "ivory" )
-    ierr = MPE_Describe_state( MPE_begin(VThallo), MPE_end(VThallo),"hallo", "orange" )
-    ierr = MPE_Describe_state( MPE_begin(VTphysiq), MPE_end(VTphysiq),"physiq", "purple" )
-    ierr = MPE_Describe_state( MPE_begin(VTinca), MPE_end(VTinca),"inca", "LightBlue" )
-#endif     
-  END SUBROUTINE  InitVampir
-
-  SUBROUTINE VTb(number)
-    IMPLICIT NONE
-    INTEGER :: number
-#ifdef USE_VT    
-    include 'VT.inc'
-    INTEGER :: ierr
-    
-    CALL VTBEGIN(number,ierr)
-#endif 
-#ifdef USE_MPE
-    include 'mpe_logf.h' 
-    INTEGER :: ierr,i
-    ierr = MPE_Log_event( MPE_begin(number), 0, '' )
-#endif
-
-  END SUBROUTINE  VTb
-
-  SUBROUTINE VTe(number)
-    IMPLICIT NONE
-    INTEGER :: Number
-#ifdef USE_VT    
-    include 'VT.inc'
-    INTEGER :: ierr
-   
-    CALL VTEND(number,ierr)
-#endif    
-
-#ifdef USE_MPE
-    include 'mpe_logf.h' 
-    INTEGER :: ierr,i
-    ierr = MPE_Log_event( MPE_end(number), 0, '' )
-#endif
-
-  END SUBROUTINE  VTe
-  
-end module Vampir
Index: LMDZ6/branches/Amaury_dev/libf/misc/write_field.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/write_field.F90	(revision 5116)
+++ 	(revision )
@@ -1,301 +1,0 @@
-module write_field
-  USE netcdf, ONLY: nf90_sync, nf90_put_var, nf90_enddef, nf90_def_dim, nf90_unlimited, &
-          nf90_clobber, nf90_create, nf90_def_var
-  USE lmdz_cppkeys_wrapper, ONLY: nf90_format
-  USE strings_mod, ONLY: int2str
-
-  IMPLICIT NONE; PRIVATE
-  PUBLIC WriteField
-
-  integer, parameter :: MaxWriteField = 100
-  integer, dimension(MaxWriteField), save :: FieldId
-  integer, dimension(MaxWriteField), save :: FieldVarId
-  integer, dimension(MaxWriteField), save :: FieldIndex
-  CHARACTER(LEN = 255), dimension(MaxWriteField) :: FieldName
-
-  integer, save :: NbField = 0
-
-  interface WriteField
-    module procedure WriteField3d, WriteField2d, WriteField1d
-  end interface WriteField
-contains
-
-  function GetFieldIndex(name)
-    IMPLICIT NONE
-    INTEGER :: GetFieldindex
-    CHARACTER(LEN = *) :: name
-
-    CHARACTER(LEN = 255) :: TrueName
-    INTEGER :: i
-
-    TrueName = TRIM(ADJUSTL(name))
-
-    GetFieldIndex = -1
-    do i = 1, NbField
-      if (TrueName==FieldName(i)) THEN
-        GetFieldIndex = i
-        exit
-      endif
-    enddo
-  END FUNCTION GetFieldIndex
-
-  subroutine WriteField3d(name, Field)
-    IMPLICIT NONE
-    CHARACTER(LEN = *) :: name
-    real, dimension(:, :, :) :: Field
-    integer, dimension(3) :: Dim
-
-    Dim = shape(Field)
-    CALL WriteField_gen(name, Field, Dim(1), Dim(2), Dim(3))
-
-  END SUBROUTINE WriteField3d
-
-  subroutine WriteField2d(name, Field)
-    IMPLICIT NONE
-    CHARACTER(LEN = *) :: name
-    real, dimension(:, :) :: Field
-    integer, dimension(2) :: Dim
-
-    Dim = shape(Field)
-    CALL WriteField_gen(name, Field, Dim(1), Dim(2), 1)
-
-  END SUBROUTINE WriteField2d
-
-  subroutine WriteField1d(name, Field)
-    IMPLICIT NONE
-    CHARACTER(LEN = *) :: name
-    real, dimension(:) :: Field
-    integer, dimension(1) :: Dim
-
-    Dim = shape(Field)
-    CALL WriteField_gen(name, Field, Dim(1), 1, 1)
-
-  END SUBROUTINE WriteField1d
-
-  subroutine WriteField_gen(name, Field, dimx, dimy, dimz)
-    IMPLICIT NONE
-    CHARACTER(LEN = *) :: name
-    INTEGER :: dimx, dimy, dimz
-    real, dimension(dimx, dimy, dimz) :: Field
-    integer, dimension(dimx * dimy * dimz) :: ndex
-    INTEGER :: status
-    INTEGER :: index
-    INTEGER :: start(4)
-    INTEGER :: count(4)
-
-    Index = GetFieldIndex(name)
-    if (Index==-1) THEN
-      CALL CreateNewField(name, dimx, dimy, dimz)
-      Index = GetFieldIndex(name)
-    else
-      FieldIndex(Index) = FieldIndex(Index) + 1.
-    endif
-
-    start(1) = 1
-    start(2) = 1
-    start(3) = 1
-    start(4) = FieldIndex(Index)
-
-    count(1) = dimx
-    count(2) = dimy
-    count(3) = dimz
-    count(4) = 1
-
-    status = nf90_put_var(FieldId(Index), FieldVarId(Index), Field, start, count)
-    status = nf90_sync(FieldId(Index))
-
-  END SUBROUTINE WriteField_gen
-
-  subroutine CreateNewField(name, dimx, dimy, dimz)
-    IMPLICIT NONE
-    CHARACTER(LEN = *) :: name
-    INTEGER :: dimx, dimy, dimz
-    INTEGER :: TabDim(4)
-    INTEGER :: status
-
-    NbField = NbField + 1
-    FieldName(NbField) = TRIM(ADJUSTL(name))
-    FieldIndex(NbField) = 1
-
-    status = nf90_create(TRIM(ADJUSTL(name)) // '.nc', nf90_clobber, FieldId(NbField))
-    status = nf90_def_dim(FieldId(NbField), 'X', dimx, TabDim(1))
-    status = nf90_def_dim(FieldId(NbField), 'Y', dimy, TabDim(2))
-    status = nf90_def_dim(FieldId(NbField), 'Z', dimz, TabDim(3))
-    status = nf90_def_dim(FieldId(NbField), 'iter', nf90_unlimited, TabDim(4))
-    status = nf90_def_var(FieldId(NbField), FieldName(NbField), nf90_format, TabDim, FieldVarId(NbField))
-    status = nf90_enddef(FieldId(NbField))
-
-  END SUBROUTINE CreateNewField
-
-  subroutine write_field1D(name, Field)
-    IMPLICIT NONE
-
-    integer, parameter :: MaxDim = 1
-    CHARACTER(LEN = *) :: name
-    real, dimension(:) :: Field
-    real, dimension(:), allocatable :: New_Field
-    CHARACTER(LEN = 20) :: str
-    integer, dimension(MaxDim) :: Dim
-    INTEGER :: i, nb
-    integer, parameter :: id = 10
-    integer, parameter :: NbCol = 4
-    INTEGER :: ColumnSize
-    INTEGER :: pos
-    CHARACTER(LEN = 255) :: form
-    CHARACTER(LEN = 255) :: MaxLen
-
-    open(unit = id, file = name // '.field', form = 'formatted', status = 'replace')
-    write (id, '("----- Field ' // name // '",//)')
-    Dim = shape(Field)
-    MaxLen = int2str(len(trim(int2str(Dim(1)))))
-    ColumnSize = 20 + 6 + 3 + len(trim(int2str(Dim(1))))
-    Nb = 0
-    Pos = 2
-    do i = 1, Dim(1)
-      nb = nb + 1
-
-      if (MOD(nb, NbCol)==0) THEN
-        form = '(t' // trim(int2str(pos)) // ',i' // trim(MaxLen) // '," ---> ",g22.16,/)'
-        Pos = 2
-      else
-        form = '(t' // trim(int2str(pos)) // ',i' // trim(MaxLen) // '," ---> ",g22.16," | ",)'
-        Pos = Pos + ColumnSize
-      endif
-      write (id, form, advance = 'no') i, Field(i)
-    enddo
-
-    close(id)
-
-  END SUBROUTINE write_field1D
-
-  subroutine write_field2D(name, Field)
-    IMPLICIT NONE
-
-    integer, parameter :: MaxDim = 2
-    CHARACTER(LEN = *) :: name
-    real, dimension(:, :) :: Field
-    real, dimension(:, :), allocatable :: New_Field
-    CHARACTER(LEN = 20) :: str
-    integer, dimension(MaxDim) :: Dim
-    INTEGER :: i, j, nb
-    integer, parameter :: id = 10
-    integer, parameter :: NbCol = 4
-    INTEGER :: ColumnSize
-    INTEGER :: pos, offset
-    CHARACTER(LEN = 255) :: form
-    CHARACTER(LEN = 255) :: spacing
-
-    open(unit = id, file = name // '.field', form = 'formatted', status = 'replace')
-    write (id, '("----- Field ' // name // '",//)')
-
-    Dim = shape(Field)
-    offset = len(trim(int2str(Dim(1)))) + len(trim(int2str(Dim(2)))) + 3
-    ColumnSize = 20 + 6 + 3 + offset
-
-    spacing = '(t2,"' // repeat('-', ColumnSize * NbCol) // '")'
-
-    do i = 1, Dim(2)
-      nb = 0
-      Pos = 2
-      do j = 1, Dim(1)
-        nb = nb + 1
-
-        if (MOD(nb, NbCol)==0) THEN
-          form = '(t' // trim(int2str(pos)) // &
-                  ',"(' // trim(int2str(j)) // ','          &
-                  // trim(int2str(i)) // ')",t'       &
-                  // trim(int2str(pos + offset))     &
-                  // '," ---> ",g22.16,/)'
-          Pos = 2
-        else
-          form = '(t' // trim(int2str(pos)) // &
-                  ',"(' // trim(int2str(j)) // ','          &
-                  // trim(int2str(i)) // ')",t'       &
-                  // trim(int2str(pos + offset))     &
-                  // '," ---> ",g22.16," | ")'
-          Pos = Pos + ColumnSize
-        endif
-        write (id, form, advance = 'no') Field(j, i)
-      enddo
-      if (MOD(nb, NbCol)==0) THEN
-        write (id, spacing)
-      else
-        write (id, '("")')
-        write (id, spacing)
-      endif
-    enddo
-
-  END SUBROUTINE write_field2D
-
-  subroutine write_field3D(name, Field)
-    IMPLICIT NONE
-
-    integer, parameter :: MaxDim = 3
-    CHARACTER(LEN = *) :: name
-    real, dimension(:, :, :) :: Field
-    real, dimension(:, :, :), allocatable :: New_Field
-    integer, dimension(MaxDim) :: Dim
-    INTEGER :: i, j, k, nb
-    integer, parameter :: id = 10
-    integer, parameter :: NbCol = 4
-    INTEGER :: ColumnSize
-    INTEGER :: pos, offset
-    CHARACTER(LEN = 255) :: form
-    CHARACTER(LEN = 255) :: spacing
-
-    open(unit = id, file = name // '.field', form = 'formatted', status = 'replace')
-    write (id, '("----- Field ' // name // '"//)')
-
-    Dim = shape(Field)
-    offset = len(trim(int2str(Dim(1)))) + len(trim(int2str(Dim(2)))) + len(trim(int2str(Dim(3)))) + 4
-    ColumnSize = 22 + 6 + 3 + offset
-
-    !    open(unit=id,file=name,form=formatted
-
-    spacing = '(t2,"' // repeat('-', ColumnSize * NbCol) // '")'
-
-    do i = 1, Dim(3)
-
-      do j = 1, Dim(2)
-        nb = 0
-        Pos = 2
-
-        do k = 1, Dim(1)
-          nb = nb + 1
-
-          if (MOD(nb, NbCol)==0) THEN
-            form = '(t' // trim(int2str(pos)) // &
-                    ',"(' // trim(int2str(k)) // ','          &
-                    // trim(int2str(j)) // ','          &
-                    // trim(int2str(i)) // ')",t'       &
-                    // trim(int2str(pos + offset))      &
-                    // '," ---> ",g22.16,/)'
-            Pos = 2
-          else
-            form = '(t' // trim(int2str(pos)) // &
-                    ',"(' // trim(int2str(k)) // ','          &
-                    // trim(int2str(j)) // ','          &
-                    // trim(int2str(i)) // ')",t'       &
-                    // trim(int2str(pos + offset))      &
-                    // '," ---> ",g22.16," | ")'
-            ! dépend de l'implémention, sur compaq, c'est necessaire
-            !            Pos=Pos+ColumnSize
-          endif
-          write (id, form, advance = 'no') Field(k, j, i)
-        enddo
-        if (MOD(nb, NbCol)==0) THEN
-          write (id, spacing)
-        else
-          write (id, '("")')
-          write (id, spacing)
-        endif
-      enddo
-      write (id, spacing)
-    enddo
-
-    close(id)
-
-  END SUBROUTINE write_field3D
-
-end module write_field
-  
Index: LMDZ6/branches/Amaury_dev/libf/misc/wxios.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/misc/wxios.F90	(revision 5116)
+++ 	(revision )
@@ -1,787 +1,0 @@
-! $Id$
-
-MODULE wxios
-    USE lmdz_xios
-
-    !Variables disponibles pendant toute l'execution du programme:
-    
-    INTEGER, SAVE :: g_comm
-    CHARACTER(len=100), SAVE :: g_ctx_name ="LMDZ"
-    TYPE(xios_context), SAVE :: g_ctx
-!$OMP THREADPRIVATE(g_comm,g_ctx_name,g_ctx)
-    LOGICAL, SAVE :: g_flag_xml = .FALSE.
-    CHARACTER(len=100) :: g_field_name = "nofield"
-!$OMP THREADPRIVATE(g_flag_xml,g_field_name)
-    REAL :: missing_val_omp
-    REAL :: missing_val
-!$OMP THREADPRIVATE(missing_val)
-
-#ifdef XIOS1
-#error "XIOS v1 no longer supported, use XIOS v2."
-#endif
-
-    CONTAINS
-    
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    !   36day => 36d etc     !!!!!!!!!!!!!!!!!!!!
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    
-    SUBROUTINE reformadate(odate, ndate)
-        CHARACTER(len=*), INTENT(IN) :: odate
-        TYPE(xios_duration) :: ndate
-        
-        INTEGER :: i = 0
-         !!!!!!!!!!!!!!!!!!
-         ! Pour XIOS:
-         !  year : y
-         !  month : mo
-         !  day : d
-         !  hour : h
-         !  minute : mi
-         !  second : s
-         !!!!!!!!!!!!!!!!!!
-
-        i = INDEX(odate, "day")
-        IF (i > 0) THEN
-            read(odate(1:i-1),*) ndate%day
-        END IF
-
-        i = INDEX(odate, "hr")
-        IF (i > 0) THEN
-            read(odate(1:i-1),*) ndate%hour
-        END IF
-
-        i = INDEX(odate, "mth")
-        IF (i > 0) THEN
-            read(odate(1:i-1),*) ndate%month
-        END IF
-        
-        !IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", odate, " => ", ndate
-    END SUBROUTINE reformadate
-    
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    !   ave(X) => average etc     !!!!!!!!!!!!!!!
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    
-    CHARACTER(len=7) FUNCTION reformaop(op)
-        CHARACTER(len=*), INTENT(IN) :: op
-        
-        INTEGER :: i = 0
-        reformaop = "average"
-        
-        IF (op=="inst(X)") THEN
-            reformaop = "instant"
-        END IF
-        
-        IF (op=="once") THEN
-            reformaop = "once"
-        END IF
-        
-        IF (op=="t_max(X)") THEN
-            reformaop = "maximum"
-        END IF
-        
-        IF (op=="t_min(X)") THEN
-            reformaop = "minimum"
-        END IF
-        
-        !IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", op, " => ", reformaop
-    END FUNCTION reformaop
-
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    ! Routine d'initialisation      !!!!!!!!!!!!!
-    !     A lancer juste après mpi_init !!!!!!!!!!!!!
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-    SUBROUTINE wxios_init(xios_ctx_name, locom, outcom, type_ocean)
-        USE lmdz_print_control, ONLY: prt_level, lunout
-        IMPLICIT NONE
-
-      CHARACTER(len=*), INTENT(IN) :: xios_ctx_name
-      INTEGER, INTENT(IN), OPTIONAL :: locom
-      INTEGER, INTENT(OUT), OPTIONAL :: outcom
-      CHARACTER(len=6), INTENT(IN), OPTIONAL :: type_ocean
-
-    
-        TYPE(xios_context) :: xios_ctx
-        INTEGER :: xios_comm
-
-        IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: Initialization"
-
-
-
-        IF (PRESENT(locom)) THEN
-          CALL xios_initialize(xios_ctx_name, local_comm = locom, return_comm = xios_comm )
-          IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," local_comm=",locom,", return_comm=",xios_comm
-        ELSE
-          CALL xios_initialize(xios_ctx_name, return_comm = xios_comm )
-          IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," return_comm=",xios_comm
-        END IF
-        
-        IF (PRESENT(outcom)) THEN
-          outcom = xios_comm
-          IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," outcom=",outcom
-        END IF
-        
-        !Enregistrement des variables globales:
-        g_comm = xios_comm
-        g_ctx_name = xios_ctx_name
-        
-!        ! Si couple alors init fait dans cpl_init
-!        IF (.not. PRESENT(type_ocean)) THEN
-!            CALL wxios_context_init()
-!        ENDIF
-         WRITE(*,*)'END of WXIOS_INIT', g_comm , g_ctx_name 
-
-    END SUBROUTINE wxios_init
-
-    SUBROUTINE wxios_context_init()
-        USE lmdz_print_control, ONLY: prt_level, lunout
-        USE lmdz_phys_mpi_data, ONLY: COMM_LMDZ_PHY
-        IMPLICIT NONE
-
-        TYPE(xios_context) :: xios_ctx
-
-!$OMP MASTER
-        !Initialisation du contexte:
-        !!CALL xios_context_initialize(g_ctx_name, g_comm)
-        CALL xios_context_initialize(g_ctx_name, COMM_LMDZ_PHY)
-        CALL xios_get_handle(g_ctx_name, xios_ctx)    !Récupération
-        CALL xios_set_current_context(xios_ctx)            !Activation
-        g_ctx = xios_ctx
-
-        CALL wxios_add_group_init
-        
-        IF (prt_level >= 10) THEN
-          WRITE(lunout,*) "wxios_context_init: Current context is ",trim(g_ctx_name)
-          WRITE(lunout,*) "     now CALL xios_solve_inheritance()"
-        ENDIF
-        !Une première analyse des héritages:
-        CALL xios_solve_inheritance()
-!$OMP END MASTER
-    END SUBROUTINE wxios_context_init
-
-
-    
-    SUBROUTINE wxios_add_group_init
-
-      ! routine create by Anne Cozic (2023)
-      ! This routine will create field associated to group defined without description of fields in field.xml file
-      ! This routine need to be CALL before "xios_sole_inheritance" after an !$OMP MASTER directive
-      
-      USE infotrac_phy, ONLY: nbtr, nqtot, nqo, type_trac, tracers, niso, ntiso
-      USE strings_mod,  ONLY: maxlen
-
-      IMPLICIT NONE
-
-      TYPE(xios_fieldgroup) :: group_handle, philev_hdl
-      TYPE(xios_field) :: child
-      INTEGER :: k, iq
-      CHARACTER(len=12) :: nvar, name_phi    
-      CHARACTER(LEN=maxlen) :: varname, dn
-      CHARACTER(LEN=maxlen) :: unt
-    
-
-      ! group create for StratAER variables 
-      !On ajoute les variables 3D traceurs par l interface fortran 
-      CALL xios_get_handle("fields_strataer_trac_3D", group_handle)
-      ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
-      DO iq = 1, nqtot
-         IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
-         dn = 'd'//TRIM(tracers(iq)%name)//'_'
-
-         unt = "kg kg-1"
-         varname=trim(tracers(iq)%name)
-         CALL xios_add_child(group_handle, child, varname)
-         CALL xios_set_attr(child, name=varname, unit=unt)
-         
-         unt = "kg kg-1 s-1"
-         varname=TRIM(dn)//'vdf'
-         CALL xios_add_child(group_handle, child, varname)
-         CALL xios_set_attr(child, name=varname, unit=unt)
-         varname=TRIM(dn)//'the'
-         CALL xios_add_child(group_handle, child, varname)
-         CALL xios_set_attr(child, name=varname, unit=unt)
-         varname=TRIM(dn)//'con'
-         CALL xios_add_child(group_handle, child, varname)
-         CALL xios_set_attr(child, name=varname, unit=unt)
-         varname=TRIM(dn)//'lessi_impa'
-         CALL xios_add_child(group_handle, child, varname)
-         CALL xios_set_attr(child, name=varname, unit=unt)
-         varname=TRIM(dn)//'lessi_nucl'
-         CALL xios_add_child(group_handle, child, varname)
-         CALL xios_set_attr(child, name=varname, unit=unt)
-         varname=TRIM(dn)//'insc'
-         CALL xios_add_child(group_handle, child, varname)
-         CALL xios_set_attr(child, name=varname, unit=unt)
-         varname=TRIM(dn)//'bcscav'
-         CALL xios_add_child(group_handle, child, varname)
-         CALL xios_set_attr(child, name=varname, unit=unt)
-         varname=TRIM(dn)//'evapls'
-         CALL xios_add_child(group_handle, child, varname)
-         CALL xios_set_attr(child, name=varname, unit=unt)
-         varname=TRIM(dn)//'ls'
-         CALL xios_add_child(group_handle, child, varname)
-         CALL xios_set_attr(child, name=varname, unit=unt)
-         varname=TRIM(dn)//'trsp'
-         CALL xios_add_child(group_handle, child, varname)
-         CALL xios_set_attr(child, name=varname, unit=unt)
-         varname=TRIM(dn)//'sscav'
-         CALL xios_add_child(group_handle, child, varname)
-         CALL xios_set_attr(child, name=varname, unit=unt)
-         varname=TRIM(dn)//'sat'
-         CALL xios_add_child(group_handle, child, varname)
-         CALL xios_set_attr(child, name=varname, unit=unt)
-         varname=TRIM(dn)//'uscav'
-         CALL xios_add_child(group_handle, child, varname)
-         CALL xios_set_attr(child, name=varname, unit=unt)
-      END DO
-      !On ajoute les variables 2D traceurs par l interface fortran 
-      CALL xios_get_handle("fields_strataer_trac_2D", group_handle)
-      ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
-      DO iq = 1, nqtot
-         IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
-         
-         unt = "kg m-2"
-         varname='cum'//trim(tracers(iq)%name)
-         
-         CALL xios_add_child(group_handle, child, varname)
-         CALL xios_set_attr(child, name=varname, unit=unt)
-         
-         unt = "kg m-2 s-1"
-         varname='cumd'//trim(tracers(iq)%name)//'_dry'
-         CALL xios_add_child(group_handle, child, varname)
-         CALL xios_set_attr(child, name=varname, unit=unt)
-      ENDDO
-      
-
-      ! group create for offline mass flow variables
-      CALL xios_get_handle("philev_grp", philev_hdl)
-
-      DO k=1,79
-         IF (k<10) THEN
-            WRITE(nvar,'(i1)') k
-         ELSE IF (k<100) THEN
-            WRITE(nvar,'(i2)') k
-         ELSE
-            WRITE(nvar,'(i3)') k
-         END IF
-         name_phi= "phi_lev"//TRIM(nvar)
-         CALL xios_add_child(philev_hdl, child, "phi_lev"//TRIM(nvar)) 
-         CALL xios_set_attr(child, name=trim(name_phi))
-      ENDDO
-
-
-    END SUBROUTINE wxios_add_group_init
-
-    SUBROUTINE wxios_set_context()
-        IMPLICIT NONE
-        TYPE(xios_context) :: xios_ctx
-
-       !$OMP MASTER
-        CALL xios_get_handle(g_ctx_name, xios_ctx)    !Récupération
-        CALL xios_set_current_context(xios_ctx)            !Activation
-       !$OMP END MASTER
-
-    END SUBROUTINE wxios_set_context
-
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    ! Routine de paramétrisation !!!!!!!!!!!!!!!!!!
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-    SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure, ini_an, ini_mois, ini_jour, ini_heure)
-        USE lmdz_print_control, ONLY: prt_level, lunout
-        USE lmdz_abort_physic, ONLY: abort_physic
-        IMPLICIT NONE
-
-     !Paramètres:
-     CHARACTER(len=*), INTENT(IN) :: calendrier
-     INTEGER, INTENT(IN) :: annee, mois, jour, ini_an, ini_mois, ini_jour
-     REAL, INTENT(IN) :: pasdetemps, heure, ini_heure
-     
-     !Variables:
-     CHARACTER(len=80) :: abort_message
-     CHARACTER(len=19) :: date
-     INTEGER :: njour = 1
-     
-     !Variables pour xios:
-     TYPE(xios_duration) :: mdtime
-     !REAL(kind = 8) :: year=0, month=0, day=0, hour=0, minute=0, second=0
-     
-        mdtime%second=pasdetemps
-
-        !Réglage du calendrier:
-        SELECT CASE (calendrier)
-            CASE('earth_360d')
-                CALL xios_define_calendar("D360")
-                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 360 jours/an'
-            CASE('earth_365d')
-                CALL xios_define_calendar("NoLeap")
-                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 365 jours/an'
-            CASE('gregorian')
-                CALL xios_define_calendar("Gregorian")
-                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier gregorien'
-            CASE DEFAULT
-                abort_message = 'wxios_set_cal: Mauvais choix de calendrier'
-                CALL abort_physic('Gcm:Xios',abort_message,1)
-        END SELECT
-        
-        !Formatage de la date d'origine:
-        WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") annee, mois, jour, int(heure) 
-        
-        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Time origin: ", date
-        CALL xios_set_time_origin(xios_date(annee,mois,jour,int(heure),0,0))
-
-        !Formatage de la date de debut:
-
-        WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") ini_an, ini_mois, ini_jour, int(ini_heure)
-        
-        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Start date: ", date
-        
-        CALL xios_set_start_date(xios_date(ini_an,ini_mois,ini_jour,int(ini_heure),0,0))
-        
-        !Et enfin,le pas de temps:
-        CALL xios_set_timestep(mdtime)
-        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: ts=",mdtime
-    END SUBROUTINE wxios_set_cal
-
-    SUBROUTINE wxios_set_timestep(ts)
-        REAL, INTENT(IN) :: ts
-        TYPE(xios_duration) :: mdtime     
-
-        mdtime%timestep = ts
-
-        CALL xios_set_timestep(mdtime)
-    END SUBROUTINE wxios_set_timestep
-
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    ! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!!
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    SUBROUTINE wxios_domain_param(dom_id)
-       USE dimphy, ONLY: klon
-       USE lmdz_phys_transfert_para, ONLY: gather, bcast
-       USE lmdz_phys_para, ONLY: jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
-                                     mpi_size, mpi_rank, klon_mpi, &
-                                     is_sequential, is_south_pole_dyn
-       USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, klon_glo
-       USE lmdz_print_control, ONLY: prt_level, lunout
-       USE lmdz_geometry
-
-       IMPLICIT NONE
-        CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
-
-        REAL   :: rlat_glo(klon_glo)
-        REAL   :: rlon_glo(klon_glo)
-        REAL   :: io_lat(nbp_lat)
-        REAL   :: io_lon(nbp_lon)
-        LOGICAL :: mask(nbp_lon,jj_nb) !Masque pour les problèmes de recouvrement MPI
-        TYPE(xios_domain) :: dom
-        INTEGER :: i
-        LOGICAL :: boool
-        
-
-
-        CALL gather(latitude_deg,rlat_glo) 
-        CALL bcast(rlat_glo)
-        CALL gather(longitude_deg,rlon_glo)
-        CALL bcast(rlon_glo)
-    
-  !$OMP MASTER  
-        io_lat(1)=rlat_glo(1)
-        io_lat(nbp_lat)=rlat_glo(klon_glo)
-        IF ((nbp_lon*nbp_lat) > 1) THEN
-          DO i=2,nbp_lat-1
-            io_lat(i)=rlat_glo(2+(i-2)*nbp_lon)
-          ENDDO
-        ENDIF
-
-        IF (klon_glo == 1) THEN
-          io_lon(1)=rlon_glo(1)
-        ELSE 
-          io_lon(1:nbp_lon)=rlon_glo(2:nbp_lon+1)
-        ENDIF
-
-        
-        !On récupère le handle:
-        CALL xios_get_handle(dom_id, dom)
-        
-        !On parametrise le domaine:
-        CALL xios_set_attr(dom, ni_glo=nbp_lon, ibegin=0, ni=nbp_lon, type="rectilinear")
-        CALL xios_set_attr(dom, nj_glo=nbp_lat, jbegin=jj_begin-1, nj=jj_nb, data_dim=2)
-        CALL xios_set_attr(dom, lonvalue_1d=io_lon(1:nbp_lon), latvalue_1d=io_lat(jj_begin:jj_end))
-        CALL xios_set_domain_attr("dom_out", domain_ref=dom_id)
-
-        !On definit un axe de latitudes pour les moyennes zonales
-        IF (xios_is_valid_axis("axis_lat")) THEN
-           CALL xios_set_axis_attr( "axis_lat", n_glo=nbp_lat, n=jj_nb, begin=jj_begin-1, value=io_lat(jj_begin:jj_end))
-        ENDIF
-        IF (xios_is_valid_axis("axis_lat_greordered")) THEN
-           CALL xios_set_axis_attr( "axis_lat_greordered", n_glo=nbp_lat, n=jj_nb, begin=jj_begin-1, &
-                                    value=io_lat(jj_begin:jj_end)*(-1.))
-        ENDIF
-
-        IF (.NOT.is_sequential) THEN
-            mask(:,:)=.TRUE.
-            if (ii_begin>1) mask(1:ii_begin-1,1) = .FALSE.
-            if (ii_end<nbp_lon) mask(ii_end+1:nbp_lon,jj_nb) = .FALSE.
-            ! special case for south pole
-            if ((ii_end==1).and.(is_south_pole_dyn)) mask(1:nbp_lon,jj_nb)=.TRUE.
-            IF (prt_level >= 10) THEN
-              WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1)
-              WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,jj_nb)=",mask(:,jj_nb)
-            ENDIF
-            CALL xios_set_attr(dom, mask_2d=mask)
-        END IF
-
-         CALL xios_is_defined_attr(dom,ni_glo=boool)
-        !Vérification:
-        IF (xios_is_valid_domain(dom_id)) THEN
-            IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Domain initialized: ", trim(dom_id), boool
-        ELSE
-            IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id)
-        END IF
-!$OMP END MASTER
-        
-    END SUBROUTINE wxios_domain_param
-    
-
-    SUBROUTINE wxios_domain_param_unstructured(dom_id)
-        USE lmdz_geometry, ONLY: longitude, latitude, boundslon, boundslat,ind_cell_glo
-        USE lmdz_grid_phy, ONLY: nvertex, klon_glo
-        USE lmdz_phys_para
-        USE nrtype, ONLY: PI
-        USE lmdz_ioipsl_getin_p, ONLY: getin_p
-        IMPLICIT NONE
-        CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
-        REAL :: lon_mpi(klon_mpi)
-        REAL :: lat_mpi(klon_mpi)
-        REAL :: boundslon_mpi(klon_mpi,nvertex)
-        REAL :: boundslat_mpi(klon_mpi,nvertex)
-        INTEGER :: ind_cell_glo_mpi(klon_mpi)
-        TYPE(xios_domain) :: dom
-        
-        LOGICAL :: remap_output
-
-        CALL gather_omp(longitude*180/PI,lon_mpi)
-        CALL gather_omp(latitude*180/PI,lat_mpi)
-        CALL gather_omp(boundslon*180/PI,boundslon_mpi)
-        CALL gather_omp(boundslat*180/PI,boundslat_mpi)
-        CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi)
-        
-        remap_output=.TRUE.
-        CALL getin_p("remap_output",remap_output)
-
-!$OMP MASTER
-        CALL xios_get_handle(dom_id, dom)
-        
-        !On parametrise le domaine:
-        CALL xios_set_attr(dom, ni_glo=klon_glo, ibegin=ij_begin-1, ni=ij_nb, type="unstructured")
-        CALL xios_set_attr(dom, nvertex=nvertex, lonvalue_1d=lon_mpi, latvalue_1d=lat_mpi, &
-                           bounds_lon_1d=TRANSPOSE(boundslon_mpi), bounds_lat_1d=TRANSPOSE(boundslat_mpi) )
-        CALL xios_set_attr(dom, i_index=ind_cell_glo_mpi(:)-1)
-        IF (remap_output) THEN
-          CALL xios_set_domain_attr("dom_out", domain_ref="dom_regular")
-          CALL xios_set_fieldgroup_attr("remap_expr", expr="@this_ref")
-          CALL xios_set_fieldgroup_attr("remap_1800s", freq_op=xios_duration_convert_from_string("1800s"))
-          CALL xios_set_fieldgroup_attr("remap_1h",    freq_op=xios_duration_convert_from_string("1h"))
-          CALL xios_set_fieldgroup_attr("remap_3h",    freq_op=xios_duration_convert_from_string("3h"))
-          CALL xios_set_fieldgroup_attr("remap_6h",    freq_op=xios_duration_convert_from_string("6h"))
-          CALL xios_set_fieldgroup_attr("remap_1d",    freq_op=xios_duration_convert_from_string("1d"))
-          CALL xios_set_fieldgroup_attr("remap_1mo",   freq_op=xios_duration_convert_from_string("1mo"))
-        ENDIF
-!$OMP END MASTER
-
-    END SUBROUTINE wxios_domain_param_unstructured
-
-
-
-
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    ! Pour déclarer un axe vertical !!!!!!!!!!!!!!!
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    SUBROUTINE wxios_add_vaxis(axis_id, axis_size, axis_value,     &
-                               positif, bnds)
-        USE lmdz_print_control, ONLY: prt_level, lunout
-        IMPLICIT NONE
-
-        CHARACTER (len=*), INTENT(IN) :: axis_id
-        INTEGER, INTENT(IN) :: axis_size
-        REAL, DIMENSION(axis_size), INTENT(IN) :: axis_value
-        CHARACTER (len=*), INTENT(IN), OPTIONAL :: positif
-        REAL, DIMENSION(axis_size, 2), INTENT(IN), OPTIONAL :: bnds
-        
-!        TYPE(xios_axisgroup) :: axgroup
-!        TYPE(xios_axis) :: ax
-!        CHARACTER(len=50) :: axis_id 
-        
-!        IF (len_trim(axisgroup_id).gt.len(axis_id)) THEN
-!          WRITE(lunout,*) "wxios_add_vaxis: error, size of axis_id too small!!"
-!          WRITE(lunout,*) "     increase it to at least ",len_trim(axisgroup_id)
-!          CALL abort_gcm("wxios_add_vaxis","len(axis_id) too small",1)
-!        ENDIF
-!        axis_id=trim(axisgroup_id)
-        
-        !On récupère le groupe d'axes qui va bien:
-        !CALL xios_get_axisgroup_handle(axisgroup_id, axgroup)
-        
-        !On ajoute l'axe correspondant à ce fichier:
-        !CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id)))
-        
-        !Et on le parametrise:
-        !CALL xios_set_axis_attr_hdl(ax, size=axis_size, value=axis_value)
-        
-        ! Ehouarn: New way to declare axis, without axis_group:
-        if (PRESENT(positif) .AND. PRESENT(bnds)) THEN
-          CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
-                                  positive=positif, bounds=bnds)
-        else if (PRESENT(positif)) THEN
-          CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
-                                  positive=positif)
-        else if (PRESENT(bnds)) THEN
-          CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
-                                  bounds=bnds)
-        else
-          CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value)
-        endif
-
-        !Vérification:
-        IF (xios_is_valid_axis(TRIM(ADJUSTL(axis_id)))) THEN
-            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id))
-        ELSE
-            WRITE(lunout,*) "wxios_add_vaxis: Invalid axis: ", TRIM(ADJUSTL(axis_id))
-        END IF
-
-    END SUBROUTINE wxios_add_vaxis
-    
-    
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    ! Pour déclarer un fichier  !!!!!!!!!!!!!!!!!!!
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    SUBROUTINE wxios_add_file(fname, ffreq, flvl)
-        USE lmdz_print_control, ONLY: prt_level, lunout
-        IMPLICIT NONE
-
-        CHARACTER(len=*), INTENT(IN) :: fname
-        CHARACTER(len=*), INTENT(IN) :: ffreq
-        INTEGER, INTENT(IN) :: flvl
-        
-        TYPE(xios_file) :: x_file
-        TYPE(xios_filegroup) :: x_fg
-        TYPE(xios_duration) :: nffreq
-        
-        !On regarde si le fichier n'est pas défini par XML:
-        IF (.NOT.xios_is_valid_file(fname)) THEN
-            !On créé le noeud:
-            CALL xios_get_handle("defile", x_fg)
-            CALL xios_add_child(x_fg, x_file, fname)
-        
-            !On reformate la fréquence:
-            CALL reformadate(ffreq, nffreq)
-        
-            !On configure:
-            CALL xios_set_attr(x_file, name="X"//fname,&
-                output_freq=nffreq, output_level=flvl, enabled=.TRUE.)
-       
-            IF (xios_is_valid_file("X"//fname)) THEN
-                IF (prt_level >= 10) THEN
-                  WRITE(lunout,*) "wxios_add_file: New file: ", "X"//fname
-                  WRITE(lunout,*) "wxios_add_file: output_freq=",nffreq,"; output_lvl=",flvl
-                ENDIF
-            ELSE
-                WRITE(lunout,*) "wxios_add_file: Error, invalid file: ", "X"//trim(fname)
-                WRITE(lunout,*) "wxios_add_file: output_freq=",nffreq,"; output_lvl=",flvl
-            END IF
-        ELSE
-            IF (prt_level >= 10) THEN
-              WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
-            ENDIF
-            ! Ehouarn: add an enable=.TRUE. on top of xml definitions... why???
-            CALL xios_set_file_attr(fname, enabled=.TRUE.)
-        END IF
-    END SUBROUTINE wxios_add_file
-    
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    ! Pour créer un champ      !!!!!!!!!!!!!!!!!!!!
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
-        USE netcdf, ONLY: nf90_fill_real
-
-        IMPLICIT NONE
-        INCLUDE 'iniprint.h'
-        
-        CHARACTER(len=*), INTENT(IN) :: fieldname
-        TYPE(xios_fieldgroup), INTENT(IN) :: fieldgroup
-        CHARACTER(len=*), INTENT(IN) :: fieldlongname
-        CHARACTER(len=*), INTENT(IN) :: fieldunit
-        
-        TYPE(xios_field) :: field
-        CHARACTER(len=10) :: newunit
-        REAL(KIND=8) :: def
-        
-        !La valeur par défaut des champs non définis:
-        def = nf90_fill_real
-        
-        IF (fieldunit == " ") THEN
-            newunit = "-"
-        ELSE
-            newunit = fieldunit
-        ENDIF
-        
-        !On ajoute le champ:
-        CALL xios_add_child(fieldgroup, field, fieldname)
-        !IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit
-        
-        !On rentre ses paramètres:
-        CALL xios_set_attr(field, standard_name=fieldlongname, unit=newunit, default_value=def)
-        IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: Field ",trim(fieldname), "cree:"
-        IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: long_name=",trim(fieldlongname),"; unit=",trim(newunit),";  default_value=",nf90_fill_real
-
-    END SUBROUTINE wxios_add_field
-    
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    ! Pour déclarer un champ      !!!!!!!!!!!!!!!!!
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op, nam_axvert)
-        USE lmdz_print_control, ONLY: prt_level, lunout
-        IMPLICIT NONE
-
-        CHARACTER(len=*), INTENT(IN) :: fieldname
-        INTEGER, INTENT(IN)          :: fdim, fid
-        CHARACTER(len=*), INTENT(IN) :: fname
-        CHARACTER(len=*), INTENT(IN) :: fieldlongname
-        CHARACTER(len=*), INTENT(IN) :: fieldunit
-        INTEGER, INTENT(IN)          :: field_level
-        CHARACTER(len=*), INTENT(IN) :: op
-        
-        CHARACTER(len=20) :: axis_id ! Ehouarn: dangerous...
-        CHARACTER(len=20), INTENT(IN), OPTIONAL :: nam_axvert
-        CHARACTER(len=100) :: operation
-        TYPE(xios_file) :: f
-        TYPE(xios_field) :: field
-        TYPE(xios_fieldgroup) :: fieldgroup
-        TYPE(xios_duration) :: freq_op
-
-        LOGICAL :: bool=.FALSE.
-        INTEGER :: lvl =0
-        
-        
-        ! Ajout Abd pour NMC:
-        IF (fid<=6) THEN
-          axis_id="presnivs"
-        ELSE
-          axis_id="plev"
-        ENDIF
- 
-        IF (PRESENT(nam_axvert)) THEN
-           axis_id=nam_axvert
-           PRINT*,'nam_axvert=',axis_id
-        ENDIF
-        
-        !on prépare le nom de l'opération:
-        operation = reformaop(op)
-        
-        
-        !On selectionne le bon groupe de champs:
-        IF (fdim==2) THEN
-          CALL xios_get_handle("fields_2D", fieldgroup)
-        ELSE
-          CALL xios_get_handle("fields_3D", fieldgroup)
-        ENDIF
-        
-        !On regarde si le champ à déjà été créé ou non:
-        IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN
-            !Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire
-            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
-            g_flag_xml = .TRUE.
-            g_field_name = fieldname
-
-        ELSE IF (.NOT. g_field_name == fieldname) THEN
-            !Si premier pssage et champ indéfini, alors on le créé
-
-            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
-            
-            !On le créé:
-            CALL wxios_add_field(fieldname,  fieldgroup, fieldlongname, fieldunit)
-            IF (xios_is_valid_field(fieldname)) THEN
-                IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "created"
-            ENDIF
-
-            g_flag_xml = .FALSE.
-            g_field_name = fieldname
-
-        END IF
-
-        IF (.NOT. g_flag_xml) THEN
-            !Champ existe déjà, mais pas XML, alors on l'ajoute
-            !On ajoute le champ:
-            CALL xios_get_handle(fname, f)
-            CALL xios_add_child(f, field)
-            
-            
-            !L'operation, sa frequence:
-            freq_op%timestep=1
-            CALL xios_set_attr(field, field_ref=fieldname, operation=TRIM(ADJUSTL(operation)), freq_op=freq_op, prec=4)
-
-            
-            !On rentre ses paramètres:
-            CALL xios_set_attr(field, level=field_level, enabled=.TRUE.)
-            
-            IF (fdim==2) THEN
-                !Si c'est un champ 2D:
-                IF (prt_level >= 10) THEN
-                  WRITE(lunout,*) "wxios_add_field_to_file: 2D Field ", trim(fieldname), " in ", "X"//trim(fname) ," configured with:"
-                  WRITE(lunout,*) "wxios_add_field_to_file: op=", TRIM(ADJUSTL(operation))
-                  WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
-                ENDIF
-            ELSE
-                !Si 3D :
-                !On ajoute l'axe vertical qui va bien:
-                CALL xios_set_attr(field, axis_ref=TRIM(ADJUSTL(axis_id)))
-                
-                IF (prt_level >= 10) THEN
-                  WRITE(lunout,*) "wxios_add_field_to_file: 3D Field",trim(fieldname), " in ", "X"//trim(fname), "configured with:"
-                  WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
-                  WRITE(lunout,*) "wxios_add_field_to_file: axis=",TRIM(ADJUSTL(axis_id))
-                ENDIF
-            END IF
-        
-        ELSE
-            !Sinon on se contente de l'activer:
-            CALL xios_set_field_attr(fieldname, enabled=.TRUE.)
-            !NB: This will override an enable=.FALSE. set by a user in the xml file;
-            !   then the only way to not output the field is by changing its
-            !   output level
-        ENDIF       
-        
-    END SUBROUTINE wxios_add_field_to_file
-    
-!    SUBROUTINE wxios_update_calendar(ito)
-!        INTEGER, INTENT(IN) :: ito
-!        CALL xios_update_calendar(ito)
-!    END SUBROUTINE wxios_update_calendar
-
-!    SUBROUTINE wxios_write_2D(fieldname, fdata)
-!        CHARACTER(len=*), INTENT(IN) :: fieldname
-!        REAL, DIMENSION(:,:), INTENT(IN) :: fdata
-
-!        CALL xios_send_field(fieldname, fdata)
-!    END SUBROUTINE wxios_write_2D
-    
-!    SUBROUTINE wxios_write_3D(fieldname, fdata)
-!        CHARACTER(len=*), INTENT(IN) :: fieldname
-!        REAL, DIMENSION(:,:,:), INTENT(IN) :: fdata
-
-!        CALL xios_send_field(fieldname, fdata)
-!    END SUBROUTINE wxios_write_3D
-    
-    SUBROUTINE wxios_closedef()
-        CALL xios_close_context_definition()
-!        CALL xios_update_calendar(0)
-    END SUBROUTINE wxios_closedef
-    
-    SUBROUTINE wxios_close()
-        CALL xios_context_finalize()
-         CALL xios_finalize()
-     END SUBROUTINE wxios_close
-END MODULE wxios
-
Index: LMDZ6/branches/Amaury_dev/libf/obsolete/regr1_step_av_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/obsolete/regr1_step_av_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/obsolete/regr1_step_av_m.F90	(revision 5117)
@@ -1,2 +1,4 @@
+! Amaury (07/24): ce module n'est utilisé nulle part à part dans obsolete/, où il en existe déjà une autre version....
+
 ! $Id$
 module regr1_step_av_m
Index: LMDZ6/branches/Amaury_dev/libf/obsolete/sort.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/obsolete/sort.f90	(revision 5117)
+++ LMDZ6/branches/Amaury_dev/libf/obsolete/sort.f90	(revision 5117)
@@ -0,0 +1,35 @@
+! $Header$
+
+!
+!
+SUBROUTINE sort(n, d)
+  !
+  ! P.Le Van
+  !
+  !...  cette routine met le tableau d  dans l'ordre croissant  ....
+  !c   ( pour avoir l'ordre decroissant,il suffit de remplacer l'instruc
+  !  tion  situee + bas  IF(d(j).LE.p)  THEN     par
+  !                       IF(d(j).GE.p)  THEN
+  !
+
+  INTEGER :: n
+  REAL :: d(n), p
+  INTEGER :: i, j, k
+
+  DO i = 1, n - 1
+    k = i
+    p = d(i)
+    DO j = i + 1, n
+      IF(d(j)<=p) THEN
+        k = j
+        p = d(j)
+      ENDIF
+    ENDDO
+
+    IF(k/=i) THEN
+      d(k) = d(i)
+      d(i) = p
+    ENDIF
+  ENDDO
+
+END SUBROUTINE sort
Index: LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_abort_physic.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_abort_physic.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_abort_physic.F90	(revision 5117)
@@ -18,7 +18,7 @@
     !         ierr    = severity of situation ( = 0 normal )
 
-    CHARACTER(LEN = *), intent(in) :: modname
-    integer ierr, ierror_mpi
-    CHARACTER(LEN = *), intent(in) :: message
+    CHARACTER(LEN = *), INTENT(IN) :: modname
+    INTEGER ierr, ierror_mpi
+    CHARACTER(LEN = *), INTENT(IN) :: message
 
     WRITE(lunout, *) 'in abort_physic'
@@ -26,5 +26,5 @@
     CALL histclo
     CALL restclo
-    if (mpi_rank == 0) THEN
+    IF (mpi_rank == 0) THEN
       CALL getin_dump
     endif
@@ -33,7 +33,7 @@
     WRITE(lunout, *) 'Stopping in ', modname
     WRITE(lunout, *) 'Reason = ', message
-    if (ierr == 0) THEN
+    IF (ierr == 0) THEN
       WRITE(lunout, *) 'Everything is cool'
-      if (using_mpi) THEN
+      IF (using_mpi) THEN
         !$OMP CRITICAL (MPI_ABORT_PHYSIC)
         CALL MPI_ABORT(COMM_LMDZ_PHY, 0, ierror_mpi)
@@ -44,5 +44,5 @@
     else
       WRITE(lunout, *) 'Houston, we have a problem, ierr = ', ierr
-      if (using_mpi) THEN
+      IF (using_mpi) THEN
         !$OMP CRITICAL (MPI_ABORT_PHYSIC)
         CALL MPI_ABORT(COMM_LMDZ_PHY, 1, ierror_mpi)
Index: LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_geometry.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_geometry.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_geometry.F90	(revision 5117)
@@ -38,5 +38,5 @@
           cell_area_, ind_cell_glo_, dx_, dy_)
     USE lmdz_grid_phy, ONLY: nvertex
-    USE nrtype, ONLY: PI
+    USE lmdz_physical_constants, ONLY: PI
     IMPLICIT NONE
     INTEGER, INTENT(IN) :: klon ! number of columns for this MPI/OpenMP domain
Index: LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_init_print_control.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_init_print_control.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_init_print_control.F90	(revision 5117)
@@ -35,5 +35,5 @@
 
     IF (is_omp_root) THEN
-      IF (lunout /= 5 .and. lunout /= 6) THEN
+      IF (lunout /= 5 .AND. lunout /= 6) THEN
         INQUIRE(FILE = 'lmdz.out_0000', OPENED = opened, NUMBER = number)
         IF (opened) THEN
Index: LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_phys_mpi_data.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_phys_mpi_data.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_phys_mpi_data.F90	(revision 5117)
@@ -66,5 +66,5 @@
     is_using_mpi = using_mpi
     
-    if ((nbp_lon==1).and.(nbp_lat==1)) then ! running 1D column model
+    IF ((nbp_lon==1).AND.(nbp_lat==1)) then ! running 1D column model
        klon_glo=1
     else
Index: LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_phys_mpi_transfert.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_phys_mpi_transfert.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_phys_mpi_transfert.f90	(revision 5117)
@@ -1375,5 +1375,5 @@
     INTEGER :: ierr
 
-    IF (.not.is_using_mpi) RETURN
+    IF (.NOT.is_using_mpi) RETURN
     
     CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_master,COMM_LMDZ_PHY,ierr)
@@ -1393,5 +1393,5 @@
     INTEGER :: ierr
 
-    IF (.not.is_using_mpi) RETURN
+    IF (.NOT.is_using_mpi) RETURN
 
     CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_master,COMM_LMDZ_PHY,ierr)
@@ -1412,5 +1412,5 @@
     INTEGER :: ierr
 
-    IF (.not.is_using_mpi) RETURN
+    IF (.NOT.is_using_mpi) RETURN
 
     CALL MPI_BCAST(Var,nb,MPI_REAL_LMDZ,mpi_master,COMM_LMDZ_PHY,ierr)
@@ -1431,5 +1431,5 @@
     INTEGER :: ierr
 
-    IF (.not.is_using_mpi) RETURN
+    IF (.NOT.is_using_mpi) RETURN
 
     CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_master,COMM_LMDZ_PHY,ierr)
@@ -1456,5 +1456,5 @@
 
 
-    IF (.not.is_using_mpi) THEN
+    IF (.NOT.is_using_mpi) THEN
       VarOut(:,:)=VarIn(:,:)
       RETURN
@@ -1496,5 +1496,5 @@
     INTEGER :: ierr
 
-    IF (.not.is_using_mpi) THEN
+    IF (.NOT.is_using_mpi) THEN
       VarOut(:,:)=VarIn(:,:)
       RETURN
@@ -1537,5 +1537,5 @@
     INTEGER :: ierr
 
-    IF (.not.is_using_mpi) THEN
+    IF (.NOT.is_using_mpi) THEN
       VarOut(:,:)=VarIn(:,:)
       RETURN
@@ -1579,5 +1579,5 @@
     INTEGER :: ierr
 
-    IF (.not.is_using_mpi) THEN
+    IF (.NOT.is_using_mpi) THEN
       VarOut(:,:)=VarIn(:,:)
       RETURN
@@ -1638,5 +1638,5 @@
     ENDIF
     
-    IF (.not.is_using_mpi) THEN
+    IF (.NOT.is_using_mpi) THEN
       VarOut(:,:)=VarIn(:,:)
       RETURN
@@ -1675,5 +1675,5 @@
     INTEGER :: ierr
     
-    IF (.not.is_using_mpi) THEN
+    IF (.NOT.is_using_mpi) THEN
       VarOut(:,:)=VarIn(:,:)
       RETURN
@@ -1720,5 +1720,5 @@
     INTEGER :: ierr
    
-    IF (.not.is_using_mpi) THEN
+    IF (.NOT.is_using_mpi) THEN
       VarOut(:)=VarIn(:)
       RETURN
@@ -1741,5 +1741,5 @@
     INTEGER :: ierr
  
-    IF (.not.is_using_mpi) THEN
+    IF (.NOT.is_using_mpi) THEN
       VarOut(:)=VarIn(:)
       RETURN
@@ -1763,5 +1763,5 @@
     INTEGER :: ierr
    
-    IF (.not.is_using_mpi) THEN
+    IF (.NOT.is_using_mpi) THEN
       VarOut(:)=VarIn(:)
       RETURN
@@ -1785,5 +1785,5 @@
     INTEGER :: ierr
  
-    IF (.not.is_using_mpi) THEN
+    IF (.NOT.is_using_mpi) THEN
       VarOut(:)=VarIn(:)
       RETURN
Index: LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_phys_omp_data.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_phys_omp_data.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_phys_omp_data.F90	(revision 5117)
@@ -28,5 +28,5 @@
     USE lmdz_abort_physic, ONLY: abort_physic
     IMPLICIT NONE
-    INTEGER, INTENT(in) :: klon_mpi
+    INTEGER, INTENT(IN) :: klon_mpi
 
     INTEGER :: i
@@ -88,10 +88,10 @@
 !$OMP BARRIER
 
-   if ((is_north_pole_dyn) .AND. (omp_rank == 0 )) THEN
+   IF ((is_north_pole_dyn) .AND. (omp_rank == 0 )) THEN
       is_north_pole_phy = .TRUE.
     else
       is_north_pole_phy = .FALSE.
     endif
-    if ((is_south_pole_dyn) .AND. (omp_rank == omp_size-1)) THEN
+    IF ((is_south_pole_dyn) .AND. (omp_rank == omp_size-1)) THEN
       is_south_pole_phy = .TRUE.
     else
Index: LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_phys_para.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_phys_para.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_phys_para.f90	(revision 5117)
@@ -19,9 +19,9 @@
   SUBROUTINE Init_phys_lmdz_para(nbp,nbp_lon,nbp_lat,nbp_lev,grid_type, nvertex,communicator)
   IMPLICIT NONE
-    INTEGER,INTENT(in) :: nbp
-    INTEGER,INTENT(in) :: nbp_lon
-    INTEGER,INTENT(in) :: nbp_lat
-    INTEGER,INTENT(in) :: nbp_lev
-    INTEGER,INTENT(in) :: communicator
+    INTEGER,INTENT(IN) :: nbp
+    INTEGER,INTENT(IN) :: nbp_lon
+    INTEGER,INTENT(IN) :: nbp_lat
+    INTEGER,INTENT(IN) :: nbp_lev
+    INTEGER,INTENT(IN) :: communicator
     INTEGER,INTENT(IN) :: grid_type 
     INTEGER,INTENT(IN) :: nvertex 
Index: LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_physics_distribution.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_physics_distribution.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_physics_distribution.F90	(revision 5117)
@@ -55,9 +55,9 @@
   !  IMPLICIT NONE
 
-  !    INTEGER,INTENT(in) :: iim
-  !    INTEGER,INTENT(in) :: jjp1
-  !    INTEGER,INTENT(in) :: llm
-  !    INTEGER,INTENT(in) :: nb_proc
-  !    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
+  !    INTEGER,INTENT(IN) :: iim
+  !    INTEGER,INTENT(IN) :: jjp1
+  !    INTEGER,INTENT(IN) :: llm
+  !    INTEGER,INTENT(IN) :: nb_proc
+  !    INTEGER,INTENT(IN) :: distrib(0:nb_proc-1)
 
 
Index: LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_write_field_phy.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_write_field_phy.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_write_field_phy.f90	(revision 5117)
@@ -12,5 +12,5 @@
     USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, klon_glo, &
             Grid1Dto2D_glo
-    USE Write_Field, ONLY: WriteField
+    USE lmdz_write_field, ONLY: WriteField
 
     IMPLICIT NONE
@@ -20,6 +20,6 @@
     REAL, INTENT(IN) :: Field(klon_omp, ll)
 
-    real, dimension(klon_glo, ll) :: New_Field
-    real, dimension(nbp_lon, nbp_lat, ll) :: Field_2d
+    REAL, DIMENSION(klon_glo, ll) :: New_Field
+    REAL, DIMENSION(nbp_lon, nbp_lat, ll) :: Field_2d
 
     CALL Gather(Field, New_Field)
Index: LMDZ6/branches/Amaury_dev/libf/phydev/gr_fi_ecrit.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phydev/gr_fi_ecrit.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phydev/gr_fi_ecrit.F90	(revision 5117)
@@ -10,5 +10,5 @@
   INTEGER,INTENT(IN) :: nfield,nlon,iim,jjmp1
   REAL,INTENT(IN) :: fi(nlon,nfield)
-  REAL,INTENT(out) :: ecrit(iim*jjmp1,nfield)
+  REAL,INTENT(OUT) :: ecrit(iim*jjmp1,nfield)
 
   INTEGER :: i, n, ig, jjm
Index: LMDZ6/branches/Amaury_dev/libf/phydev/infotrac_phy.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phydev/infotrac_phy.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phydev/infotrac_phy.F90	(revision 5117)
@@ -4,5 +4,5 @@
 MODULE infotrac_phy
 
-   USE strings_mod, ONLY: maxlen
+   USE lmdz_strings, ONLY: maxlen
 !   PUBLIC :: tracers, type_trac                            !--- Full tracers database, tracers type keyword
 !   PUBLIC :: nqtot,   nbtr,   nqo,   nqCO2,   nqtottr      !--- Main dimensions
Index: LMDZ6/branches/Amaury_dev/libf/phydev/iophy.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phydev/iophy.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phydev/iophy.F90	(revision 5117)
@@ -3,11 +3,11 @@
 module iophy
 
-  ! abd  REAL,PRIVATE,allocatable,dimension(:),save :: io_lat
-  ! abd  REAL,PRIVATE,allocatable,dimension(:),save :: io_lon
-  REAL, allocatable, dimension(:), save :: io_lat
-  REAL, allocatable, dimension(:), save :: io_lon
+  ! abd  REAL,PRIVATE,ALLOCATABLE,DIMENSION(:),save :: io_lat
+  ! abd  REAL,PRIVATE,ALLOCATABLE,DIMENSION(:),save :: io_lon
+  REAL, ALLOCATABLE, DIMENSION(:), save :: io_lat
+  REAL, ALLOCATABLE, DIMENSION(:), save :: io_lon
   INTEGER, save :: phys_domain_id
   INTEGER, save :: npstn
-  INTEGER, allocatable, dimension(:), save :: nptabij
+  INTEGER, ALLOCATABLE, DIMENSION(:), save :: nptabij
 
 
@@ -34,11 +34,11 @@
     USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
     USE ioipsl, ONLY: flio_dom_set
-    use wxios, ONLY: wxios_domain_param, using_xios
-    IMPLICIT NONE
-    real, dimension(klon), intent(in) :: rlon
-    real, dimension(klon), intent(in) :: rlat
-
-    REAL, dimension(klon_glo) :: rlat_glo
-    REAL, dimension(klon_glo) :: rlon_glo
+    USE lmdz_wxios, ONLY: wxios_domain_param, using_xios
+    IMPLICIT NONE
+    REAL, DIMENSION(klon), INTENT(IN) :: rlon
+    REAL, DIMENSION(klon), INTENT(IN) :: rlat
+
+    REAL, DIMENSION(klon_glo) :: rlat_glo
+    REAL, DIMENSION(klon_glo) :: rlon_glo
 
     INTEGER, DIMENSION(2) :: ddid
@@ -93,5 +93,5 @@
     dpl = (/ nbp_lon, jj_end /)
     dhs = (/ ii_begin - 1, 0 /)
-    if (mpi_rank==mpi_size - 1) THEN
+    IF (mpi_rank==mpi_size - 1) THEN
       dhe = (/0, 0/)
     else
@@ -117,5 +117,5 @@
       END IF
 
-      if (prt_level>=10) THEN
+      IF (prt_level>=10) THEN
         WRITE(lunout, *) "init_iophy_new: mpirank=", mpi_rank, " iibegin=", ii_begin, " ii_end=", ii_end, " jjbegin=", jj_begin, " jj_nb=", jj_nb, " jj_end=", jj_end
         WRITE(lunout, *) "init_iophy_new: mpirank=", mpi_rank, " nbp_lon=", nbp_lon, " nbp_lat=", nbp_lat
@@ -140,18 +140,18 @@
   SUBROUTINE histbeg_phy(name, itau0, zjulian, dtime, nhori, nid_day)
     USE lmdz_phys_para, ONLY: is_sequential, jj_begin, jj_end, jj_nb
-    use ioipsl, ONLY: histbeg
+    USE ioipsl, ONLY: histbeg
     USE lmdz_print_control, ONLY: prt_level, lunout
     USE lmdz_grid_phy, ONLY: nbp_lon
     IMPLICIT NONE
 
-    character*(*), intent(IN) :: name
-    integer, intent(in) :: itau0
-    real, intent(in) :: zjulian
-    real, intent(in) :: dtime
-    integer, intent(out) :: nhori
-    integer, intent(out) :: nid_day
-
-    !$OMP MASTER
-    if (is_sequential) THEN
+    character*(*), INTENT(IN) :: name
+    INTEGER, INTENT(IN) :: itau0
+    REAL, INTENT(IN) :: zjulian
+    REAL, INTENT(IN) :: dtime
+    INTEGER, INTENT(OUT) :: nhori
+    INTEGER, INTENT(OUT) :: nid_day
+
+    !$OMP MASTER
+    IF (is_sequential) THEN
       CALL histbeg(name, nbp_lon, io_lon, jj_nb, io_lat(jj_begin:jj_end), &
               1, nbp_lon, 1, jj_nb, itau0, zjulian, dtime, nhori, nid_day)
@@ -170,15 +170,15 @@
   SUBROUTINE histbeg_phyxios(name, ffreq, lev)
     USE lmdz_phys_para, ONLY: is_using_mpi, is_mpi_root
-    use wxios, ONLY: wxios_add_file
+    USE lmdz_wxios, ONLY: wxios_add_file
     IMPLICIT NONE
 
     character*(*), INTENT(IN) :: name
-    !    integer, INTENT(IN) :: itau0
+    !    INTEGER, INTENT(IN) :: itau0
     !    REAL,INTENT(IN) :: zjulian
     !    REAL,INTENT(IN) :: dtime
     character(LEN = *), INTENT(IN) :: ffreq
     INTEGER, INTENT(IN) :: lev
-    !    integer,intent(out) :: nhori
-    !    integer,intent(out) :: nid_day
+    !    INTEGER,INTENT(OUT) :: nhori
+    !    INTEGER,INTENT(OUT) :: nid_day
 
     !$OMP MASTER
@@ -207,15 +207,15 @@
     IMPLICIT NONE
 
-    integer, intent(in) :: nid
-    logical, intent(in) :: lpoint
-    character*(*), intent(IN) :: name
-    integer, intent(in) :: itau
-    real, dimension(:), intent(in) :: field
-    REAL, dimension(klon_mpi) :: buffer_omp
-    INTEGER, allocatable, dimension(:) :: index2d
+    INTEGER, INTENT(IN) :: nid
+    logical, INTENT(IN) :: lpoint
+    character*(*), INTENT(IN) :: name
+    INTEGER, INTENT(IN) :: itau
+    REAL, DIMENSION(:), INTENT(IN) :: field
+    REAL, DIMENSION(klon_mpi) :: buffer_omp
+    INTEGER, ALLOCATABLE, DIMENSION(:) :: index2d
     REAL :: Field2d(nbp_lon, jj_nb)
 
     INTEGER :: ip
-    real, allocatable, dimension(:) :: fieldok
+    REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
 
     IF (size(field)/=klon) CALL abort_physic('iophy::histwrite2d', 'Field first dimension not equal to klon', 1)
@@ -267,14 +267,14 @@
     IMPLICIT NONE
 
-    integer, intent(in) :: nid
-    logical, intent(in) :: lpoint
-    character*(*), intent(IN) :: name
-    integer, intent(in) :: itau
-    real, dimension(:, :), intent(in) :: field  ! --> field(klon,:)
-    REAL, dimension(klon_mpi, size(field, 2)) :: buffer_omp
+    INTEGER, INTENT(IN) :: nid
+    logical, INTENT(IN) :: lpoint
+    character*(*), INTENT(IN) :: name
+    INTEGER, INTENT(IN) :: itau
+    REAL, DIMENSION(:, :), INTENT(IN) :: field  ! --> field(klon,:)
+    REAL, DIMENSION(klon_mpi, size(field, 2)) :: buffer_omp
     REAL :: Field3d(nbp_lon, jj_nb, size(field, 2))
     INTEGER :: ip, n, nlev
-    INTEGER, ALLOCATABLE, dimension(:) :: index3d
-    real, allocatable, dimension(:, :) :: fieldok
+    INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
+    REAL, ALLOCATABLE, DIMENSION(:, :) :: fieldok
 
     IF (size(field, 1)/=klon) CALL abort_physic('iophy::histwrite3d', 'Field first dimension not equal to klon', 1)
Index: LMDZ6/branches/Amaury_dev/libf/phydev/phyetat0.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phydev/phyetat0.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phydev/phyetat0.F90	(revision 5117)
@@ -14,5 +14,5 @@
   IMPLICIT NONE
 
-  CHARACTER(len=*),INTENT(in) :: fichnom ! input file name
+  CHARACTER(len=*),INTENT(IN) :: fichnom ! input file name
 
   REAL :: lon_startphy(klon), lat_startphy(klon)
Index: LMDZ6/branches/Amaury_dev/libf/phydev/phys_state_var_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phydev/phys_state_var_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phydev/phys_state_var_mod.F90	(revision 5117)
@@ -19,9 +19,9 @@
 !  use dimphy, ONLY: klon
 
-!  if (.not.allocated(rlat)) THEN
+!  if (.NOT.allocated(rlat)) THEN
 !    ALLOCATE(rlat(klon),rlon(klon))
 !  else
 !    WRITE(*,*) "phys_state_var_init: warning, rlat already allocated"
-!  endif
+!  ENDIF
   
   END SUBROUTINE phys_state_var_init
Index: LMDZ6/branches/Amaury_dev/libf/phydev/physiq_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phydev/physiq_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phydev/physiq_mod.F90	(revision 5117)
@@ -24,5 +24,5 @@
 
       USE lmdz_xios, ONLY: xios_update_calendar, using_xios
-      USE wxios, ONLY: wxios_add_vaxis, wxios_set_cal, wxios_closedef
+      USE lmdz_wxios, ONLY: wxios_add_vaxis, wxios_set_cal, wxios_closedef
       USE iophy, ONLY: histwrite_phy
 
@@ -31,26 +31,26 @@
 ! Routine argument:
 
-      integer,intent(in) :: nlon ! number of atmospheric colums
-      integer,intent(in) :: nlev ! number of vertical levels (should be =klev)
-      logical,intent(in) :: debut ! signals first CALL to physics
-      logical,intent(in) :: lafin ! signals last CALL to physics
-      real,intent(in) :: pdtphys ! physics time step (s)
-      real,intent(in) :: paprs(klon,klev+1) ! interlayer pressure (Pa)
-      real,intent(in) :: pplay(klon,klev) ! mid-layer pressure (Pa)
-      real,intent(in) :: pphi(klon,klev) ! geopotential at mid-layer
-      real,intent(in) :: pphis(klon) ! surface geopotential
-      real,intent(in) :: presnivs(klev) ! pseudo-pressure (Pa) of mid-layers
-      real,intent(in) :: u(klon,klev) ! eastward zonal wind (m/s)
-      real,intent(in) :: v(klon,klev) ! northward meridional wind (m/s)
-      real,intent(in) :: t(klon,klev) ! temperature (K)
-      real,intent(in) :: qx(klon,klev,nqtot) ! tracers (.../kg_air)
-      real,intent(in) :: flxmass_w(klon,klev) ! vertical mass flux
-      real,intent(out) :: d_u(klon,klev) ! physics tendency on u (m/s/s)
-      real,intent(out) :: d_v(klon,klev) ! physics tendency on v (m/s/s)
-      real,intent(out) :: d_t(klon,klev) ! physics tendency on t (K/s)
-      real,intent(out) :: d_qx(klon,klev,nqtot) ! physics tendency on tracers
-      real,intent(out) :: d_ps(klon) ! physics tendency on surface pressure
+      INTEGER,INTENT(IN) :: nlon ! number of atmospheric colums
+      INTEGER,INTENT(IN) :: nlev ! number of vertical levels (should be =klev)
+      logical,INTENT(IN) :: debut ! signals first CALL to physics
+      logical,INTENT(IN) :: lafin ! signals last CALL to physics
+      REAL,INTENT(IN) :: pdtphys ! physics time step (s)
+      REAL,INTENT(IN) :: paprs(klon,klev+1) ! interlayer pressure (Pa)
+      REAL,INTENT(IN) :: pplay(klon,klev) ! mid-layer pressure (Pa)
+      REAL,INTENT(IN) :: pphi(klon,klev) ! geopotential at mid-layer
+      REAL,INTENT(IN) :: pphis(klon) ! surface geopotential
+      REAL,INTENT(IN) :: presnivs(klev) ! pseudo-pressure (Pa) of mid-layers
+      REAL,INTENT(IN) :: u(klon,klev) ! eastward zonal wind (m/s)
+      REAL,INTENT(IN) :: v(klon,klev) ! northward meridional wind (m/s)
+      REAL,INTENT(IN) :: t(klon,klev) ! temperature (K)
+      REAL,INTENT(IN) :: qx(klon,klev,nqtot) ! tracers (.../kg_air)
+      REAL,INTENT(IN) :: flxmass_w(klon,klev) ! vertical mass flux
+      REAL,INTENT(OUT) :: d_u(klon,klev) ! physics tendency on u (m/s/s)
+      REAL,INTENT(OUT) :: d_v(klon,klev) ! physics tendency on v (m/s/s)
+      REAL,INTENT(OUT) :: d_t(klon,klev) ! physics tendency on t (K/s)
+      REAL,INTENT(OUT) :: d_qx(klon,klev,nqtot) ! physics tendency on tracers
+      REAL,INTENT(OUT) :: d_ps(klon) ! physics tendency on surface pressure
 
-integer,save :: itau=0 ! counter to count number of calls to physics
+INTEGER,save :: itau=0 ! counter to count number of calls to physics
 !$OMP THREADPRIVATE(itau)
 REAL :: temp_newton(klon,klev)
@@ -64,10 +64,10 @@
 REAL :: dtime
 INTEGER :: nhori ! horizontal coordinate ID
-integer,save :: nid_hist ! output file ID
+INTEGER,save :: nid_hist ! output file ID
 !$OMP THREADPRIVATE(nid_hist)
 INTEGER :: zvertid ! vertical coordinate ID
-integer,save :: iwrite_phys ! output every iwrite_phys physics step
+INTEGER,save :: iwrite_phys ! output every iwrite_phys physics step
 !$OMP THREADPRIVATE(iwrite_phys)
-integer,save :: iwrite_phys_omp ! intermediate variable to read iwrite_phys
+INTEGER,save :: iwrite_phys_omp ! intermediate variable to read iwrite_phys
                                 ! (must be shared by all threads)
 REAL :: t_ops ! frequency of the IOIPSL operations (eg average over...)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/coarsemission.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/coarsemission.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/coarsemission.f90	(revision 5117)
@@ -49,6 +49,6 @@
   ! REAL prfl(klon,klev),   psfl(klon,klev)     !--large-scale
   LOGICAL :: debutphy, lafinphy
-  REAL, intent(in) :: xlat(klon)    ! latitudes pour chaque point
-  REAL, intent(in) :: xlon(klon)    ! longitudes pour chaque point
+  REAL, INTENT(IN) :: xlat(klon)    ! latitudes pour chaque point
+  REAL, INTENT(IN) :: xlon(klon)    ! longitudes pour chaque point
   REAL, DIMENSION(klon), INTENT(IN) :: zu10m
   REAL, DIMENSION(klon), INTENT(IN) :: zv10m
@@ -195,5 +195,5 @@
 
     DO i = 1, klon
-      if (maskd(i)>0) THEN
+      IF (maskd(i)>0) THEN
         IF(id_fine>0)    source_tr(i, id_fine) = &
                 scale_param_dustacc(iregion_dust(i)) * &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfc.f90	(revision 5117)
@@ -35,9 +35,9 @@
 
   ierr = nf90_open ("limitcarbon.nc", nf90_nowrite, nid1)
-  if (ierr/=nf90_noerr) THEN
+  IF (ierr/=nf90_noerr) THEN
     WRITE(6, *)' Pb d''ouverture du fichier limitbc.nc'
     WRITE(6, *)' ierr = ', ierr
     CALL exit(1)
-  endif
+  ENDIF
 
   ! Tranche a lire:
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfc_new.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfc_new.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfc_new.f90	(revision 5117)
@@ -58,5 +58,5 @@
 
     ierr = nf90_open ("carbon_emissions.nc", nf90_nowrite, nid1)
-    if (ierr/=nf90_noerr) THEN
+    IF (ierr/=nf90_noerr) THEN
       WRITE(6, *)' Pb d''ouverture du fichier limitbc.nc'
       WRITE(6, *)' ierr = ', ierr
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfs.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfs.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfs.f90	(revision 5117)
@@ -36,9 +36,9 @@
 
   ierr = nf90_open ("limitsoufre.nc", nf90_nowrite, nid)
-  if (ierr/=nf90_noerr) THEN
+  IF (ierr/=nf90_noerr) THEN
     WRITE(6, *)' Pb d''ouverture du fichier limitsoufre.nc'
     WRITE(6, *)' ierr = ', ierr
     CALL exit(1)
-  endif
+  ENDIF
 
   ! Tranche a lire:
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfs_new.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfs_new.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfs_new.f90	(revision 5117)
@@ -61,5 +61,5 @@
 
     ierr = nf90_open ("sulphur_emissions_antro.nc", nf90_nowrite, nid)
-    if (ierr/=nf90_noerr) THEN
+    IF (ierr/=nf90_noerr) THEN
       WRITE(6, *)' Pb d''ouverture du fichier sulphur_emissions_antro'
       WRITE(6, *)' ierr = ', ierr
@@ -130,5 +130,5 @@
     !=======================================================================
     ierr = nf90_open ("sulphur_emissions_nat.nc", nf90_nowrite, nid)
-    if (ierr/=nf90_noerr) THEN
+    IF (ierr/=nf90_noerr) THEN
       WRITE(6, *)' Pb d''ouverture du fichier sulphur_emissions_nat'
       WRITE(6, *)' ierr = ', ierr
@@ -185,5 +185,5 @@
     print *, ' Jour = ', jour
     ierr = nf90_open ("sulphur_emissions_volc.nc", nf90_nowrite, nid)
-    if (ierr/=nf90_noerr) THEN
+    IF (ierr/=nf90_noerr) THEN
       WRITE(6, *)' Pb d''ouverture du fichier sulphur_emissions_volc'
       WRITE(6, *)' ierr = ', ierr
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/dustemission_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/dustemission_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/dustemission_mod.F90	(revision 5117)
@@ -17,16 +17,16 @@
   INTEGER, PARAMETER    :: nats=14 !number of mineral types (14 here for sand,
                                    ! silt, clay etc.)
-  integer, parameter :: nclass=200000
+  INTEGER, parameter :: nclass=200000
 
 
   real   , parameter :: dmin=0.0001
   real   , parameter :: dmax=0.2
-  integer, parameter :: nspe=nmode*3+1
+  INTEGER, parameter :: nspe=nmode*3+1
   real   ,parameter     :: vkarm=0.41
 !JE20150202 : updating scheme to chimere13b <<<
 ! original values
-!  integer, parameter :: div1=3.
-!  integer, parameter :: div2=3.
-!  integer, parameter :: div3=3.
+!  INTEGER, parameter :: div1=3.
+!  INTEGER, parameter :: div2=3.
+!  INTEGER, parameter :: div3=3.
 !  real   , parameter :: e1=3.61/div1
 !  real   , parameter :: e2=3.52/div2
@@ -41,10 +41,10 @@
 ! Div=3 from S. Alfaro (Sow et al ACPD 2011)
 !JE 20150206
-!  integer, parameter :: div1=3.
-!  integer, parameter :: div2=3.
-!  integer, parameter :: div3=3.
-  integer, parameter :: div1=6.
-  integer, parameter :: div2=6.
-  integer, parameter :: div3=6.
+!  INTEGER, parameter :: div1=3.
+!  INTEGER, parameter :: div2=3.
+!  INTEGER, parameter :: div3=3.
+  INTEGER, parameter :: div1=6.
+  INTEGER, parameter :: div2=6.
+  INTEGER, parameter :: div3=6.
   real   , parameter :: e1=3.61/div1
   real   , parameter :: e2=3.52/div2
@@ -59,8 +59,8 @@
 !  real   , parameter :: cd=1.0*roa/gravity
 !JE20150202>>>>
-  real,parameter     :: beta=16300.
-  real, parameter, dimension(3) :: diam=(/1.5,6.7,14.2/)
+  REAL,parameter     :: beta=16300.
+  REAL, parameter, DIMENSION(3) :: diam=(/1.5,6.7,14.2/)
   INTEGER, PARAMETER     :: ndistb=3
-  real, parameter, dimension(3) :: sig=(/1.7,1.6,1.5/)
+  REAL, parameter, DIMENSION(3) :: sig=(/1.7,1.6,1.5/)
 
 !   INTEGER, PARAMETER     :: nbinsHR=3000 !original
@@ -259,5 +259,5 @@
       maskdustloc(k)=0
       do i=1,ntyp
-         if (masklisa(k,i)>0) THEN
+         IF (masklisa(k,i)>0) THEN
              maskdustloc(k)=1
          endif
@@ -296,58 +296,58 @@
   INTEGER,DIMENSION(klon) :: maskdust ! where the emissions were calculated
   REAL,DIMENSION(klon,nbsrf),     INTENT(IN)     :: pctsrf
-!  real,parameter :: sizeacclow=0.03
-!  real,parameter :: sizeacchigh=0.5
-!  real,parameter :: sizecoalow=0.5
-!  real,parameter :: sizecoahigh=10.  ! in micrometers
-  real,parameter :: sizeacclow=0.06
-  real,parameter :: sizeacchigh=1.0
-  real,parameter :: sizecoalow=1.0
-  real,parameter :: sizecoahigh=6.  !20 ! diameter in micrometers
-  real,parameter :: sizescolow=6.
-  real,parameter :: sizescohigh=30.  ! in micrometers
+!  REAL,parameter :: sizeacclow=0.03
+!  REAL,parameter :: sizeacchigh=0.5
+!  REAL,parameter :: sizecoalow=0.5
+!  REAL,parameter :: sizecoahigh=10.  ! in micrometers
+  REAL,parameter :: sizeacclow=0.06
+  REAL,parameter :: sizeacchigh=1.0
+  REAL,parameter :: sizecoalow=1.0
+  REAL,parameter :: sizecoahigh=6.  !20 ! diameter in micrometers
+  REAL,parameter :: sizescolow=6.
+  REAL,parameter :: sizescohigh=30.  ! in micrometers
 !--------------------------------
-!  real,parameter :: tuningfactorfine=0.9  ! factor for fine bins!!! important!!
-  real,parameter :: tuningfactorfine=0.8  ! factor for fine bins!!! important!!
-!  real,parameter :: tuningfactorfine=4.5  ! factor for fine bins!!! important!!
-!  real,parameter :: tuningfactorcoa=3.6 ! factor for coarse bins!!! important!!
-  real,parameter :: tuningfactorcoa=3.25 ! factor for coarse bins!!! important!!
-!  real,parameter :: tuningfactorcoa=4.5  ! factor for coarse bins!!! important!!
-!  real,parameter :: tuningfactorsco=3.6  ! factor for supercoarse bins!!! important!!
-  real,parameter :: tuningfactorsco=3.25  ! factor for supercoarse bins!!! important!!
-!  real,parameter :: tuningfactorsco=4.5  ! factor for supercoarse bins!!! important!!
-  real,parameter :: basesumemission= 0.0  !1.e-6  ! emissions to SUM to each land pixel FOR ASSIMILATION ONLY important!!  in mg/m2/s, per bin
+!  REAL,parameter :: tuningfactorfine=0.9  ! factor for fine bins!!! important!!
+  REAL,parameter :: tuningfactorfine=0.8  ! factor for fine bins!!! important!!
+!  REAL,parameter :: tuningfactorfine=4.5  ! factor for fine bins!!! important!!
+!  REAL,parameter :: tuningfactorcoa=3.6 ! factor for coarse bins!!! important!!
+  REAL,parameter :: tuningfactorcoa=3.25 ! factor for coarse bins!!! important!!
+!  REAL,parameter :: tuningfactorcoa=4.5  ! factor for coarse bins!!! important!!
+!  REAL,parameter :: tuningfactorsco=3.6  ! factor for supercoarse bins!!! important!!
+  REAL,parameter :: tuningfactorsco=3.25  ! factor for supercoarse bins!!! important!!
+!  REAL,parameter :: tuningfactorsco=4.5  ! factor for supercoarse bins!!! important!!
+  REAL,parameter :: basesumemission= 0.0  !1.e-6  ! emissions to SUM to each land pixel FOR ASSIMILATION ONLY important!!  in mg/m2/s, per bin
  !basesumemission = 1.e-6 increase the AOD in about 12%  (0.03 of AOD) , 
  !while 1e-8 increase in about 0.12%  (0.003 of AOD)
 
-  real,dimension(klon) :: basesumacc,basesumcoa,basesumsco
+  REAL,DIMENSION(klon) :: basesumacc,basesumcoa,basesumsco
 !--------------------------------
-!JE20140915  real,parameter :: sizeacclow=0.06
-!JE20140915  real,parameter :: sizeacchigh=1.0
-!JE20140915  real,parameter :: sizecoalow=1.0
-!JE20140915  real,parameter :: sizecoahigh=10.  !20 ! diameter in micrometers
-!JE20140915  real,parameter :: sizescolow=10.
-!JE20140915  real,parameter :: sizescohigh=30.  ! in micrometers
-
-
-
-  logical ::  debutphy
+!JE20140915  REAL,parameter :: sizeacclow=0.06
+!JE20140915  REAL,parameter :: sizeacchigh=1.0
+!JE20140915  REAL,parameter :: sizecoalow=1.0
+!JE20140915  REAL,parameter :: sizecoahigh=10.  !20 ! diameter in micrometers
+!JE20140915  REAL,parameter :: sizescolow=10.
+!JE20140915  REAL,parameter :: sizescohigh=30.  ! in micrometers
+
+
+
+  LOGICAL ::  debutphy
   REAL :: diff, auxr1,auxr2,auxr3,auxr4
-  real,dimension(klon,nbins) :: itvmean
-  real,dimension(klon,nbins+1) :: itv2
-!  real,dimension(klon_glo,nbins) :: itvmean_glo
-!  real,dimension(:,:) , allocatable  :: itvmean_glo
-!  real,dimension(:,:), allocatable :: itv2_glo
+  REAL,DIMENSION(klon,nbins) :: itvmean
+  REAL,DIMENSION(klon,nbins+1) :: itv2
+!  REAL,DIMENSION(klon_glo,nbins) :: itvmean_glo
+!  REAL,DIMENSION(:,:) , ALLOCATABLE  :: itvmean_glo
+!  REAL,DIMENSION(:,:), ALLOCATABLE :: itv2_glo
   
-  integer, save :: counter,counter1 !dbg
+  INTEGER, save :: counter,counter1 !dbg
   REAL, DIMENSION(:,:),ALLOCATABLE,SAVE :: emisbinlocalmean,emisbinlocalmean2 !dbg
   REAL, DIMENSION(:,:),ALLOCATABLE :: emisbinlocalmean2_glo 
-  logical :: writeaerosoldistrib
+  LOGICAL :: writeaerosoldistrib
 !$OMP THREADPRIVATE(iminacclow,iminacchigh,imincoalow,imincoahigh)
 
 writeaerosoldistrib=.FALSE.
 IF (debutphy) THEN
-  if (sizedustmin>sizeacclow .or. sizedustmax<sizescohigh) THEN
+  IF (sizedustmin>sizeacclow .OR. sizedustmax<sizescohigh) THEN
    CALL abort_gcm('adaptdustemission', 'Dust range problem',1)
-  endif
+  ENDIF
   print *,'FINE DUST BIN: tuning EMISSION factor= ',tuningfactorfine
   print *,'COA DUST BIN: tuning EMISSION factor= ',tuningfactorcoa
@@ -359,19 +359,19 @@
   auxr4=9999.
   do i=1,nbins+1
-   if (abs(sizeacclow-itv(i))<auxr1) THEN
+   IF (abs(sizeacclow-itv(i))<auxr1) THEN
           auxr1=abs( sizeacclow-itv(i))
           iminacclow=i
    endif
-   if (abs(sizeacchigh-itv(i))<auxr2) THEN
+   IF (abs(sizeacchigh-itv(i))<auxr2) THEN
           auxr2=abs( sizeacchigh-itv(i))
           iminacchigh=i
           imincoalow=i
    endif
-   if (abs(sizecoahigh-itv(i))<auxr3) THEN
+   IF (abs(sizecoahigh-itv(i))<auxr3) THEN
           auxr3=abs( sizecoahigh-itv(i))
           imincoahigh=i
           iminscolow=i
    endif
-   if (abs(sizescohigh-itv(i))<auxr4) THEN
+   IF (abs(sizescohigh-itv(i))<auxr4) THEN
           auxr4=abs( sizescohigh-itv(i))
           iminscohigh=i
@@ -478,5 +478,5 @@
 ! 480 = 5 days
 IF (MOD(counter,1440)== 0) THEN
-   !if (MOD(counter,480).eq. 0) THEN
+   !if (MOD(counter,480).EQ. 0) THEN
    do k = 1,klon
    do i=1,nbins
@@ -671,9 +671,9 @@
     !print *,Pini(i,1),Pini(i,2),Pini(i,3),Pini(i,4),Pini(i,5)
     DO nts=1,ntyp
-      !IF(xlon(i).ge.longmin.and.xlon(i).le.longmax.and. &
-      !&      xlat(i).ge.latmin.and.xlat(i).le.latmax    &
-      !&      .and.pctsrf(i)>0.5.and.Pini(i,nts)>0.)THEN
+      !IF(xlon(i).ge.longmin.AND.xlon(i).le.longmax.AND. &
+      !&      xlat(i).ge.latmin.AND.xlat(i).le.latmax    &
+      !&      .AND.pctsrf(i)>0.5.AND.Pini(i,nts)>0.)THEN
   ! JE20150605<< easier to read
-      IF(pctsrf(i,is_ter)>0.5.and.Pini(i,nts)>0.)THEN
+      IF(pctsrf(i,is_ter)>0.5.AND.Pini(i,nts)>0.)THEN
   ! JE20150605>>
            sol(i,nts) = solini(i,nts)
@@ -774,5 +774,5 @@
             cc=sqrt(1+ddust*(sizeclass(i)**(-2.5)))
             xk=sqrt(abs(rop*gravity*sizeclass(i)/roa))
-            if (bb<10.) THEN
+            IF (bb<10.) THEN
                dd=sqrt(1.928*(bb**0.092)-1.)
                uth(i)=0.129*xk*cc/dd
@@ -848,5 +848,5 @@
           do k=1,ntyp
      !     PRINT*,'IKKK ',i,klon,k,ntyp
-             if (zos(i,k)==0..or.z01(i,k)==0.) THEN
+             IF (zos(i,k)==0..or.z01(i,k)==0.) THEN
      !       if (zos(i,k)<=0..or.z01(i,k)<=0.) THEN
 !              if (zos(i,k)<0..or.z01(i,k)<0.) THEN
@@ -876,8 +876,8 @@
    !       PRINT*,'IKKK D ',i,klon,k,ntyp
               endif
-              if (feff(i,k)<0.)feff(i,k)=0.
-              if (feffdbg(i,k)<0.)feffdbg(i,k)=0.
-              if (feff(i,k)>1.)feff(i,k)=1.
-              if (feffdbg(i,k)>1.)feffdbg(i,k)=1.
+              IF (feff(i,k)<0.)feff(i,k)=0.
+              IF (feffdbg(i,k)<0.)feffdbg(i,k)=0.
+              IF (feff(i,k)>1.)feff(i,k)=1.
+              IF (feffdbg(i,k)>1.)feffdbg(i,k)=1.
     !      PRINT*,'IKKK E ',i,klon,k,ntyp
             endif
@@ -885,5 +885,5 @@
         enddo
 ! JE20150120<<
-  if (flag_feff == 0) THEN
+  IF (flag_feff == 0) THEN
     print *,'JE_dbg FORCED deactivated feff'
     do i=1,klon
@@ -892,5 +892,5 @@
       enddo
     enddo
-  endif
+  ENDIF
 ! JE20150120>>
 
@@ -1011,5 +1011,5 @@
 !           GOTO 60
 !        END IF
-!        IF(nb.eq.miniso)THEN
+!        IF(nb.EQ.miniso)THEN
 !           binsISOGRAD(k)=binsHR(nb)
 !           istart=nb+1
@@ -1239,12 +1239,12 @@
  
 
-                 !IF(n.eq.1.and.nat.eq.99)GOTO 80
-             !      IF(n.eq.1) PRINT*,'nat1=',nat,'sol1=',sol(i,n)
-                   IF(n==1.and.nat==99)GOTO 80
+                 !IF(n.EQ.1.AND.nat.EQ.99)GOTO 80
+             !      IF(n.EQ.1) PRINT*,'nat1=',nat,'sol1=',sol(i,n)
+                   IF(n==1.AND.nat==99)GOTO 80
 
              ENDIF
              IF(.TRUE.) THEN
                 nat=int(sol(i,n))
-                IF(n == 1 .and. nat >= 14 .or. nat < 1 .or. nat > 19) GOTO 80
+                IF(n == 1 .AND. nat >= 14 .OR. nat < 1 .OR. nat > 19) GOTO 80
              ENDIF
 !JE20150129>>>>
@@ -1256,5 +1256,5 @@
                       ustarsalt=0.
                    IF(ceff<=0..or.z0salt==0.)GOTO 80
-                   IF(cerod==0.or.cpcent==0.)GOTO 80
+                   IF(cerod==0.OR.cpcent==0.)GOTO 80
 ! in cm: utmin, umin, z10m, z0salt, ustarns
 ! in meters: modwm
@@ -1275,5 +1275,5 @@
       do ni=1,kfin
          fdp1=1.-(uth2(ni)/(ceff*ustarsalt))
-         if (fdp1<=0..or.srel2(nat,ni)==0.) THEN
+         IF (fdp1<=0..or.srel2(nat,ni)==0.) THEN
             ad1=0.
             ad2=0.
@@ -1374,6 +1374,6 @@
       IMPLICIT NONE
 
- integer i,n,kfin,ideb,ifin,istep,kfin2
-    real dsmin,dsmax
+ INTEGER i,n,kfin,ideb,ifin,istep,kfin2
+    REAL dsmin,dsmax
 
 ! estimation of the reduced soil size distribution
@@ -1426,6 +1426,6 @@
 
       IMPLICIT NONE
-      integer i1,i2,nclass,iout,ismin,ismax,k2,ihalf,idiff
-      real siz(nclass),ds
+      INTEGER i1,i2,nclass,iout,ismin,ismax,k2,ihalf,idiff
+      REAL siz(nclass),ds
 !c-----------------------------
       iout=0
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/lsc_scav_orig.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/lsc_scav_orig.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/lsc_scav_orig.F90	(revision 5117)
@@ -102,5 +102,5 @@
 !  else
 !   PRINT*,'beta from Reddy and Bocuher 2004 (original version), inscav_fisrt=',inscav_fisrt
-!  endif
+!  ENDIF
 
       alpha_r=0.001        !  coefficient d'impaction pour la pluie
@@ -201,5 +201,5 @@
 !  incloud scavenging
 !   IF(inscav_fisrt) THEN
-   if (iflag_lscav == 4) THEN
+   IF (iflag_lscav == 4) THEN
       beta=beta_fisrt(i,k)*rneb(i,k)
    else
@@ -208,5 +208,5 @@
       beta=beta/zmass(i,k)/oliq
       beta=MAX(0.,beta)
-   endif ! (iflag_lscav .eq. 4)
+   endif ! (iflag_lscav .EQ. 4)
    beta_v1(i,k)=beta    !! for output
 
@@ -282,5 +282,5 @@
 !                +d_tr_bcscav(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG  &
 !                +d_tr_evap(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG
-!      IF(it.eq.3) WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)'),&
+!      IF(it.EQ.3) WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)'),&
 !      k,'lsc conserv ',conserv,'insc',d_tr_insc(i,k,it),'bc',d_tr_bcscav(i,k,it),'ev',d_tr_evap(i,k,it)
 !       ENDDO
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/lsc_scav_spl.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/lsc_scav_spl.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/lsc_scav_spl.F90	(revision 5117)
@@ -112,5 +112,5 @@
 !  else
 !   PRINT*,'beta from Reddy and Bocuher 2004 (original version), inscav_fisrt=',inscav_fisrt
-!  endif
+!  ENDIF
 
 !JE      alpha_r=0.001        !  coefficient d'impaction pour la pluie
@@ -212,5 +212,5 @@
 !  incloud scavenging
 !   IF(inscav_fisrt) THEN
-   if (iflag_lscav == 4) THEN
+   IF (iflag_lscav == 4) THEN
       beta=beta_fisrt(i,k)*rneb(i,k)
    else
@@ -219,5 +219,5 @@
       beta=beta/zmass(i,k)/oliq
       beta=MAX(0.,beta)
-   endif ! (iflag_lscav .eq. 4)
+   endif ! (iflag_lscav .EQ. 4)
    beta_v1(i,k)=beta    !! for output
 
@@ -293,5 +293,5 @@
 !                +d_tr_bcscav(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG  &
 !                +d_tr_evap(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG
-!      IF(it.eq.3) WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)'),&
+!      IF(it.EQ.3) WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)'),&
 !      k,'lsc conserv ',conserv,'insc',d_tr_insc(i,k,it),'bc',d_tr_bcscav(i,k,it),'ev',d_tr_evap(i,k,it)
 !       ENDDO
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxqfi2.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxqfi2.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxqfi2.f90	(revision 5117)
@@ -24,5 +24,5 @@
   zqmax = zq(ijmax, lmax)
 
-  IF(zqmin<qmin.or.zqmax>qmax) &
+  IF(zqmin<qmin.OR.zqmax>qmax) &
           WRITE(*, 9999) comment, &
                   ijmin, lmin, zqmin, ijmax, lmax, zqmax
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxsource.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxsource.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxsource.f90	(revision 5117)
@@ -25,5 +25,5 @@
   zqmax = zq(ijmax, lmax)
 
-  IF(zqmin<qmin.or.zqmax>qmax) &
+  IF(zqmin<qmin.OR.zqmax>qmax) &
           WRITE(*, 9999) comment, &
                   ijmin, lmin, zqmin, ijmax, lmax, zqmax
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/neutral.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/neutral.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/neutral.f90	(revision 5117)
@@ -43,7 +43,7 @@
   do i = 1, klon
 
-    if (u10_mps(i) < 0.) u10_mps(i) = 0.0
+    IF (u10_mps(i) < 0.) u10_mps(i) = 0.0
 
-    if  (obklen_m(i) < 0.) THEN
+    IF  (obklen_m(i) < 0.) THEN
       phi = (1. - 160. / obklen_m(i))**(-0.25)
       phi_inv = 1. / phi
@@ -55,5 +55,5 @@
       f3 = atan(dum1)
       psi = 2. * log(f1) + log(f2) - 2. * f3 + pi / 2.
-    else if (obklen_m(i) > 0.) THEN
+    ELSE IF (obklen_m(i) > 0.) THEN
       psi = -50. / obklen_m(i)
     end if
@@ -61,8 +61,8 @@
     u10n_mps(i) = u10_mps(i) + (ustar_mps(i) * psi / von_karman)
     ! u10n set to 0. if -1 < obklen < 20
-    if ((obklen_m(i)>-1.).and.(obklen_m(i)<20.)) THEN
+    IF ((obklen_m(i)>-1.).AND.(obklen_m(i)<20.)) THEN
       u10n_mps(i) = 0.
     endif
-    if (u10n_mps(i) < 0.) u10n_mps(i) = 0.0
+    IF (u10n_mps(i) < 0.) u10n_mps(i) = 0.0
 
   enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phys_output_write_spl_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phys_output_write_spl_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phys_output_write_spl_mod.F90	(revision 5117)
@@ -393,5 +393,5 @@
     ! ug Pour les sorties XIOS
     USE lmdz_xios, ONLY: xios_update_calendar, using_xios
-    USE wxios, ONLY: wxios_closedef, missing_val_xios => missing_val
+    USE lmdz_wxios, ONLY: wxios_closedef, missing_val_xios => missing_val
     USE phys_cal_mod, ONLY: mth_len
     USE lmdz_yomcst
@@ -928,5 +928,5 @@
           CALL histwrite_phy(o_wdtrainA, wdtrainA)
           CALL histwrite_phy(o_wdtrainM, wdtrainM)
-       ENDIF !(iflag_con.EQ.3.or.iflag_con.EQ.30)
+       ENDIF !(iflag_con.EQ.3.OR.iflag_con.EQ.30)
 !!! nrlmd le 10/04/2012
        IF (iflag_trig_bl>=1) THEN
@@ -1067,5 +1067,5 @@
           CALL histwrite_phy(o_swsrfcs_ant, solsw0_aero(:,2))
           !cf
-          IF (.not. aerosol_couple) THEN
+          IF (.NOT. aerosol_couple) THEN
              CALL histwrite_phy(o_swtoacf_nat, topswcf_aero(:,1))
              CALL histwrite_phy(o_swsrfcf_nat, solswcf_aero(:,1))
@@ -1219,5 +1219,5 @@
           ENDIF
           CALL histwrite_phy(o_tntc, zx_tmp_fi3d)
-       ELSEIF (iflag_thermals>=1.and.iflag_wake==1)THEN
+       ELSEIF (iflag_thermals>=1.AND.iflag_wake==1)THEN
           IF (vars_defined) THEN
              zx_tmp_fi3d(1:klon,1:klev)=d_t_con(1:klon,1:klev)/pdtphys + &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90	(revision 5117)
@@ -828,25 +828,25 @@
     !  -------
 
-    real, intent(in) :: pdtphys  ! pas d'integration pour la physique (seconde)
-    REAL, intent(in) :: jD_cur, jH_cur
-    real, intent(in) :: ftsol(klon, nbsrf)  ! temperature du sol par type
-    real, intent(in) :: t_seri(klon, klev)  ! temperature
-    real, intent(in) :: u_seri(klon, klev)  ! vent
-    real, intent(in) :: v_seri(klon, klev)  ! vent
-    real, intent(in) :: q_seri(klon, klev)  ! vapeur d eau kg/kg
+    REAL, INTENT(IN) :: pdtphys  ! pas d'integration pour la physique (seconde)
+    REAL, INTENT(IN) :: jD_cur, jH_cur
+    REAL, INTENT(IN) :: ftsol(klon, nbsrf)  ! temperature du sol par type
+    REAL, INTENT(IN) :: t_seri(klon, klev)  ! temperature
+    REAL, INTENT(IN) :: u_seri(klon, klev)  ! vent
+    REAL, INTENT(IN) :: v_seri(klon, klev)  ! vent
+    REAL, INTENT(IN) :: q_seri(klon, klev)  ! vapeur d eau kg/kg
 
     LOGICAL, INTENT(IN) :: lafin
 
-    real tr_seri(klon, klev, nbtr) ! traceur
-    real tmp_var(klon, klev) ! auxiliary variable to replace traceur
-    real tmp_var2(klon, nbtr) ! auxiliary variable to replace source
-    real tmp_var3(klon, klev, nbtr) ! auxiliary variable 3D
-    real dummy1d ! JE auxiliary variable
-    real aux_var2(klon) ! auxiliary variable to replace traceur
-    real aux_var3(klon, klev) ! auxiliary variable to replace traceur
-    real d_tr(klon, klev, nbtr)    ! traceur  tendance
-    real sconc_seri(klon, nbtr) ! surface concentration of traceur
-
-    integer nbjour
+    REAL tr_seri(klon, klev, nbtr) ! traceur
+    REAL tmp_var(klon, klev) ! auxiliary variable to replace traceur
+    REAL tmp_var2(klon, nbtr) ! auxiliary variable to replace source
+    REAL tmp_var3(klon, klev, nbtr) ! auxiliary variable 3D
+    REAL dummy1d ! JE auxiliary variable
+    REAL aux_var2(klon) ! auxiliary variable to replace traceur
+    REAL aux_var3(klon, klev) ! auxiliary variable to replace traceur
+    REAL d_tr(klon, klev, nbtr)    ! traceur  tendance
+    REAL sconc_seri(klon, nbtr) ! surface concentration of traceur
+
+    INTEGER nbjour
     save nbjour
     !$OMP THREADPRIVATE(nbjour)
@@ -898,12 +898,12 @@
     !JE20150518>>
 
-    real, intent(in) :: paprs(klon, klev + 1)  ! pression pour chaque inter-couche (en Pa)
-    real, intent(in) :: pplay(klon, klev)  ! pression pour le mileu de chaque couche (en Pa)
-    real, intent(in) :: RHcl(klon, klev)  ! humidite relativen ciel clair
-    real znivsig(klev)  ! indice des couches
-    real paire(klon)
-    real, intent(in) :: pphis(klon)
-    real, intent(in) :: pctsrf(klon, nbsrf)
-    logical, intent(in) :: debutphy   ! le flag de l'initialisation de la physique
+    REAL, INTENT(IN) :: paprs(klon, klev + 1)  ! pression pour chaque inter-couche (en Pa)
+    REAL, INTENT(IN) :: pplay(klon, klev)  ! pression pour le mileu de chaque couche (en Pa)
+    REAL, INTENT(IN) :: RHcl(klon, klev)  ! humidite relativen ciel clair
+    REAL znivsig(klev)  ! indice des couches
+    REAL paire(klon)
+    REAL, INTENT(IN) :: pphis(klon)
+    REAL, INTENT(IN) :: pctsrf(klon, nbsrf)
+    logical, INTENT(IN) :: debutphy   ! le flag de l'initialisation de la physique
 
     !  Scaling Parameters:
@@ -950,10 +950,10 @@
     !  -----------
 
-    REAL, intent(in) :: pmfu(klon, klev)  ! flux de masse dans le panache montant
-    REAL, intent(in) :: pmfd(klon, klev)  ! flux de masse dans le panache descendant
-    REAL, intent(in) :: pen_u(klon, klev) ! flux entraine dans le panache montant
-    REAL, intent(in) :: pde_u(klon, klev) ! flux detraine dans le panache montant
-    REAL, intent(in) :: pen_d(klon, klev) ! flux entraine dans le panache descendant
-    REAL, intent(in) :: pde_d(klon, klev) ! flux detraine dans le panache descendant
+    REAL, INTENT(IN) :: pmfu(klon, klev)  ! flux de masse dans le panache montant
+    REAL, INTENT(IN) :: pmfd(klon, klev)  ! flux de masse dans le panache descendant
+    REAL, INTENT(IN) :: pen_u(klon, klev) ! flux entraine dans le panache montant
+    REAL, INTENT(IN) :: pde_u(klon, klev) ! flux detraine dans le panache montant
+    REAL, INTENT(IN) :: pen_d(klon, klev) ! flux entraine dans le panache descendant
+    REAL, INTENT(IN) :: pde_d(klon, klev) ! flux detraine dans le panache descendant
 
     !  Convection KE scheme:
@@ -1023,6 +1023,6 @@
     !  ---------
 
-    REAL, intent(in) :: pmflxr(klon, klev + 1), pmflxs(klon, klev + 1)   !--convection
-    REAL, intent(in) :: prfl(klon, klev + 1), psfl(klon, klev + 1)     !--large-scale
+    REAL, INTENT(IN) :: pmflxr(klon, klev + 1), pmflxs(klon, klev + 1)   !--convection
+    REAL, INTENT(IN) :: prfl(klon, klev + 1), psfl(klon, klev + 1)     !--large-scale
     REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb
     REAL :: ql_incloud_ref    ! ref value of in-cloud condensed water content
@@ -1047,8 +1047,8 @@
     !  --------------
 
-    REAL, intent(in) :: coefh(klon, klev) ! coeff melange CL
-    REAL, intent(in) :: cdragh(klon), cdragm(klon)
-    REAL, intent(in) :: yu1(klon)        ! vent dans la 1iere couche
-    REAL, intent(in) :: yv1(klon)        ! vent dans la 1iere couche
+    REAL, INTENT(IN) :: coefh(klon, klev) ! coeff melange CL
+    REAL, INTENT(IN) :: cdragh(klon), cdragm(klon)
+    REAL, INTENT(IN) :: yu1(klon)        ! vent dans la 1iere couche
+    REAL, INTENT(IN) :: yv1(klon)        ! vent dans la 1iere couche
 
 
@@ -1071,6 +1071,6 @@
     !  -----------
 
-    REAL, intent(in) :: rlat(klon)       ! latitudes pour chaque point
-    REAL, intent(in) :: rlon(klon)       ! longitudes pour chaque point
+    REAL, INTENT(IN) :: rlat(klon)       ! latitudes pour chaque point
+    REAL, INTENT(IN) :: rlon(klon)       ! longitudes pour chaque point
 
     INTEGER i, k, iq, itr, j, ig
@@ -1164,5 +1164,5 @@
     !      REAL his_g2paer(klon)      ! gastoparticle in aerosol units (check!)
 
-    INTEGER, intent(in) :: iflag_conv
+    INTEGER, INTENT(IN) :: iflag_conv
     LOGICAL iscm3  ! debug variable. for checkmass ! JE
 
@@ -1213,5 +1213,5 @@
     source_tr = 0.
 
-    if (debutphy) THEN
+    IF (debutphy) THEN
 #ifdef IOPHYS_DUST
          CALL iophys_ini(pdtphys)
@@ -1394,13 +1394,13 @@
       enddo
       ! check consistency with dust emission scheme:
-      if (ok_chimeredust) THEN
-        if (.not.(id_scdu>0 .and. id_codu>0 .and. id_fine>0)) THEN
+      IF (ok_chimeredust) THEN
+        IF (.NOT.(id_scdu>0 .AND. id_codu>0 .AND. id_fine>0)) THEN
           CALL abort_gcm('phytracr_mod', 'pb in ok_chimdust 0', 1)
         endif
       else
-        if (id_scdu>0) THEN
+        IF (id_scdu>0) THEN
           CALL abort_gcm('phytracr_mod', 'pb in ok_chimdust 1 SCDU', 1)
         endif
-        if ((id_codu <= 0) .or. (id_fine<=0)) THEN
+        IF ((id_codu <= 0) .OR. (id_fine<=0)) THEN
           CALL abort_gcm('phytracr_mod', 'pb in ok_chimdust 1', 1)
         endif
@@ -1521,5 +1521,5 @@
 
     iscm3 = .FALSE.
-    if (debutphy) THEN
+    IF (debutphy) THEN
       !$OMP MASTER
       CALL suphel
@@ -4442,15 +4442,15 @@
     REAL scale_param(nbreg)
     !local vars
-    integer nid, ierr, nvarid
-    real rcode, auxreal
-    integer start(4), count(4), status
+    INTEGER nid, ierr, nvarid
+    REAL rcode, auxreal
+    INTEGER start(4), count(4), status
     !      local
     CHARACTER*104 varname
     CHARACTER*2 aux_2s
-    integer i, j, ig
+    INTEGER i, j, ig
     !$OMP MASTER
     IF (is_mpi_root .AND. is_omp_root) THEN
       ierr = nf90_open(trim(adjustl(filescaleparams)), nf90_nowrite, nid)
-      if (ierr == nf90_noerr) THEN
+      IF (ierr == nf90_noerr) THEN
         do i = 1, nbreg
           WRITE(aux_2s, '(i2.2)') i
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/precuremission.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/precuremission.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/precuremission.f90	(revision 5117)
@@ -98,5 +98,5 @@
           tsol, pctsrf, lmt_dmsconc, lmt_dms)
 
-  IF (.not.bateau) THEN
+  IF (.NOT.bateau) THEN
     DO i = 1, klon
       lmt_so2ba(i) = 0.0
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_dust.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_dust.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_dust.f90	(revision 5117)
@@ -26,5 +26,5 @@
   !$OMP MASTER
   IF (is_mpi_root .AND. is_omp_root) THEN
-    if (debutphy) THEN
+    IF (debutphy) THEN
       ncid1 = nf90_open('dust.nc', nf90_nowrite, rcode)
       varid1 = nf90_inq_varid(ncid1, 'EMISSION', rcode)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_newemissions.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_newemissions.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_newemissions.f90	(revision 5117)
@@ -30,5 +30,5 @@
   INCLUDE 'chem_spla.h'
 
-  logical :: debutphy, lafinphy, edgar
+  LOGICAL :: debutphy, lafinphy, edgar
   INTEGER :: test_vent, test_day, step_vent, flag_dms, nbjour
   INTEGER :: julien, i, iday
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_surface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_surface.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_surface.F90	(revision 5117)
@@ -18,27 +18,27 @@
        character*10 varname
 
-       real tmp_dyn(iip1,jjp1)
-       real tmp_dyn_glo(nbp_lon+1,nbp_lat)
+       REAL tmp_dyn(iip1,jjp1)
+       REAL tmp_dyn_glo(nbp_lon+1,nbp_lat)
        REAL tmp_dyn_invers(iip1,jjp1)
-       real tmp_dyn_invers_glo(nbp_lon+1,nbp_lat)
-       real tmp_fi(klon)
-       real tmp_fi_glo(klon_glo)
-       real surfa(klon,5)
-       real surfa_glo(klon_glo,5)
+       REAL tmp_dyn_invers_glo(nbp_lon+1,nbp_lat)
+       REAL tmp_fi(klon)
+       REAL tmp_fi_glo(klon_glo)
+       REAL surfa(klon,5)
+       REAL surfa_glo(klon_glo,5)
 
-       integer ncid
-       integer varid
-       integer rcode
-       integer start(2),count(2),status
-       integer i,j,l,ig
+       INTEGER ncid
+       INTEGER varid
+       INTEGER rcode
+       INTEGER start(2),count(2),status
+       INTEGER i,j,l,ig
        character*1 str1
 
 !JE20140526<<
       character*4 ::  latstr,aux4s
-      logical :: outcycle, isinversed
-      real, dimension(jjp1) :: lats
-      real, dimension(nbp_lat) :: lats_glo
+      LOGICAL :: outcycle, isinversed
+      REAL, DIMENSION(jjp1) :: lats
+      REAL, DIMENSION(nbp_lat) :: lats_glo
       REAL :: rcode2
-      integer, dimension(1) :: startj,endj
+      INTEGER, DIMENSION(1) :: startj,endj
 !JE20140526>>
 !$OMP MASTER
@@ -53,13 +53,13 @@
       isinversed=.FALSE.
       do i=1,5
-       if (i==1) aux4s='latu'
-       if (i==2) aux4s='LATU'
-       if (i==3) aux4s='LatU'
-       if (i==4) aux4s='Latu'
-       if (i==5) aux4s='latU'
+       IF (i==1) aux4s='latu'
+       IF (i==2) aux4s='LATU'
+       IF (i==3) aux4s='LatU'
+       IF (i==4) aux4s='Latu'
+       IF (i==5) aux4s='latU'
        status = nf90_inq_varid (ncid, aux4s, rcode)
 !       print *,'stat,i',status,i,outcycle,aux4s
 !       print *,'ifclause',status.NE. nf90_noerr ,outcycle == .FALSE.
-       IF ((.not.(status/= nf90_noerr) ).and.( .not. outcycle )) THEN
+       IF ((.NOT.(status/= nf90_noerr) ).AND.( .NOT. outcycle )) THEN
          outcycle=.TRUE.
          latstr=aux4s
@@ -78,5 +78,5 @@
 
 ! check if netcdf is latitude inversed or not. 
-      if (lats_glo(1)<lats_glo(2)) isinversed=.TRUE.
+      IF (lats_glo(1)<lats_glo(2)) isinversed=.TRUE.
 ! JE20140526>>
 
@@ -118,5 +118,5 @@
 !JE20140526<<
 !              CALL gr_dyn_fi(1, iip1, jjp1, klon, tmp_dyn_invers, tmp_fi)
-           if (isinversed) THEN
+           IF (isinversed) THEN
                         CALL gr_dyn_fi(1, nbp_lon+1, nbp_lat, klon_glo, &
    tmp_dyn_invers_glo, tmp_fi_glo)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_vent.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_vent.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_vent.f90	(revision 5117)
@@ -26,5 +26,5 @@
   !$OMP MASTER
   IF (is_mpi_root .AND. is_omp_root) THEN
-    if (debutphy) THEN
+    IF (debutphy) THEN
       ncidu1 = nf90_open('u10m.nc', nf90_nowrite, rcode)
       varidu1 = nf90_inq_varid(ncidu1, 'U10M', rcode)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/satellite_out_spla.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/satellite_out_spla.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/satellite_out_spla.F90	(revision 5117)
@@ -16,5 +16,5 @@
   INTEGER :: i
   REAL :: overpassaqua, overpassterra
-  REAL,dimension(klon) :: rlat,rlon
+  REAL,DIMENSION(klon) :: rlat,rlon
 
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/bulk_flux_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/bulk_flux_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/bulk_flux_m.F90	(revision 5117)
@@ -8,80 +8,80 @@
        u, t_ocean_1, s1, rain, hf, hlb, rnl, tau, rhoa, xlv, rf, dtime, rns)
 
-    use config_ocean_skin_m, ONLY: jwarm, jcool, rain_effect
-    use Microlayer_m, ONLY: Microlayer
-    use mom_flux_rain_m, ONLY: mom_flux_rain
-    use Near_Surface_m, ONLY: Near_Surface, depth
-    use therm_expans_m, ONLY: therm_expans
+    USE config_ocean_skin_m, ONLY: jwarm, jcool, rain_effect
+    USE Microlayer_m, ONLY: Microlayer
+    USE mom_flux_rain_m, ONLY: mom_flux_rain
+    USE Near_Surface_m, ONLY: Near_Surface, depth
+    USE therm_expans_m, ONLY: therm_expans
 
-    real, intent(out):: tkt(:)
+    REAL, INTENT(OUT):: tkt(:)
     ! thickness of cool skin (microlayer), in m
 
-    real, intent(out):: tks(:)
+    REAL, INTENT(OUT):: tks(:)
     ! thickness of mass diffusion layer (microlayer), in m
 
-    real, intent(out):: taur(:) ! momentum flux due to rain, in Pa
+    REAL, INTENT(OUT):: taur(:) ! momentum flux due to rain, in Pa
 
-    real, intent(out):: dter(:)
+    REAL, INTENT(OUT):: dter(:)
     ! Temperature variation in the diffusive microlayer, that is
     ! ocean-air interface temperature minus subskin temperature. In K.
 
-    real, intent(out):: dser(:)
+    REAL, INTENT(OUT):: dser(:)
     ! Salinity variation in the diffusive microlayer, that is ocean-air
     ! interface salinity minus subskin salinity. In ppt.
 
-    real, intent(out):: t_int(:) ! interface temperature, in K
-    real, intent(out):: s_int(:) ! interface salinity, in ppt
+    REAL, INTENT(OUT):: t_int(:) ! interface temperature, in K
+    REAL, INTENT(OUT):: s_int(:) ! interface salinity, in ppt
 
-    real, intent(inout):: ds_ns(:)
+    REAL, INTENT(INOUT):: ds_ns(:)
     ! "delta salinity near surface". Salinity variation in the
     ! near-surface turbulent layer. That is subskin salinity minus
     ! foundation salinity. In ppt.
 
-    real, intent(inout):: dt_ns(:)
+    REAL, INTENT(INOUT):: dt_ns(:)
     ! "delta temperature near surface". Temperature variation in the
     ! near-surface turbulent layer. That is subskin temperature minus
     ! foundation temperature. (Can be negative.) In K.
 
-    real, intent(in):: u(:)
+    REAL, INTENT(IN):: u(:)
     ! Wind speed relative to the sea surface, i. e. taking current
     ! vector into account. In m s-1.
 
-    real, intent(in):: t_ocean_1(:) ! input sea temperature, at depth_1, in K
-    real, intent(in):: S1(:) ! salinity at depth_1, in ppt
+    REAL, INTENT(IN):: t_ocean_1(:) ! input sea temperature, at depth_1, in K
+    REAL, INTENT(IN):: S1(:) ! salinity at depth_1, in ppt
 
-    real, intent(in):: rain(:)
+    REAL, INTENT(IN):: rain(:)
     ! rain mass flux, averaged on a timestep, in kg m-2 s-1
 
-    real, intent(in):: hf(:)
+    REAL, INTENT(IN):: hf(:)
     !  turbulent part of sensible heat flux, positive upward, in W m-2
 
-    real, intent(in):: hlb(:)
+    REAL, INTENT(IN):: hlb(:)
     ! latent heat flux at the surface, positive upward (W m-2)
 
-    real, intent(in):: rnl(:)
+    REAL, INTENT(IN):: rnl(:)
     ! net longwave radiation, positive upward, in W m-2
 
-    real, intent(in):: tau(:)
+    REAL, INTENT(IN):: tau(:)
     ! wind stress at the surface, turbulent part only, in Pa
     
-    real, intent(in):: rhoa(:) ! density of moist air  (kg / m3)
-    real, intent(in):: xlv(:) ! latent heat of evaporation (J / kg)
+    REAL, INTENT(IN):: rhoa(:) ! density of moist air  (kg / m3)
+    REAL, INTENT(IN):: xlv(:) ! latent heat of evaporation (J / kg)
 
-    real, intent(in):: rf(:)
+    REAL, INTENT(IN):: rf(:)
     ! sensible heat flux at the surface due to rainfall, in W m-2,
     ! positive upward
 
-    real, intent(in):: dtime ! time step, in s
-    real, intent(in):: rns(:) ! net downward shortwave radiation, in W m-2
+    REAL, INTENT(IN):: dtime ! time step, in s
+    REAL, INTENT(IN):: rns(:) ! net downward shortwave radiation, in W m-2
 
     ! Local:
     
-    real al(size(t_ocean_1)) ! water thermal expansion coefficient (in K-1)
-    real dels(size(t_ocean_1)), null_array(size(t_ocean_1))
-    integer iter
-    real t_subskin(size(t_ocean_1)) ! subskin temperature, in K
-    real s_subskin(size(t_ocean_1)) ! subskin salinity, in ppt
+    REAL al(size(t_ocean_1)) ! water thermal expansion coefficient (in K-1)
+    REAL dels(size(t_ocean_1)), null_array(size(t_ocean_1))
+    INTEGER iter
+    REAL t_subskin(size(t_ocean_1)) ! subskin temperature, in K
+    REAL s_subskin(size(t_ocean_1)) ! subskin salinity, in ppt
 
-    real, parameter:: fxp = 1. - (0.28 * 0.014 &
+    REAL, parameter:: fxp = 1. - (0.28 * 0.014 &
          + 0.27 * 0.357 * (1. - exp(- depth / 0.357)) &
          + .45 * 12.82 * (1.- exp(- depth / 12.82))) / depth
@@ -90,22 +90,22 @@
     ! H. Bellenger 2016
 
-    real tau_with_min(size(t_ocean_1))
+    REAL tau_with_min(size(t_ocean_1))
     ! modified wind stress, avoiding very low values
     
-    real, parameter:: tau_0 = 1e-3 ! in N m-2
+    REAL, parameter:: tau_0 = 1e-3 ! in N m-2
 
     !-------------------------------------------------------------------
 
-    if (rain_effect) THEN
+    IF (rain_effect) THEN
        taur = mom_flux_rain(u, rain)
     else
-       if (jwarm .or. jcool) null_array = 0.
+       IF (jwarm .OR. jcool) null_array = 0.
        taur = 0.
     end if
 
-    if (jwarm .or. jcool) tau_with_min = tau + tau_0 * (1. - exp(- tau_0 / tau))
+    IF (jwarm .OR. jcool) tau_with_min = tau + tau_0 * (1. - exp(- tau_0 / tau))
 
-    if (Jwarm) THEN
-       if (rain_effect) THEN
+    IF (Jwarm) THEN
+       IF (rain_effect) THEN
           CALL Near_Surface(al, t_subskin, s_subskin, ds_ns, dt_ns, &
                tau_with_min, taur, hlb, rhoa, xlv, dtime, t_ocean_1, s1, rain, &
@@ -117,10 +117,10 @@
        end if
     else
-       if (Jcool) al = therm_expans(t_ocean_1)
+       IF (Jcool) al = therm_expans(t_ocean_1)
        t_subskin = t_ocean_1
        s_subskin = s1
     end if
 
-    if (Jcool) THEN
+    IF (Jcool) THEN
        ! First guess:
        tkt = 0.001
@@ -131,5 +131,5 @@
           dels = rns * (0.065 + 11. * tkt - 6.6e-5 / tkt &
                * (1. - exp(- tkt / 8e-4))) ! equation 16 Ohlmann
-          if (rain_effect) THEN
+          IF (rain_effect) THEN
              CALL Microlayer(dter, dser, tkt, tks, hlb, tau_with_min, &
                   s_subskin, al, xlv, taur, rf, rain, &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/config_ocean_skin_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/config_ocean_skin_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/config_ocean_skin_m.F90	(revision 5117)
@@ -7,5 +7,5 @@
   logical, protected:: rain_effect
 
-  real, protected:: depth_1 = 20.
+  REAL, protected:: depth_1 = 20.
   ! Depth at which the temperature and salinity are input. Could be
   ! the depth of a sensor, or the depth at the middle of the first
@@ -18,5 +18,5 @@
 
 #ifdef IN_LMDZ
-  integer, protected:: activate_ocean_skin = 0
+  INTEGER, protected:: activate_ocean_skin = 0
   ! Allowed values: 0 do not activate; 1 activate without retroaction
   ! on LMDZ; 2 activate with retroaction on LMDZ
@@ -30,9 +30,9 @@
 
 #ifdef IN_LMDZ
-    use lmdz_ioipsl_getin_p, ONLY: getin_p
-    use lmdz_assert, ONLY: assert
+    USE lmdz_ioipsl_getin_p, ONLY: getin_p
+    USE lmdz_assert, ONLY: assert
 #endif
 
-    integer:: flag_ocean_skin = 3
+    INTEGER:: flag_ocean_skin = 3
     !$omp threadprivate(flag_ocean_skin)
     
@@ -43,7 +43,7 @@
 #ifdef IN_LMDZ
     CALL getin_p("activate_ocean_skin", activate_ocean_skin)
-    CALL assert(activate_ocean_skin >= 0 .and. activate_ocean_skin <= 2, &
+    CALL assert(activate_ocean_skin >= 0 .AND. activate_ocean_skin <= 2, &
          "config_ocean_skin bad value of activate_ocean_skin")
-    if (activate_ocean_skin >= 1) THEN
+    IF (activate_ocean_skin >= 1) THEN
        CALL getin_p("flag_ocean_skin", flag_ocean_skin)
        CALL getin_p("depth_1", depth_1)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/const.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/const.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/const.F90	(revision 5117)
@@ -3,5 +3,5 @@
   IMPLICIT NONE
 
-  real, parameter :: beta = 0.756 / 1023.343
+  REAL, parameter :: beta = 0.756 / 1023.343
   ! Salinity expansion coefficient. Derivative with respect to
   ! practical salinity, not mass fraction of salt. Value at 25 Celsius
@@ -9,17 +9,17 @@
   ! k0829, table A.3.1).
 
-  real, parameter :: cpa = 1004.67
+  REAL, parameter :: cpa = 1004.67
   ! specific heat of dry air, in J / kg / K (Businger 1982)
 
-  real, parameter :: cpw = 4000. ! specific heat of liquid water, in J / kg / K
-  real, parameter :: grav = 9.780326772 ! constante de gravitation, m s-2
-  real, parameter :: rhow = 1022. ! density of liquid water, in kg / m3
+  REAL, parameter :: cpw = 4000. ! specific heat of liquid water, in J / kg / K
+  REAL, parameter :: grav = 9.780326772 ! constante de gravitation, m s-2
+  REAL, parameter :: rhow = 1022. ! density of liquid water, in kg / m3
 
-  real, parameter :: rgas = 287.1
+  REAL, parameter :: rgas = 287.1
   ! specific ideal gas constant for dry air, in J / kg / K
 
-  real, parameter :: von = 0.4 ! von Karman's "constant"
+  REAL, parameter :: von = 0.4 ! von Karman's "constant"
 
-  real, parameter :: eps_w = 0.62197
+  REAL, parameter :: eps_w = 0.62197
   ! molecular mass of water over molecular mass of dry air (Gill 1982
   ! k0829, equation 3.1.13)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/esat_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/esat_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/esat_m.F90	(revision 5117)
@@ -10,6 +10,6 @@
     ! J. Appl. Meteor. 20, 1527-1532, equation (8).
 
-    real, intent(in):: T ! temperature, in K
-    real, intent(in):: P ! air pressure, in Pa
+    REAL, INTENT(IN):: T ! temperature, in K
+    REAL, INTENT(IN):: P ! air pressure, in Pa
 
     !--------------------------------------------------------------------
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/fv_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/fv_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/fv_m.F90	(revision 5117)
@@ -9,20 +9,20 @@
     ! H. Bellenger 2016
 
-    real, intent(in):: z ! profondeur en m (z < 0)
-    real, intent(in):: rain ! rain mass flux, in kg m-2 s-1
+    REAL, INTENT(IN):: z ! profondeur en m (z < 0)
+    REAL, INTENT(IN):: rain ! rain mass flux, in kg m-2 s-1
 
     ! Local:
 
-    real dfV
+    REAL dfV
     ! fraction of rain volume entering the ocean and deposited within depth "z"
 
-    real rc, lbd, f0
-    real z_mm
+    REAL rc, lbd, f0
+    REAL z_mm
 
     ! Schlussel et al. 1997, Table 1:
-    real, parameter:: zeta(14) = [0.0026091, 0.0022743, 0.0015406, 0.0012281, &
+    REAL, parameter:: zeta(14) = [0.0026091, 0.0022743, 0.0015406, 0.0012281, &
          0.0008795, 0.00077123, 0.00057451, 0.000438, 6.7228e-5, 6.4955e-5, &
          4.4234e-5, 3.3906e-5, 2.7433e-6, 4.0283e-7]
-    real, parameter:: psi(14) = [0.60107, 0.29968, 0.5563, 1.80858, 0.2175, &
+    REAL, parameter:: psi(14) = [0.60107, 0.29968, 0.5563, 1.80858, 0.2175, &
          0.33961, 0.96368, 0.65081, 0.5967, 2.7661, 2.2812, 2.7674, 2.6095, &
          6.5308]
@@ -30,5 +30,5 @@
     !---------------------------------------------------------------------
 
-    if (rain > 0.) THEN
+    IF (rain > 0.) THEN
        rc = 0.4 ! mm
        z_mm = z * 1000. ! mm and <0
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/microlayer_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/microlayer_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/microlayer_m.F90	(revision 5117)
@@ -10,52 +10,52 @@
     ! H. Bellenger 2016
 
-    use const, ONLY: beta, cpw, grav, rhow
-    use fv_m, ONLY: fv
+    USE const, ONLY: beta, cpw, grav, rhow
+    USE fv_m, ONLY: fv
 
-    real, intent(out):: dter(:)
+    REAL, INTENT(OUT):: dter(:)
     ! Temperature variation in the diffusive microlayer, that is
     ! ocean-air interface temperature minus subskin temperature. In K.
 
-    real, intent(out):: dser(:)
+    REAL, INTENT(OUT):: dser(:)
     ! Salinity variation in the diffusive microlayer, that is ocean-air
     ! interface salinity minus subskin salinity. In ppt.
 
-    real, intent(inout):: tkt(:)
+    REAL, INTENT(INOUT):: tkt(:)
     ! thickness of cool skin (microlayer), in m
 
-    real, intent(inout):: tks(:)
+    REAL, INTENT(INOUT):: tks(:)
     ! thickness of mass diffusion layer (microlayer), in m
 
-    real, intent(in):: hlb(:)
+    REAL, INTENT(IN):: hlb(:)
     ! latent heat flux at the surface, positive upward (W m-2)
 
-    real, intent(in):: tau(:) ! wind stress, turbulent part only, in Pa
-    real, intent(in):: s_subskin(:) ! subskin salinity, in ppt
-    real, intent(in):: al(:) ! water thermal expansion coefficient (in K-1)
-    real, intent(in):: xlv(:) ! latent heat of evaporation (J/kg)
-    real, intent(in):: taur(:) ! momentum flux due to rainfall, in Pa
+    REAL, INTENT(IN):: tau(:) ! wind stress, turbulent part only, in Pa
+    REAL, INTENT(IN):: s_subskin(:) ! subskin salinity, in ppt
+    REAL, INTENT(IN):: al(:) ! water thermal expansion coefficient (in K-1)
+    REAL, INTENT(IN):: xlv(:) ! latent heat of evaporation (J/kg)
+    REAL, INTENT(IN):: taur(:) ! momentum flux due to rainfall, in Pa
 
-    real, intent(in):: rf(:)
+    REAL, INTENT(IN):: rf(:)
     ! sensible heat flux at the surface due to rainfall, in W m-2
 
-    real, intent(in):: rain(:) ! rain mass flux, in kg m-2 s-1
+    REAL, INTENT(IN):: rain(:) ! rain mass flux, in kg m-2 s-1
 
-    real, intent(in):: qcol(:)
+    REAL, INTENT(IN):: qcol(:)
     ! net flux at the surface, without sensible heat flux due to rain, in W m-2
 
     ! Local:
 
-    real, dimension(size(qcol)):: usrk, usrct, usrcs, alq
-    real xlamx(size(qcol)) ! Saunders coefficient
-    real, parameter:: visw = 1e-6
-    real, parameter:: tcw = 0.6 ! thermal conductivity of water
+    REAL, DIMENSION(size(qcol)):: usrk, usrct, usrcs, alq
+    REAL xlamx(size(qcol)) ! Saunders coefficient
+    REAL, parameter:: visw = 1e-6
+    REAL, parameter:: tcw = 0.6 ! thermal conductivity of water
 
-    real, parameter:: mu = 0.0129e-7 ! in m2 / s
+    REAL, parameter:: mu = 0.0129e-7 ! in m2 / s
     ! molecular salinity diffusivity, Kraus and Businger, page 47
 
-    real, parameter:: kappa = 1.49e-7 ! thermal diffusivity, in m2 / s
+    REAL, parameter:: kappa = 1.49e-7 ! thermal diffusivity, in m2 / s
 
-    real, parameter:: afk = 4e-4
-    real, parameter:: bfk = 1.3
+    REAL, parameter:: afk = 4e-4
+    REAL, parameter:: bfk = 1.3
     ! a and b coefficient for the power function fitting the TKE flux 
     ! carried by rain:  Fk = a * R**b, derived form the exact solution
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/mom_flux_rain_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/mom_flux_rain_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/mom_flux_rain_m.F90	(revision 5117)
@@ -9,8 +9,8 @@
     ! Computes momentum flux due to rainfall, in Pa.
 
-    real, intent(in):: U
+    REAL, INTENT(IN):: U
     ! difference of velocity between air and sea, including gustiness, in m / s
 
-    real, intent(in):: rain ! rain mass flux, in kg m-2 s-1
+    REAL, INTENT(IN):: rain ! rain mass flux, in kg m-2 s-1
 
     !------------------------------------------------------------------------
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/near_surface_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/near_surface_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/near_surface_m.F90	(revision 5117)
@@ -3,5 +3,5 @@
   Implicit none
 
-  real, parameter:: depth = 3.
+  REAL, parameter:: depth = 3.
   ! diurnal warm layer and fresh water lens depth, in m (Zeng and Beljaars 2005)
 
@@ -13,36 +13,36 @@
     ! Hugo Bellenger, 2016
 
-    use config_ocean_skin_m, ONLY: depth_1
-    use const, ONLY: beta, cpw, grav, rhow, von
-    use Phiw_m, ONLY: Phiw
-    use therm_expans_m, ONLY: therm_expans
+    USE config_ocean_skin_m, ONLY: depth_1
+    USE const, ONLY: beta, cpw, grav, rhow, von
+    USE Phiw_m, ONLY: Phiw
+    USE therm_expans_m, ONLY: therm_expans
 
-    real, intent(out):: al(:) ! water thermal expansion coefficient (in K-1)
-    real, intent(out):: t_subskin(:) ! subskin temperature, in K
-    real, intent(out):: s_subskin(:) ! subskin salinity, in ppt
+    REAL, INTENT(OUT):: al(:) ! water thermal expansion coefficient (in K-1)
+    REAL, INTENT(OUT):: t_subskin(:) ! subskin temperature, in K
+    REAL, INTENT(OUT):: s_subskin(:) ! subskin salinity, in ppt
 
-    real, intent(inout):: ds_ns(:)
+    REAL, INTENT(INOUT):: ds_ns(:)
     ! "delta salinity near surface". Salinity variation in the
     ! near-surface turbulent layer. That is subskin salinity minus
     ! foundation salinity. In ppt.
 
-    real, intent(inout):: dt_ns(:)
+    REAL, INTENT(INOUT):: dt_ns(:)
     ! "delta temperature near surface". Temperature variation in the
     ! near-surface turbulent layer. That is subskin temperature minus
     ! foundation temperature. (Can be negative.) In K.
 
-    real, intent(in):: tau(:)
+    REAL, INTENT(IN):: tau(:)
     ! wind stress at the surface, turbulent part only, in Pa
 
-    real, intent(in):: taur(:) ! momentum flux due to rainfall, in Pa
-    real, intent(in):: hlb(:) ! latent heat flux, turbulent part only, in W / m2
-    real, intent(in):: rhoa(:) ! density of moist air  (kg / m3)
-    real, intent(in):: xlv(:) ! latent heat of evaporation (J/kg)
-    real, intent(in):: dtime ! time step (s)
-    real, intent(in):: t_ocean_1(:) ! input sea temperature, at depth_1, in K
-    real, intent(in):: S1(:) ! salinity at depth_1, in ppt
-    real, intent(in):: rain(:) ! rain mass flux, in kg m-2 s-1
+    REAL, INTENT(IN):: taur(:) ! momentum flux due to rainfall, in Pa
+    REAL, INTENT(IN):: hlb(:) ! latent heat flux, turbulent part only, in W / m2
+    REAL, INTENT(IN):: rhoa(:) ! density of moist air  (kg / m3)
+    REAL, INTENT(IN):: xlv(:) ! latent heat of evaporation (J/kg)
+    REAL, INTENT(IN):: dtime ! time step (s)
+    REAL, INTENT(IN):: t_ocean_1(:) ! input sea temperature, at depth_1, in K
+    REAL, INTENT(IN):: S1(:) ! salinity at depth_1, in ppt
+    REAL, INTENT(IN):: rain(:) ! rain mass flux, in kg m-2 s-1
 
-    real, intent(in):: q_pwp(:)
+    REAL, INTENT(IN):: q_pwp(:)
     ! net flux absorbed by the warm layer (part of the solar flux
     ! absorbed at "depth"), minus surface fluxes, in W m-2
@@ -50,27 +50,27 @@
     ! Local:
 
-    real, parameter:: khor = 1. / 1.5e4
+    REAL, parameter:: khor = 1. / 1.5e4
     ! Parameter for the lens spread, in m-1. Inverse of the size of
     ! the lens.
 
-    real, parameter:: umax = 15.
-    real, parameter:: fact = 1.
-    real buoyf(size(t_ocean_1)) ! buoyancy flux
-    real usrc(size(t_ocean_1))
-    real drho(size(t_ocean_1)) ! rho(- delta) - rho(- d)
-    real Lmo(size(t_ocean_1)) ! Monin-Obukhov length
+    REAL, parameter:: umax = 15.
+    REAL, parameter:: fact = 1.
+    REAL buoyf(size(t_ocean_1)) ! buoyancy flux
+    REAL usrc(size(t_ocean_1))
+    REAL drho(size(t_ocean_1)) ! rho(- delta) - rho(- d)
+    REAL Lmo(size(t_ocean_1)) ! Monin-Obukhov length
 
-    real u(size(t_ocean_1))
+    REAL u(size(t_ocean_1))
     ! Wind speed at 15 m relative to the sea surface, i. e. taking
     ! current vector into account. In m s-1.
 
-    real, dimension(size(t_ocean_1)):: At, Bt, As, Bs, correction
+    REAL, DIMENSION(size(t_ocean_1)):: At, Bt, As, Bs, correction
 
-    real eta(size(t_ocean_1))
+    REAL eta(size(t_ocean_1))
     ! exponent in the function giving T(z) and S(z), equation (11) in
     ! Bellenger et al. 2017 JGR
 
-    real t_fnd(size(t_ocean_1)) ! foundation temperature, in K
-    real s_fnd(size(t_ocean_1)) ! foundation salinity, in ppt
+    REAL t_fnd(size(t_ocean_1)) ! foundation temperature, in K
+    REAL s_fnd(size(t_ocean_1)) ! foundation salinity, in ppt
 
     !----------------------------------------------------------------------
@@ -86,5 +86,5 @@
           eta = 2. / (fact * umax)
        elsewhere
-          ! {u > 2. .and. u < umax}
+          ! {u > 2. .AND. u < umax}
           eta = u / (fact * umax)
        end where
@@ -93,5 +93,5 @@
     end where
 
-    if (depth_1 < depth) THEN
+    IF (depth_1 < depth) THEN
        correction = 1. - (depth_1 / depth)**eta
        ! (neglecting microlayer thickness compared to depth_1 and depth)
@@ -115,5 +115,5 @@
     ! Case of stable stratification and negative flux, Bellenger 2017
     ! k0976, equation (15):
-    where (buoyf < 0. .and. drho < 0.)
+    where (buoyf < 0. .AND. drho < 0.)
        buoyf = sqrt(- eta * grav / (5. * depth * rhow) * drho) * usrc**2
     elsewhere (buoyf == 0.)
@@ -129,5 +129,5 @@
 
     ! Lens horizontal spreading:
-    where (drho < 0. .and. ds_ns < 0.) At = At &
+    where (drho < 0. .AND. ds_ns < 0.) At = At &
          - (eta + 1.) * khor * sqrt(depth * grav * abs(drho) / rhow)
 
@@ -141,5 +141,5 @@
 
     ! Lens horizontal spreading:
-    where (drho < 0. .and. ds_ns < 0.) As = As &
+    where (drho < 0. .AND. ds_ns < 0.) As = As &
          - (eta + 1.) * khor * sqrt(depth * grav * abs(drho) / rhow)
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/phiw_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/phiw_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/phiw_m.F90	(revision 5117)
@@ -9,9 +9,9 @@
     ! Fonction de stabilit\'e (Monin Obukhov)
 
-    real, intent(in):: zL ! profondeur  / longueur de Monin-Obukhov
+    REAL, INTENT(IN):: zL ! profondeur  / longueur de Monin-Obukhov
 
     !----------------------------------------------
 
-    if (zL < 0.) THEN
+    IF (zL < 0.) THEN
        Phiw = (1. - 16. * zL)**(- 0.5)
     else
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/sens_heat_rain_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/sens_heat_rain_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/sens_heat_rain_m.F90	(revision 5117)
@@ -6,5 +6,5 @@
 
 #ifdef IN_LMDZ
-  real function sens_heat_rain(rain, t, q, rhoa, xlv, t_int, p)
+  REAL function sens_heat_rain(rain, t, q, rhoa, xlv, t_int, p)
 #else
   elemental real function sens_heat_rain(rain, t, q, rhoa, xlv, t_int, p)
@@ -18,9 +18,9 @@
     ! OpenMP 5.0.
 
-    use const, ONLY: cpa, cpw, rgas
+    USE const, ONLY: cpa, cpw, rgas
 #ifndef IN_LMDZ
-    use const, ONLY: eps_w
+    USE const, ONLY: eps_w
 #endif
-    use esat_m, ONLY: esat
+    USE esat_m, ONLY: esat
 
 #ifdef IN_LMDZ
@@ -29,22 +29,22 @@
 #endif
 
-    real, intent(in):: rain ! rain mass flux, in kg m-2 s-1
-    real, intent(in):: t ! air temperature at 10 m, in K
-    real, intent(in):: q ! specific humidity at 10 m
-    real, intent(in):: rhoa ! density of moist air  (kg / m3)
-    real, intent(in):: xlv ! latent heat of evaporation (J / kg)
-    real, intent(in):: t_int ! interface temperature, in K
-    real, intent(in):: p ! surface pressure, in Pa
+    REAL, INTENT(IN):: rain ! rain mass flux, in kg m-2 s-1
+    REAL, INTENT(IN):: t ! air temperature at 10 m, in K
+    REAL, INTENT(IN):: q ! specific humidity at 10 m
+    REAL, INTENT(IN):: rhoa ! density of moist air  (kg / m3)
+    REAL, INTENT(IN):: xlv ! latent heat of evaporation (J / kg)
+    REAL, INTENT(IN):: t_int ! interface temperature, in K
+    REAL, INTENT(IN):: p ! surface pressure, in Pa
 
     ! Local:
     
-    real es ! saturation pressure of wator vapor, in Pa
-    real alfac ! wet bulb factor
-    real dwat ! water vapour diffusivity
-    real dtmp ! heat diffusivity
-    real q_int ! specific (saturation) humidity at ocean interface
-    real t_celsius ! air temperature at 10 m, in Celsius degrees
+    REAL es ! saturation pressure of wator vapor, in Pa
+    REAL alfac ! wet bulb factor
+    REAL dwat ! water vapour diffusivity
+    REAL dtmp ! heat diffusivity
+    REAL q_int ! specific (saturation) humidity at ocean interface
+    REAL t_celsius ! air temperature at 10 m, in Celsius degrees
 
-    real wetc
+    REAL wetc
     ! derivative of saturated mass fraction of water vapor with
     ! respect to temperature, at constant total pressure
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/therm_expans_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/therm_expans_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/therm_expans_m.F90	(revision 5117)
@@ -9,5 +9,5 @@
     ! Compute the thermal expansion coefficient of sea water.
 
-    real, intent(in):: t ! temperature, in K
+    REAL, INTENT(IN):: t ! temperature, in K
 
     !--------------------------------------------------------------
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/coagulate.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/coagulate.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/coagulate.F90	(revision 5117)
@@ -274,5 +274,5 @@
 !                     =(Vdry(k)*tr_t(ilon,ilev,k)+pdtcoag*num_dry)/( (1.+pdtcoag*denom)*Vdry(k) ) 
 !          with num_dry=...beta(i,j)*Vdry(i)*....
-!       so in old STRATAER (.not.flag_new_strat_compo), it was correct
+!       so in old STRATAER (.NOT.flag_new_strat_compo), it was correct
   ENDIF
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/micphy_tstep.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/micphy_tstep.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/micphy_tstep.F90	(revision 5117)
@@ -57,5 +57,5 @@
    1.*(7.990811e-4 + 1.*(-7.458060e-4 + 1.*2.58139e-4 )))))
 
-  IF(.not.flag_new_strat_compo) THEN
+  IF(.NOT.flag_new_strat_compo) THEN
      ! STRAACT (R2SO4, t_seri -> H2SO4 activity coefficient (ACTSO4)) for cond/evap
      CALL STRAACT(ACTSO4)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/strataer_emiss_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/strataer_emiss_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/strataer_emiss_mod.F90	(revision 5117)
@@ -88,5 +88,5 @@
       IF (flag_emit==1) THEN
         CALL getin_p('m_sulf_emiss_vol', m_sulf_emiss_vol)
-        if (ok_qemiss) THEN
+        IF (ok_qemiss) THEN
           CALL getin_p('m_H2O_emiss_vol', m_H2O_emiss_vol)
         endif
@@ -155,5 +155,5 @@
     IF (is_master) THEN
       IF (nErupt > 0) THEN
-        if (flag_emit == 1 .OR. flag_emit == 4) THEN
+        IF (flag_emit == 1 .OR. flag_emit == 4) THEN
           WRITE(lunout, *) 'IN STRATAER nErupt: ', nErupt
           WRITE(lunout, *) 'IN STRATAER injdur: ', injdur
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/sulfate_aer_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/sulfate_aer_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/sulfate_aer_mod.F90	(revision 5117)
@@ -40,7 +40,7 @@
       
 !     local variables
-      integer         :: ilon,ilev,ik
-      real, parameter :: rath2oair = mAIRmol/mH2Omol  
-      real, parameter :: third = 1./3.
+      INTEGER         :: ilon,ilev,ik
+      REAL, parameter :: rath2oair = mAIRmol/mH2Omol
+      REAL, parameter :: third = 1./3.
       real            :: pph2ogas(klon,klev) 
       real            :: temp, wpp, xa, surtens, mvh2o, radwet, fkelvin, pph2okel, r2so4ik, denso4ik
@@ -93,5 +93,5 @@
 !      ***   H2SO4-H2O curved surface - Kelvin effect factor ***
 !            wet radius (m) (RRSI(IK) in [cm])
-             if (f_r_wetB(ilon,ilev,IK) > 1.0) THEN
+             IF (f_r_wetB(ilon,ilev,IK) > 1.0) THEN
                radwet = 1.e-2*RRSI(IK)*f_r_wetB(ilon,ilev,IK)
              else 
@@ -766,5 +766,5 @@
 !********************************************************************
 !-----------------------------------------------------------------------
-      real function psh2so4(T) result(psh2so4_out)
+      REAL function psh2so4(T) result(psh2so4_out)
 !     equilibrium H2SO4 pressure over pure H2SO4 solution (Pa)
 
@@ -774,6 +774,6 @@
 
       IMPLICIT NONE
-      real, intent(in) :: T
-      real, parameter ::      &
+      REAL, INTENT(IN) :: T
+      REAL, parameter ::      &
     b1=1.01325e5, &
     b2=11.5,  &
@@ -789,14 +789,14 @@
     END FUNCTION psh2so4
 !-----------------------------------------------------------------------
-    real function ndsh2so4(T) result(ndsh2so4_out)
+    REAL function ndsh2so4(T) result(ndsh2so4_out)
 !     equilibrium H2SO4 number density over pure H2SO4 (molec/cm3)
 
       IMPLICIT NONE
-      real, intent(in) :: T
+      REAL, INTENT(IN) :: T
       REAL :: presat
 
 !     Boltzmann constant ( 1.38065e-23 J/K = m2⋅kg/(s2⋅K) )
 !      akb idem in cm2⋅g/(s2⋅K) 
-      real, parameter :: akb=1.38065e-16
+      REAL, parameter :: akb=1.38065e-16
 
 !     pure h2so4 saturation vapor pressure (Pa)
@@ -808,9 +808,9 @@
      END FUNCTION ndsh2so4
 !-----------------------------------------------------------------------
-     real function psh2o(T) result(psh2o_out)
+     REAL function psh2o(T) result(psh2o_out)
 !     equilibrium H2O pressure over pure liquid water (Pa)
 
       IMPLICIT NONE
-      real, intent(in) :: T
+      REAL, INTENT(IN) :: T
 
       IF(T>229.) THEN
@@ -835,5 +835,5 @@
      END FUNCTION psh2o
 !-----------------------------------------------------------------------
-     real function density(T,so4mfrac) result(density_out)
+     REAL function density(T,so4mfrac) result(density_out)
 !        calculation of particle density (gr/cm3)
 
@@ -842,6 +842,6 @@
 
       IMPLICIT NONE
-      real, intent(in) :: T, so4mfrac
-      real, parameter :: &
+      REAL, INTENT(IN) :: T, so4mfrac
+      REAL, parameter :: &
         a1= 0.7681724,&
         a2= 2.184714, &
@@ -851,5 +851,5 @@
         a6=-75.73729, &
         a7= 23.43228
-      real, parameter :: &
+      REAL, parameter :: &
         b1= 1.808225e-3, &
         b2=-9.294656e-3, &
@@ -859,5 +859,5 @@
         b6= 4.857736e-1, &
         b7=-1.629592e-1
-      real, parameter :: &
+      REAL, parameter :: &
         c1=-3.478524e-6, &
         c2= 1.335867e-5, &
@@ -886,5 +886,5 @@
      END FUNCTION density
 !-----------------------------------------------------------------------
-     real function surftension(T,so4frac) result(surftension_out)
+     REAL function surftension(T,so4frac) result(surftension_out)
 !        calculation of surface tension (mN/meter)
 !        requires Temperature (T) and acid mole fraction (so4frac)
@@ -892,7 +892,7 @@
 
       IMPLICIT NONE
-      real,intent(in) :: T, so4frac
+      REAL,INTENT(IN) :: T, so4frac
       REAL :: a,b,so4mfrac,so4m2,so4m3,so4m4,so4m5,so4sig
-      real, parameter :: &
+      REAL, parameter :: &
        a1= 0.11864, &
        a2=-0.11651, &
@@ -901,5 +901,5 @@
        a5= 2.95434, &
        a6=-1.25852
-      real, parameter :: &
+      REAL, parameter :: &
        b1=-1.5709e-4, &
        b2= 4.0102e-4, &
@@ -908,6 +908,6 @@
        b5=-9.37386e-3, &
        b6= 3.89722e-3
-      real, parameter :: convfac=1.e3  ! convert from newton/m to dyne/cm
-      real, parameter :: Mw=18.01528, Ma=98.079
+      REAL, parameter :: convfac=1.e3  ! convert from newton/m to dyne/cm
+      REAL, parameter :: Mw=18.01528, Ma=98.079
 
 !     so4 mass fraction
@@ -926,5 +926,5 @@
      END FUNCTION surftension
 !-----------------------------------------------------------------------
-     real function wph2so4(pph2o,T) result(wph2so4_out)
+     REAL function wph2so4(pph2o,T) result(wph2so4_out)
 !     Calculates the equilibrium composition of h2so4 aerosols
 !     as a function of temperature and  H2O pressure, using
@@ -942,5 +942,5 @@
 
       IMPLICIT NONE
-      real, intent(in) :: pph2o, T 
+      REAL, INTENT(IN) :: pph2o, T
       
       REAL :: aw, rh, y1, y2, sulfmolal
@@ -955,10 +955,10 @@
 !       composition
 !       calculation of h2so4 molality
-            IF(aw <= 0.05 .and. aw > 0.) THEN
+            IF(aw <= 0.05 .AND. aw > 0.) THEN
                y1=12.372089320*aw**(-0.16125516114) &
     -30.490657554*aw -2.1133114241
                y2=13.455394705*aw**(-0.19213122550) &
     -34.285174607*aw -1.7620073078
-            else IF(aw <= 0.85 .and. aw > 0.05) THEN
+            else IF(aw <= 0.85 .AND. aw > 0.05) THEN
                y1=11.820654354*aw**(-0.20786404244) &
     -4.8073063730*aw -5.1727540348
@@ -1001,9 +1001,9 @@
      END FUNCTION wph2so4
 !-----------------------------------------------------------------------
-     real function solh2so4(T,xa) result(solh2so4_out)
+     REAL function solh2so4(T,xa) result(solh2so4_out)
 !     equilibrium h2so4 number density over H2SO4/H2O solution (molec/cm3)
 
       IMPLICIT NONE
-      real, intent(in) :: T, xa       ! T(K)  xa(H2SO4 mass fraction)
+      REAL, INTENT(IN) :: T, xa       ! T(K)  xa(H2SO4 mass fraction)
       
       REAL :: xw, a12,b12, cacta, presat
@@ -1023,10 +1023,10 @@
      END FUNCTION solh2so4
 !-----------------------------------------------------------------------      
-     real function rpmvh2so4(T,ws) result(rpmvh2so4_out)
+     REAL function rpmvh2so4(T,ws) result(rpmvh2so4_out)
 !     partial molar volume of h2so4 in h2so4/h2o solution (cm3/mole)
 
       IMPLICIT NONE
-      real, intent(in) :: T, ws
-      real, dimension(22),parameter :: x=(/  &
+      REAL, INTENT(IN) :: T, ws
+      REAL, DIMENSION(22),parameter :: x=(/  &
    2.393284E-02,-4.359335E-05,7.961181E-08,0.0,-0.198716351, &
    1.39564574E-03,-2.020633E-06,0.51684706,-3.0539E-03,4.505475E-06, &
@@ -1046,10 +1046,10 @@
      END FUNCTION rpmvh2so4
 !-----------------------------------------------------------------------
-     real function rmvh2o(T) result(rmvh2o_out)
+     REAL function rmvh2o(T) result(rmvh2o_out)
 !     molar volume of pure h2o (cm3/mole)
 
        IMPLICIT NONE
-       real, intent(in) :: T 
-       real, parameter :: x1=2.393284E-02,x2=-4.359335E-05,x3=7.961181E-08
+       REAL, INTENT(IN) :: T
+       REAL, parameter :: x1=2.393284E-02,x2=-4.359335E-05,x3=7.961181E-08
 
 !      1000: L/mole ->  cm3/mole
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/traccoag_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/traccoag_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/traccoag_mod.F90	(revision 5117)
@@ -108,5 +108,5 @@
     ENDDO
 
-    IF (debutphy .and. is_mpi_root) THEN
+    IF (debutphy .AND. is_mpi_root) THEN
       DO it = 1, nbtr_bin
         WRITE(lunout, *) 'radius bin', it, ':', r_bin(it), '(from', r_lower(it), 'to', r_upper(it), ')'
@@ -114,5 +114,5 @@
     ENDIF
 
-    !--initialising logical is_strato from stratomask
+    !--initialising LOGICAL is_strato from stratomask
     is_strato(:, :) = .FALSE.
     WHERE (stratomask>0.5) is_strato = .TRUE.
@@ -143,5 +143,5 @@
 
     !--initialise emission diagnostics
-    if (nErupt > 0 .and. (flag_emit == 1 .or. flag_emit == 4)) budg_emi(:, 1) = 0.0
+    IF (nErupt > 0 .AND. (flag_emit == 1 .OR. flag_emit == 4)) budg_emi(:, 1) = 0.0
     budg_emi_ocs(:) = 0.0
     budg_emi_so2(:) = 0.0
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/YOEGWD.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/YOEGWD.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/YOEGWD.h	(revision 5117)
@@ -10,7 +10,7 @@
 !     -----------------------------------------------------------------
 
-      integer NKTOPG,NSTRA
-      real GFRCRIT,GKWAKE,GRCRIT,GVCRIT,GKDRAG,GKLIFT
-      real GHMAX,GRAHILO,GSIGCR,GSSEC,GTSEC,GVSEC
+      INTEGER NKTOPG,NSTRA
+      REAL GFRCRIT,GKWAKE,GRCRIT,GVCRIT,GKDRAG,GKLIFT
+      REAL GHMAX,GRAHILO,GSIGCR,GSSEC,GTSEC,GVSEC
 
       REAL GWD_RANDO_RUWMAX
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/acama_gwd_rando_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/acama_gwd_rando_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/acama_gwd_rando_m.F90	(revision 5117)
@@ -21,6 +21,6 @@
 
 !  ONLINE:
-    use dimphy, ONLY: klon, klev
-    use lmdz_assert, ONLY: assert
+    USE dimphy, ONLY: klon, klev
+    USE lmdz_assert, ONLY: assert
     USE lmdz_ioipsl_getin_p, ONLY: getin_p
     USE lmdz_vertical_layers, ONLY: presnivs
@@ -38,18 +38,18 @@
 
     ! 0.1 INPUTS
-    REAL, intent(in)::DTIME ! Time step of the Physics
-    REAL, intent(in):: PP(:, :) ! (KLON, KLEV) Pressure at full levels
-    REAL, intent(in):: ROT(:,:) ! Relative vorticity              
-    REAL, intent(in):: TT(:, :) ! (KLON, KLEV) Temp at full levels 
-    REAL, intent(in):: UU(:, :) ! (KLON, KLEV) Zonal wind at full levels
-    REAL, intent(in):: VV(:, :) ! (KLON, KLEV) Merid wind at full levels
-    REAL, intent(in):: PLAT(:) ! (KLON) LATITUDE                   
+    REAL, INTENT(IN)::DTIME ! Time step of the Physics
+    REAL, INTENT(IN):: PP(:, :) ! (KLON, KLEV) Pressure at full levels
+    REAL, INTENT(IN):: ROT(:,:) ! Relative vorticity
+    REAL, INTENT(IN):: TT(:, :) ! (KLON, KLEV) Temp at full levels
+    REAL, INTENT(IN):: UU(:, :) ! (KLON, KLEV) Zonal wind at full levels
+    REAL, INTENT(IN):: VV(:, :) ! (KLON, KLEV) Merid wind at full levels
+    REAL, INTENT(IN):: PLAT(:) ! (KLON) LATITUDE
 
     ! 0.2 OUTPUTS
-    REAL, intent(out):: zustr(:), zvstr(:) ! (KLON) Surface Stresses
-
-    REAL, intent(inout):: d_u(:, :), d_v(:, :) 
-    REAL, intent(inout):: east_gwstress(:, :) !  Profile of eastward stress
-    REAL, intent(inout):: west_gwstress(:, :) !  Profile of westward stress 
+    REAL, INTENT(OUT):: zustr(:), zvstr(:) ! (KLON) Surface Stresses
+
+    REAL, INTENT(INOUT):: d_u(:, :), d_v(:, :)
+    REAL, INTENT(INOUT):: east_gwstress(:, :) !  Profile of eastward stress
+    REAL, INTENT(INOUT):: west_gwstress(:, :) !  Profile of westward stress
     ! (KLON, KLEV) tendencies on winds
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/add_phys_tend_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/add_phys_tend_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/add_phys_tend_mod.F90	(revision 5117)
@@ -240,5 +240,5 @@
                     zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_qbs_col(:,n), zh_col(:,n))
 
-  ENDIF ! endif (fl_ebil .GT. 0)
+  ENDIF ! END IF (fl_ebil .GT. 0)
 
 !======================================================================
@@ -263,10 +263,10 @@
         zt=t_seri(i,k)+zdt(i,k)
         zq=q_seri(i,k)+zdq(i,k)
-        IF ( zt>370. .or. zt<130. .or. abs(zdt(i,k))>50. ) THEN
+        IF ( zt>370. .OR. zt<130. .OR. abs(zdt(i,k))>50. ) THEN
            jbad = jbad + 1
            jadrs(jbad) = i
            kadrs(jbad) = k
         ENDIF
-        IF ( zq<0. .or. zq>0.1 .or. abs(zdq(i,k))>1.e-2 ) THEN
+        IF ( zq<0. .OR. zq>0.1 .OR. abs(zdq(i,k))>1.e-2 ) THEN
            jqbad = jqbad + 1
            jqadrs(jqbad) = i
@@ -364,5 +364,5 @@
   DO k = 1, klev
      DO i = 1, klon
-        IF ( t_seri(i,k)>370. .or. t_seri(i,k)<130. .or. abs(zdt(i,k))>50. ) THEN
+        IF ( t_seri(i,k)>370. .OR. t_seri(i,k)<130. .OR. abs(zdt(i,k))>50. ) THEN
         jbad = jbad + 1
         jadrs(jbad) = i
@@ -371,5 +371,5 @@
 !        endif
         ENDIF
-        IF ( q_seri(i,k)<0. .or. q_seri(i,k)>0.1 .or. abs(zdq(i,k))>1.e-2 ) THEN
+        IF ( q_seri(i,k)<0. .OR. q_seri(i,k)>0.1 .OR. abs(zdq(i,k))>1.e-2 ) THEN
         jqbad = jqbad + 1
         jqadrs(jqbad) = i
@@ -389,5 +389,5 @@
                  i,itap,longitude_deg(i),latitude_deg(i),text,jbad, &
           zdt(i,k),t_seri(i,k)-zdt(i,k)
-!!!       IF(prt_level.ge.10.and.itap.GE.229.and.i.EQ.3027) THEN
+!!!       IF(prt_level.ge.10.AND.itap.GE.229.AND.i.EQ.3027) THEN
           PRINT*,'l    T     dT       Q     dQ    '
           DO k = 1, klev
@@ -407,5 +407,5 @@
                  i,itap,longitude_deg(i),latitude_deg(i),text,jqbad,&
           zdq(i,k), q_seri(i,k)-zdq(i,k), zdql(i,k), ql_seri(i,k)-zdql(i,k)
-!!!       IF(prt_level.ge.10.and.itap.GE.229.and.i.EQ.3027) THEN
+!!!       IF(prt_level.ge.10.AND.itap.GE.229.AND.i.EQ.3027) THEN
           PRINT*,'l    T     dT       Q     dQ    '
           DO k = 1, klev
@@ -471,5 +471,5 @@
     d_h_col = (zh_col(:,2)-zh_col(:,1))/phys_tstep 
 
-  ENDIF ! endif (fl_ebil .GT. 0)
+  ENDIF ! END IF (fl_ebil .GT. 0)
 
 ! When in diagnostic mode, restore "out" variables to initial values.
@@ -592,5 +592,5 @@
                     zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_qbs_col(:,n), zh_col(:,n))
 
-  ENDIF ! endif (fl_ebil .GT. 0)
+  ENDIF ! END IF (fl_ebil .GT. 0)
 
 !======================================================================
@@ -646,5 +646,5 @@
     d_h_col = (zh_col(:,2)-zh_col(:,1))/phys_tstep 
 
-  ENDIF ! endif (fl_ebil .GT. 0)
+  ENDIF ! END IF (fl_ebil .GT. 0)
 
 
@@ -833,5 +833,5 @@
 9000 FORMAT(1x,A8,2x,A35,10E15.6)
 
-ENDIF ! endif (fl_ebil .GT. 0)
+ENDIF ! END IF (fl_ebil .GT. 0)
 
 END SUBROUTINE prt_enerbil
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/aeropt_2bands.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/aeropt_2bands.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/aeropt_2bands.F90	(revision 5117)
@@ -10,5 +10,5 @@
   USE dimphy
   USE aero_mod
-  USE pres2lev_mod
+  USE lmdz_pres2lev
   USE lmdz_abort_physic, ONLY: abort_physic
 
@@ -24,19 +24,19 @@
   ! Input arguments:
 
-  REAL, DIMENSION(klon,klev),     INTENT(in)  :: pdel
-  REAL,                           INTENT(in)  :: delt
-  REAL, DIMENSION(klon,klev,naero_tot),   INTENT(in)  :: m_allaer
-  REAL, DIMENSION(klon,klev,naero_tot),   INTENT(in)  :: m_allaer_pi
-  REAL, DIMENSION(klon,klev),     INTENT(in)  :: RHcl       ! humidite relative ciel clair
-  INTEGER,                        INTENT(in)  :: flag_aerosol
-  REAL, DIMENSION(klon,klev),     INTENT(in)  :: pplay
-  REAL, DIMENSION(klon,klev),     INTENT(in)  :: t_seri
-  REAL, DIMENSION(klev),          INTENT(in)  :: presnivs
+  REAL, DIMENSION(klon,klev),     INTENT(IN)  :: pdel
+  REAL,                           INTENT(IN)  :: delt
+  REAL, DIMENSION(klon,klev,naero_tot),   INTENT(IN)  :: m_allaer
+  REAL, DIMENSION(klon,klev,naero_tot),   INTENT(IN)  :: m_allaer_pi
+  REAL, DIMENSION(klon,klev),     INTENT(IN)  :: RHcl       ! humidite relative ciel clair
+  INTEGER,                        INTENT(IN)  :: flag_aerosol
+  REAL, DIMENSION(klon,klev),     INTENT(IN)  :: pplay
+  REAL, DIMENSION(klon,klev),     INTENT(IN)  :: t_seri
+  REAL, DIMENSION(klev),          INTENT(IN)  :: presnivs
 
   ! Output arguments:
 
-  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(out) :: tau_allaer ! epaisseur optique aerosol
-  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(out) :: piz_allaer ! single scattering albedo aerosol
-  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(out) :: cg_allaer  ! asymmetry parameter aerosol
+  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: tau_allaer ! epaisseur optique aerosol
+  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: piz_allaer ! single scattering albedo aerosol
+  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: cg_allaer  ! asymmetry parameter aerosol
 
   ! Local
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/aeropt_5wv.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/aeropt_5wv.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/aeropt_5wv.F90	(revision 5117)
@@ -11,5 +11,5 @@
   USE aero_mod
   USE phys_local_var_mod, ONLY: od550aer,od865aer,ec550aer,od550lt1aer
-  USE pres2lev_mod
+  USE lmdz_pres2lev
   USE lmdz_abort_physic, ONLY: abort_physic
 
@@ -53,18 +53,18 @@
   ! Input arguments:
 
-  REAL, DIMENSION(klon,klev), INTENT(in)   :: pdel
-  REAL, INTENT(in)                         :: delt
-  REAL, DIMENSION(klon,klev,naero_tot), INTENT(in) :: m_allaer
-  REAL, DIMENSION(klon,klev), INTENT(in)   :: RHcl     ! humidite relative ciel clair
-  INTEGER,INTENT(in)                       :: flag_aerosol
-  REAL, DIMENSION(klon,klev), INTENT(in)   :: pplay
-  REAL, DIMENSION(klon,klev), INTENT(in)   :: t_seri
-  REAL, DIMENSION(klev),      INTENT(in)   :: presnivs
+  REAL, DIMENSION(klon,klev), INTENT(IN)   :: pdel
+  REAL, INTENT(IN)                         :: delt
+  REAL, DIMENSION(klon,klev,naero_tot), INTENT(IN) :: m_allaer
+  REAL, DIMENSION(klon,klev), INTENT(IN)   :: RHcl     ! humidite relative ciel clair
+  INTEGER,INTENT(IN)                       :: flag_aerosol
+  REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
+  REAL, DIMENSION(klon,klev), INTENT(IN)   :: t_seri
+  REAL, DIMENSION(klev),      INTENT(IN)   :: presnivs
 
   ! Output arguments:
 
-  REAL, DIMENSION(klon), INTENT(out)          :: ai      ! POLDER aerosol index
-  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(out)      :: tausum
-  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(out) :: tau
+  REAL, DIMENSION(klon), INTENT(OUT)          :: ai      ! POLDER aerosol index
+  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT)      :: tausum
+  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT) :: tau
 
   ! Local
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/albedo.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/albedo.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/albedo.F90	(revision 5117)
@@ -132,10 +132,10 @@
 
     ! Arguments
-    ! rmu0    (in): cosinus de l'angle solaire zenithal
-    ! albedo (out): albedo de surface de l'ocean
+    ! rmu0    (IN): cosinus de l'angle solaire zenithal
+    ! albedo (OUT): albedo de surface de l'ocean
     ! ======================================================================
     include "clesphys.h"
-    REAL, intent(in):: rmu0(klon)
-    real, intent(out):: albedo(klon)
+    REAL, INTENT(IN):: rmu0(klon)
+    REAL, INTENT(OUT):: albedo(klon)
 
     REAL fauxo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/albsno.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/albsno.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/albsno.F90	(revision 5117)
@@ -35,8 +35,8 @@
 !****************************************************************************************
 
-  if (albsno0>=0.) THEN
+  IF (albsno0>=0.) THEN
      init(:)=albsno0
      decay(:)=0.
-  endif
+  ENDIF
 
   veget = 0.
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/alpale.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/alpale.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/alpale.F90	(revision 5117)
@@ -75,6 +75,6 @@
 
        !calcul de ale_wake et alp_wake
-       if (iflag_wake>=1) THEN
-          if (itap <= it_wape_prescr) THEN
+       IF (iflag_wake>=1) THEN
+          IF (itap <= it_wape_prescr) THEN
              do i = 1,klon
                 ale_wake(i) = wape_prescr
@@ -97,6 +97,6 @@
        !combinaison avec ale et alp de couche limite: constantes si pas
        !de couplage, valeurs calculees dans le thermique sinon
-       if (iflag_coupl==0) THEN
-          if (debut.and.prt_level>9) &
+       IF (iflag_coupl==0) THEN
+          IF (debut.AND.prt_level>9) &
                WRITE(lunout,*)'ALE et ALP imposes'
           do i = 1,klon
@@ -124,5 +124,5 @@
           ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
           ! Estimation d'une vitesse verticale effective pour ALP
-          if (1==0) THEN
+          IF (1==0) THEN
              www(1:klon)=0.
              do k=2,klev-1
@@ -138,5 +138,5 @@
              enddo
              do i=1,klon
-                if (www(i)>0. .and. ale_bl(i)>0. ) www(i)=www(i)/ale_bl(i)
+                IF (www(i)>0. .AND. ale_bl(i)>0. ) www(i)=www(i)/ale_bl(i)
              enddo
           ENDIF
@@ -146,9 +146,9 @@
              ALE(i) = max(ale_wake(i),Ale_bl(i))
              !cc nrlmd le 10/04/2012----------Stochastic triggering------------
-             if (iflag_trig_bl>=1) THEN
+             IF (iflag_trig_bl>=1) THEN
                 ALE(i) = max(ale_wake(i),Ale_bl_trig(i))
              endif
              !cc fin nrlmd le 10/04/2012
-             if (alp_offset>=0.) THEN
+             IF (alp_offset>=0.) THEN
                 ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
              else
@@ -176,5 +176,5 @@
        endif
        do i=1,klon
-          if (alp(i)>alp_max) THEN
+          IF (alp(i)>alp_max) THEN
              IF(prt_level>9)WRITE(lunout,*)                             &
                   'WARNING SUPER ALP (seuil=',alp_max, &
@@ -182,5 +182,5 @@
              alp(i)=alp_max
           endif
-          if (ale(i)>ale_max) THEN
+          IF (ale(i)>ale_max) THEN
              IF(prt_level>9)WRITE(lunout,*)                             &
                   'WARNING SUPER ALE (seuil=',ale_max, &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/alpale.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/alpale.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/alpale.h	(revision 5117)
@@ -5,9 +5,9 @@
 
 ! dans alealp_th, thermcell_alp, physiq_mod, conf_phys
-      integer            :: iflag_trig_bl,iflag_clos_bl,iflag_strig
-      integer            :: tau_trig_shallow,tau_trig_deep
+      INTEGER            :: iflag_trig_bl,iflag_clos_bl,iflag_strig
+      INTEGER            :: tau_trig_shallow,tau_trig_deep
       real               :: s_trig, h_trig
 ! thermcell_alp et convection ...
-      integer            :: iflag_coupl,iflag_clos,iflag_wake
+      INTEGER            :: iflag_coupl,iflag_clos,iflag_wake
 ! thermcell_alp
       real               :: alp_bl_k
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/alpale_th.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/alpale_th.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/alpale_th.F90	(revision 5117)
@@ -127,5 +127,5 @@
           !cc nrlmd le 10/04/2012
           !-----------Stochastic triggering-----------
-          if (iflag_trig_bl>=1) THEN
+          IF (iflag_trig_bl>=1) THEN
              IF (prt_level >= 10) THEN
                 WRITE(lunout,*)'cin, ale_bl_stat, alp_bl, alp_bl_stat ', &
@@ -138,6 +138,6 @@
 !!jyg                proba_notrig(i)=1.
                 random_notrig(i)=1e6*ale_bl_stat(i)-int(1e6*ale_bl_stat(i))
-                if ( random_notrig(i) > random_notrig_max ) random_notrig(i)=0.
-                if ( ale_bl_trig(i) < abs(cin(i))+1.e-10 ) THEN
+                IF ( random_notrig(i) > random_notrig_max ) random_notrig(i)=0.
+                IF ( ale_bl_trig(i) < abs(cin(i))+1.e-10 ) THEN
                    tau_trig(i)=tau_trig_shallow
                 else
@@ -157,9 +157,9 @@
                 !----Tirage al\'eatoire et calcul de ale_bl_trig
                 do i=1,klon
-                   if ( (ale_bl_stat(i) > abs(cin(i))+1.e-10) )  THEN
+                   IF ( (ale_bl_stat(i) > abs(cin(i))+1.e-10) )  THEN
                       proba_notrig(i)=proba_notrig(i)* &
                          (1.-exp(-strig(i)/s2(i)))**(n2(i)*dtime/tau_trig(i))
                       !        print *, 'proba_notrig(i) ',proba_notrig(i)
-                      if (random_notrig(i) >= proba_notrig(i)) THEN
+                      IF (random_notrig(i) >= proba_notrig(i)) THEN
                          ale_bl_trig(i)=ale_bl_stat(i)
                       else
@@ -178,9 +178,9 @@
              ELSE IF (iflag_trig_bl>=2) THEN
                 do i=1,klon
-                   if ( (Ale_bl(i) > abs(cin(i))+1.e-10) )  THEN
+                   IF ( (Ale_bl(i) > abs(cin(i))+1.e-10) )  THEN
                       proba_notrig(i)=proba_notrig(i)* &
                          (1.-exp(-strig(i)/s2(i)))**(n2(i)*dtime/tau_trig(i))
                       !        print *, 'proba_notrig(i) ',proba_notrig(i)
-                      if (random_notrig(i) >= proba_notrig(i)) THEN
+                      IF (random_notrig(i) >= proba_notrig(i)) THEN
                          ale_bl_trig(i)=Ale_bl(i)
                       else
@@ -207,13 +207,13 @@
 
           !-----------Statistical closure-----------
-          if (iflag_clos_bl==1) THEN
+          IF (iflag_clos_bl==1) THEN
              do i=1,klon
                 !CR: alp probabiliste
-                if (ale_bl_trig(i)>0.) THEN
+                IF (ale_bl_trig(i)>0.) THEN
                    alp_bl(i)=alp_bl(i)/(1.-min(proba_notrig(i),0.999))
                 endif
              enddo
 
-          else if (iflag_clos_bl==2) THEN
+          ELSE IF (iflag_clos_bl==2) THEN
              !CR: alp calculee dans thermcell_main
              do i=1,klon
@@ -235,5 +235,5 @@
 
           !-----------Stochastic triggering-----------
-     if (iflag_trig_bl>=1) THEN
+     IF (iflag_trig_bl>=1) THEN
         IF (prt_level >= 10) THEN
            WRITE(lunout,*)'cin, ale_bl_stat, alp_bl_stat ', &
@@ -251,5 +251,5 @@
               ale_bl_ref(i)=Ale_bl(i)
          enddo
-        ENDIF ! (iflag_trig_bl.eq.1)
+        ENDIF ! (iflag_trig_bl.EQ.1)
 
 
@@ -258,5 +258,5 @@
 !!jyg           proba_notrig(i)=1.
            random_notrig(i)=1e6*ale_bl_stat(i)-int(1e6*ale_bl_stat(i))
-           if ( ale_bl_trig(i) < abs(cin(i))+1.e-10 ) THEN
+           IF ( ale_bl_trig(i) < abs(cin(i))+1.e-10 ) THEN
               tau_trig(i)=tau_trig_shallow
            else
@@ -274,5 +274,5 @@
         !----alp_bl computation
         do i=1,klon
-           if ( (ale_bl_ref(i) > abs(cin(i))+1.e-10) )  THEN
+           IF ( (ale_bl_ref(i) > abs(cin(i))+1.e-10) )  THEN
               birth_number = n2(i)*exp(-strig(i)/s2(i))
               birth_rate(i) = birth_number/(tau_trig(i)*cell_area(i))
@@ -293,5 +293,5 @@
         !----ale_bl_trig computation
          do i=1,klon
-           if (random_notrig(i) >= proba_notrig(i)) THEN
+           IF (random_notrig(i) >= proba_notrig(i)) THEN
               ale_bl_trig(i)=ale_bl_ref(i)
            else
@@ -320,10 +320,10 @@
           !IM/FH: 2011/02/23 
           ! Couplage Thermiques/Emanuel seulement si T<0
-          if (iflag_coupl==2) THEN
+          IF (iflag_coupl==2) THEN
              IF (prt_level >= 10) THEN
                 WRITE(lunout,*)'Couplage Thermiques/Emanuel seulement si T<0'
              ENDIF
              do i=1,klon
-                if (t_seri(i,lmax_th(i))>273.) THEN
+                IF (t_seri(i,lmax_th(i))>273.) THEN
                    Ale_bl(i)=0.
                 endif
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/atm2geo.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/atm2geo.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/atm2geo.F90	(revision 5117)
@@ -20,9 +20,9 @@
 ! axe y crosses (0 N, 90 E) point.
 ! axe z is 'up' : crosses north pole
-  INTEGER, INTENT (in)                 :: im, jm
-  REAL, DIMENSION (im,jm), INTENT (in) :: pte  ! Eastward vector component
-  REAL, DIMENSION (im,jm), INTENT (in) :: ptn  ! Northward vector component
-  REAL, DIMENSION (im,jm), INTENT (in) :: plon, plat
-  REAL, DIMENSION (im,jm), INTENT(out) :: pxx, pyy, pzz  ! Component in the geocentric referential 
+  INTEGER, INTENT (IN)                 :: im, jm
+  REAL, DIMENSION (im,jm), INTENT (IN) :: pte  ! Eastward vector component
+  REAL, DIMENSION (im,jm), INTENT (IN) :: ptn  ! Northward vector component
+  REAL, DIMENSION (im,jm), INTENT (IN) :: plon, plat
+  REAL, DIMENSION (im,jm), INTENT(OUT) :: pxx, pyy, pzz  ! Component in the geocentric referential
   REAL :: rad, reps
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/calbeta_clim.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/calbeta_clim.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/calbeta_clim.F90	(revision 5117)
@@ -16,11 +16,11 @@
 
   IMPLICIT NONE
-  integer klon,nt,j,it
-  real logbeta(klon),pi
-  real lat(klon),lat_radian(klon)
-  integer time
-  real time_radian
-  real lat_sahel,beta(klon)
-  real lat_nord,lat_sud
+  INTEGER klon,nt,j,it
+  REAL logbeta(klon),pi
+  REAL lat(klon),lat_radian(klon)
+  INTEGER time
+  REAL time_radian
+  REAL lat_sahel,beta(klon)
+  REAL lat_nord,lat_sud
 
   !==============================================
@@ -34,5 +34,5 @@
   time_radian=(time+15.)*2.*pi / year_len
 
-  if (prt_level >= 1) print *, 'time_radian time', time_radian, time
+  IF (prt_level >= 1) print *, 'time_radian time', time_radian, time
 
   lat(:)=180.*lat_radian(:)/pi !lat(:)=lat_radian(:)
@@ -43,5 +43,5 @@
   do j=1,klon
      !===========
-     if (lat(j) < 5. ) THEN
+     IF (lat(j) < 5. ) THEN
         logbeta(j)=0.2*(lat(j)-lat_sud)-1.6
         beta(j)=10**(logbeta(j))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/calcul_STDlev.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/calcul_STDlev.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/calcul_STDlev.h	(revision 5117)
@@ -6,5 +6,5 @@
 !       missing_val=nf90_fill_real
 
-       IF (.not. ok_all_xml) THEN
+       IF (.NOT. ok_all_xml) THEN
         CALL ini_undefSTD(itap,itapm1)
        ENDIF
@@ -112,5 +112,5 @@
                    zx_tmp_fi3d,O3STD)
 
-      if (read_climoz == 2) THEN
+      IF (read_climoz == 2) THEN
       zx_tmp_fi3d(:,:)=wo(:,:,2) * dobson_u * 1e3 / zmasse / rmo3 * rmd
         CALL plevel_new(klon,klev,nlevSTD,.FALSE.,pplay,rlevSTD, &
@@ -129,5 +129,5 @@
 !IM on moyenne a la fin du mois, du jour ou toutes les 6h
 
-       IF (.not. ok_all_xml) THEN
+       IF (.NOT. ok_all_xml) THEN
         CALL undefSTD(itap, read_climoz)
         CALL moy_undefSTD(itap,itapm1)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/calcul_fluxs_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/calcul_fluxs_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/calcul_fluxs_mod.F90	(revision 5117)
@@ -18,5 +18,5 @@
     USE dimphy, ONLY: klon
     USE indice_sol_mod
-    use sens_heat_rain_m, ONLY: sens_heat_rain
+    USE sens_heat_rain_m, ONLY: sens_heat_rain
 
     INCLUDE "clesphys.h"
@@ -77,5 +77,5 @@
     REAL,                  INTENT(IN)    :: fqsat ! correction factor on qsat (generally 0.98 over salty water, 1 everywhere else)
 
-    real, intent(in), optional:: rhoa(:) ! (knon)
+    REAL, INTENT(IN), optional:: rhoa(:) ! (knon)
     ! density of moist air  (kg / m3)
 
@@ -89,5 +89,5 @@
     REAL, DIMENSION(klon), INTENT(OUT)   :: tsurf_new, evap, fluxsens, fluxlat
     REAL, DIMENSION(klon), INTENT(OUT)   :: dflux_s, dflux_l
-    REAL, intent(out), OPTIONAL:: sens_prec_liq(:), sens_prec_sol(:) ! (knon)
+    REAL, INTENT(OUT), OPTIONAL:: sens_prec_liq(:), sens_prec_sol(:) ! (knon)
     REAL, DIMENSION(klon), OPTIONAL      :: lat_prec_liq, lat_prec_sol
 
@@ -142,6 +142,6 @@
     dflux_s = 0.
     dflux_l = 0.
-    if (PRESENT(lat_prec_liq)) lat_prec_liq = 0.
-    if (PRESENT(lat_prec_sol)) lat_prec_sol = 0.
+    IF (PRESENT(lat_prec_liq)) lat_prec_liq = 0.
+    IF (PRESENT(lat_prec_sol)) lat_prec_sol = 0.
 
 ! zx_qs = qsat en kg/kg
@@ -258,15 +258,15 @@
 
 ! calcul de l'enthalpie des precipitations liquides et solides
-       if (PRESENT(sens_prec_liq)) sens_prec_liq(i) &
+       IF (PRESENT(sens_prec_liq)) sens_prec_liq(i) &
             = - sens_heat_rain(precip_rain(i) + precip_snow(i), t1lay(i), &
             q1lay(i), rhoa(i), rlvtt, tsurf_new(i), ps(i))
-       if (PRESENT(sens_prec_sol)) sens_prec_sol(i) = 0.
+       IF (PRESENT(sens_prec_sol)) sens_prec_sol(i) = 0.
        ! On calcule par rapport a T=0
        !! sens_prec_liq(i) = rcw * (t1lay(i) - RTT) * precip_rain(i)
        !! sens_prec_sol(i) = rcs * (t1lay(i) - RTT) * precip_snow(i)
 
-       if (PRESENT(lat_prec_liq))                    &
+       IF (PRESENT(lat_prec_liq))                    &
          lat_prec_liq(i) =  precip_rain(i) * (RLVTT - RLVTT) 
-       if (PRESENT(lat_prec_sol))                    &
+       IF (PRESENT(lat_prec_sol))                    &
          lat_prec_sol(i) = precip_snow(i) * (RLSTT - RLVTT)
     ENDDO
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/call_param_replay.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/call_param_replay.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/call_param_replay.F90	(revision 5117)
@@ -1,4 +1,4 @@
    SUBROUTINE call_param_replay(ngrid,nlay)
-   integer,intent(in) :: ngrid,nlay
+   INTEGER,INTENT(IN) :: ngrid,nlay
    stop 'In call_param_replay : You should run replay_equip.sh before runing replay[13]d'
    RETURN
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/calltherm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/calltherm.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/calltherm.F90	(revision 5117)
@@ -34,5 +34,5 @@
       USE lmdz_abort_physic, ONLY: abort_physic
 #ifdef ISO
-      use infotrac_phy, ONLY: ntiso
+      USE infotrac_phy, ONLY: ntiso
 #ifdef ISOVERIF
       USE isotopes_mod, ONLY: iso_eau,iso_HDO
@@ -66,5 +66,5 @@
       REAL pplay(klon,klev)
       REAL pphi(klon,klev)
-      real zlev(klon,klev+1) 
+      REAL zlev(klon,klev+1)
 !test: on sort lentr et a* pour alimenter KE
       REAL wght_th(klon,klev)
@@ -75,61 +75,61 @@
       REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
       REAL d_u_ajs(klon,klev),d_v_ajs(klon,klev)
-      real fm_therm(klon,klev+1)
-      real entr_therm(klon,klev),detr_therm(klon,klev)
+      REAL fm_therm(klon,klev+1)
+      REAL entr_therm(klon,klev),detr_therm(klon,klev)
 
 !********************************************************
 !     declarations
       LOGICAL flag_bidouille_stratocu
-      real fmc_therm(klon,klev+1),zqasc(klon,klev)
-      real zqla(klon,klev)
-      real ztv(klon,klev),ztva(klon,klev)
-      real zpspsk(klon,klev)
-      real ztla(klon,klev)
-      real zthl(klon,klev)
-      real wmax_sec(klon)
-      real zcong(klon)
-      real zmax_sec(klon)
-      real f_sec(klon)
-      real detrc_therm(klon,klev)
+      REAL fmc_therm(klon,klev+1),zqasc(klon,klev)
+      REAL zqla(klon,klev)
+      REAL ztv(klon,klev),ztva(klon,klev)
+      REAL zpspsk(klon,klev)
+      REAL ztla(klon,klev)
+      REAL zthl(klon,klev)
+      REAL wmax_sec(klon)
+      REAL zcong(klon)
+      REAL zmax_sec(klon)
+      REAL f_sec(klon)
+      REAL detrc_therm(klon,klev)
 ! FH WARNING : il semble que ces save ne servent a rien
 !     save fmc_therm, detrc_therm
-      real clwcon0(klon,klev)
-      real zqsat(klon,klev)
-      real zw_sec(klon,klev+1)
-      integer lmix_sec(klon)
-      integer lmax(klon)
-      real ratqscth(klon,klev)
-      real ratqsdiff(klon,klev)
-      real zqsatth(klon,klev)  
+      REAL clwcon0(klon,klev)
+      REAL zqsat(klon,klev)
+      REAL zw_sec(klon,klev+1)
+      INTEGER lmix_sec(klon)
+      INTEGER lmax(klon)
+      REAL ratqscth(klon,klev)
+      REAL ratqsdiff(klon,klev)
+      REAL zqsatth(klon,klev)
 !nouvelles variables pour la convection
-      real ale_bl(klon)
-      real alp_bl(klon)
-      real ale(klon)
-      real alp(klon)
+      REAL ale_bl(klon)
+      REAL alp_bl(klon)
+      REAL ale(klon)
+      REAL alp(klon)
 !RC
       !on garde le zmax du pas de temps precedent
-      real zmax0(klon), f0(klon)
+      REAL zmax0(klon), f0(klon)
 
 !!! nrlmd le 10/04/2012
-      real pbl_tke(klon,klev+1,nbsrf)
-      real pctsrf(klon,nbsrf)
-      real omega(klon,klev)
-      real airephy(klon)
-      real zlcl_th(klon),fraca0(klon),w0(klon),w_conv(klon)
-      real therm_tke_max0(klon),env_tke_max0(klon)
-      real n2(klon),s2(klon),strig(klon)
-      real ale_bl_stat(klon)
-      real therm_tke_max(klon,klev),env_tke_max(klon,klev)
-      real alp_bl_det(klon),alp_bl_fluct_m(klon),alp_bl_fluct_tke(klon),alp_bl_conv(klon),alp_bl_stat(klon)
+      REAL pbl_tke(klon,klev+1,nbsrf)
+      REAL pctsrf(klon,nbsrf)
+      REAL omega(klon,klev)
+      REAL airephy(klon)
+      REAL zlcl_th(klon),fraca0(klon),w0(klon),w_conv(klon)
+      REAL therm_tke_max0(klon),env_tke_max0(klon)
+      REAL n2(klon),s2(klon),strig(klon)
+      REAL ale_bl_stat(klon)
+      REAL therm_tke_max(klon,klev),env_tke_max(klon,klev)
+      REAL alp_bl_det(klon),alp_bl_fluct_m(klon),alp_bl_fluct_tke(klon),alp_bl_conv(klon),alp_bl_stat(klon)
 !!! fin nrlmd le 10/04/2012
 
 !********************************************************
 
-      real, dimension(klon) :: pcon
-      real, dimension(klon,klev) :: rhobarz,wth3
-      integer,dimension(klon) :: lalim
-      real, dimension(klon,klev+1) :: fm
-      real, dimension(klon,klev) :: alim_star
-      real, dimension(klon) :: zmax
+      REAL, DIMENSION(klon) :: pcon
+      REAL, DIMENSION(klon,klev) :: rhobarz,wth3
+      INTEGER,DIMENSION(klon) :: lalim
+      REAL, DIMENSION(klon,klev+1) :: fm
+      REAL, DIMENSION(klon,klev) :: alim_star
+      REAL, DIMENSION(klon) :: zmax
 
 
@@ -140,26 +140,26 @@
       REAL d_u_the(klon,klev),d_v_the(klon,klev)
 
-      real zfm_therm(klon,klev+1),zdt
-      real zentr_therm(klon,klev),zdetr_therm(klon,klev)
+      REAL zfm_therm(klon,klev+1),zdt
+      REAL zentr_therm(klon,klev),zdetr_therm(klon,klev)
 ! FH A VERIFIER : SAVE INUTILES
 !      save zentr_therm,zfm_therm
 
-      character (len=20) :: modname='calltherm'
-      character (len=80) :: abort_message
-
-      integer i,k,isplit
+      CHARACTER (LEN=20) :: modname='calltherm'
+      CHARACTER (LEN=80) :: abort_message
+
+      INTEGER i,k,isplit
       logical, save :: first=.TRUE.
-      logical :: new_thermcell
+      LOGICAL :: new_thermcell
 
 #ifdef ISO
       REAL xt_seri(ntiso,klon,klev),xtmemoire(ntiso,klon,klev)
       REAL d_xt_ajs(ntiso,klon,klev)
-      real d_xt_the(ntiso,klon,klev)
+      REAL d_xt_the(ntiso,klon,klev)
 #ifdef DIAGISO
-      real q_the(klon,klev)
-      real xt_the(ntiso,klon,klev)
-#endif
-      real qprec(klon,klev)
-      integer ixt
+      REAL q_the(klon,klev)
+      REAL xt_the(ntiso,klon,klev)
+#endif
+      REAL qprec(klon,klev)
+      INTEGER ixt
 #endif
 
@@ -167,5 +167,5 @@
 !$OMP THREADPRIVATE(first)
 !********************************************************
-      if (first) THEN
+      IF (first) THEN
         itap=0
         first=.FALSE.
@@ -199,5 +199,5 @@
          ale_bl(:)=0.
          alp_bl(:)=0.
-         if (prt_level>=10) THEN
+         IF (prt_level>=10) THEN
           PRINT*,'thermV4 nsplit: ',nsplit_thermals,' weak_inversion'
          endif
@@ -209,7 +209,7 @@
             do i=1,klon
 ! Attention teste abderr 19-03-09
-!               logexpr2(i,k)=.not.q_seri(i,k).ge.0.
-                logexpr2(i,k)=.not.q_seri(i,k)>=1.e-15
-               if (logexpr2(i,k)) THEN
+!               logexpr2(i,k)=.NOT.q_seri(i,k).ge.0.
+                logexpr2(i,k)=.NOT.q_seri(i,k)>=1.e-15
+               IF (logexpr2(i,k)) THEN
 #ifdef ISO
                 qprec(i,k)=q_seri(i,k)
@@ -232,11 +232,11 @@
 
 
-         new_thermcell=iflag_thermals>=15.and.iflag_thermals<=18
-#ifdef ISO
-      if (.not.new_thermcell) THEN
+         new_thermcell=iflag_thermals>=15.AND.iflag_thermals<=18
+#ifdef ISO
+      IF (.NOT.new_thermcell) THEN
            CALL abort_gcm('calltherm 234','isos pas prevus ici',1)
       endif
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
        CALL iso_verif_egalite_vect2D( &
              xt_seri,q_seri, &
@@ -250,5 +250,5 @@
          do isplit=1,nsplit_thermals
 
-          if (iflag_thermals>=1000) THEN
+          IF (iflag_thermals>=1000) THEN
             CALL thermcell_2002(klon,klev,zdt,iflag_thermals   &
         ,pplay,paprs,pphi  &
@@ -258,5 +258,5 @@
         ,r_aspect_thermals,30.,w2di_thermals  &
         ,tau_thermals)
-          else if (iflag_thermals==2) THEN
+          ELSE IF (iflag_thermals==2) THEN
             CALL thermcell_sec(klon,klev,zdt  &
         ,pplay,paprs,pphi,zlev  &
@@ -266,5 +266,5 @@
         ,r_aspect_thermals,30.,w2di_thermals  &
         ,tau_thermals)
-          else if (iflag_thermals==3) THEN
+          ELSE IF (iflag_thermals==3) THEN
             CALL thermcell(klon,klev,zdt  &
         ,pplay,paprs,pphi  &
@@ -274,5 +274,5 @@
         ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
         ,tau_thermals)
-          else if (iflag_thermals==10) THEN
+          ELSE IF (iflag_thermals==10) THEN
             CALL thermcell_eau(klon,klev,zdt  &
         ,pplay,paprs,pphi  &
@@ -282,8 +282,8 @@
         ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
         ,tau_thermals)
-          else if (iflag_thermals==11) THEN
+          ELSE IF (iflag_thermals==11) THEN
               abort_message = 'cas non prevu dans calltherm'
               CALL abort_physic (modname,abort_message,1)
-          else if (iflag_thermals==12) THEN
+          ELSE IF (iflag_thermals==12) THEN
             CALL calcul_sec(klon,klev,zdt  &
         ,pplay,paprs,pphi,zlev  &
@@ -292,8 +292,8 @@
         ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
         ,tau_thermals)
-          else if (iflag_thermals==13.or.iflag_thermals==14) THEN
+          ELSE IF (iflag_thermals==13.OR.iflag_thermals==14) THEN
               abort_message = 'thermcellV0_main enleve svn>2084'
               CALL abort_physic (modname,abort_message,1)
-          else if (new_thermcell) THEN
+          ELSE IF (new_thermcell) THEN
             CALL thermcell_main(itap,klon,klev,zdt  &
         ,pplay,paprs,pphi,debut  &
@@ -324,5 +324,5 @@
           )
 
-           if (prt_level>10) WRITE(lunout,*)'Apres thermcell_main OK'
+           IF (prt_level>10) WRITE(lunout,*)'Apres thermcell_main OK'
          else
            abort_message = 'Cas des thermiques non prevu'
@@ -334,13 +334,13 @@
 ! Il aurait mieux valu avoir un nobidouille_stratocu
 ! Et pour simplifier :
-! nobidouille_stratocu=.not.(iflag_thermals==13.or.iflag_thermals=15)
+! nobidouille_stratocu=.NOT.(iflag_thermals==13.OR.iflag_thermals=15)
 ! Ce serait bien de changer, mai en prenant le temps de vérifier que ca
 ! fait bien ce qu'on croit.
 
-       flag_bidouille_stratocu=iflag_thermals<=12.or.iflag_thermals==14.or.iflag_thermals==16.or.iflag_thermals==18
+       flag_bidouille_stratocu=iflag_thermals<=12.OR.iflag_thermals==14.OR.iflag_thermals==16.OR.iflag_thermals==18
 
 ! Calcul a posteriori du niveau max des thermiques pour les schémas qui
 ! ne la sortent pas.
-      if (iflag_thermals<=12.or.iflag_thermals>=1000) THEN
+      IF (iflag_thermals<=12.OR.iflag_thermals>=1000) THEN
          lmax(:)=1
          do k=1,klev-1
@@ -349,5 +349,5 @@
          do k=1,klev-1
             do i=1,klon
-               if (zfm_therm(i,k+1)>0.) lmax(i)=k
+               IF (zfm_therm(i,k+1)>0.) lmax(i)=k
             enddo
          enddo
@@ -356,5 +356,5 @@
       fact(:)=0.
       DO i=1,klon
-       logexpr1(i)=flag_bidouille_stratocu.or.weak_inversion(i)>0.5
+       logexpr1(i)=flag_bidouille_stratocu.OR.weak_inversion(i)>0.5
        IF(logexpr1(i)) fact(i)=1./REAL(nsplit_thermals)
       ENDDO
@@ -402,5 +402,5 @@
 #ifdef ISOVERIF
 !      WRITE(*,*) 'calltherm 350 tmp: ajout d_xt_the'
-      if (iso_HDO.gt.0) THEN
+      IF (iso_HDO.gt.0) THEN
 !      i=479
 !      k=4
@@ -415,5 +415,5 @@
 #endif
 #endif 
-           if (prt_level>10) WRITE(lunout,*)'Apres apres thermcell_main OK'
+           IF (prt_level>10) WRITE(lunout,*)'Apres apres thermcell_main OK'
 
        DO i=1,klon
@@ -432,6 +432,6 @@
             DO k = 1, klev
             DO i = 1, klon
-               logexpr2(i,k)=.not.q_seri(i,k)>=0.
-               if (logexpr2(i,k)) THEN
+               logexpr2(i,k)=.NOT.q_seri(i,k)>=0.
+               IF (logexpr2(i,k)) THEN
                 q_seri(i,k)=1.e-15
                 nbptspb=nbptspb+1
@@ -450,5 +450,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-      if (iso_HDO.gt.0) THEN
+      IF (iso_HDO.gt.0) THEN
       CALL iso_verif_aberrant_enc_vect2D( &
           xt_seri,q_seri, &
@@ -464,6 +464,6 @@
             DO i = 1, klon
                logexpr2(i,k)=t_seri(i,k)<50..or.t_seri(i,k)>370.
-               if (logexpr2(i,k)) nbptspb=nbptspb+1
-!              if ((t_seri(i,k).lt.50.) .or.  &
+               IF (logexpr2(i,k)) nbptspb=nbptspb+1
+!              if ((t_seri(i,k).lt.50.) .OR.  &
 !    &              (t_seri(i,k).gt.370.)) THEN
 !                 PRINT*,'WARN temp apres therm i=',i,'  k=',k  &
@@ -483,5 +483,5 @@
                do k=1,klev
             do i=1,klon
-                  if (entr_therm(i,k)>0.) THEN
+                  IF (entr_therm(i,k)>0.) THEN
                      fmc_therm(i,k+1)=fmc_therm(i,k)+entr_therm(i,k)
                   else
@@ -498,9 +498,9 @@
 !      PRINT*,'<<<<calcul de lhumidite dans thermique'
 !CR:on ne le calcule que pour le cas sec
-      if (iflag_thermals<=11) THEN
+      IF (iflag_thermals<=11) THEN
       do i=1,klon
          zqasc(i,1)=q_seri(i,1)
          do k=2,klev
-            if (fmc_therm(i,k+1)>1.e-6) THEN
+            IF (fmc_therm(i,k+1)>1.e-6) THEN
                zqasc(i,k)=(fmc_therm(i,k)*zqasc(i,k-1)  &
                 +entr_therm(i,k)*q_seri(i,k))/fmc_therm(i,k+1)
@@ -519,5 +519,5 @@
                 do k=1,klev
                    clwcon0(i,k)=zqasc(i,k)-zqsat(i,k)
-                   if (clwcon0(i,k)<0. .or.   &
+                   IF (clwcon0(i,k)<0. .OR.   &
                (fm_therm(i,k+1)+detrc_therm(i,k))<1.e-6) THEN
                       clwcon0(i,k)=0.
@@ -529,5 +529,5 @@
                 do k=1,klev
                    clwcon0(i,k)=zqla(i,k)  
-                   if (clwcon0(i,k)<0. .or.   &
+                   IF (clwcon0(i,k)<0. .OR.   &
                (fm_therm(i,k+1)+detrc_therm(i,k))<1.e-6) THEN
                    clwcon0(i,k)=0. 
@@ -542,5 +542,5 @@
           do i=1,klon
              do k=1,klev
-                if (ztla(i,k) < 1.e-10) fraca(i,k) =0.
+                IF (ztla(i,k) < 1.e-10) fraca(i,k) =0.
              enddo
           enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cdrag_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cdrag_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cdrag_mod.F90	(revision 5117)
@@ -231,5 +231,5 @@
      IF (qsurf(i)<0.0)  ng_qsurf = ng_qsurf + 1
   ENDDO
-  IF (ng_q1>0 .and. prt_level > 5) THEN
+  IF (ng_q1>0 .AND. prt_level > 5) THEN
       WRITE(lunout,*)" *** Warning: Negative q1(humidity at 1st level) values in cdrag.F90 !"
       WRITE(lunout,*)" The total number of the grids is: ", ng_q1
@@ -238,5 +238,5 @@
 !      CALL abort_physic(modname,abort_message,1)
   ENDIF
-  IF (ng_qsurf>0 .and. prt_level > 5) THEN
+  IF (ng_qsurf>0 .AND. prt_level > 5) THEN
       WRITE(lunout,*)" *** Warning: Negative qsurf(humidity at surface) values in cdrag.F90 !"
       WRITE(lunout,*)" The total number of the grids is: ", ng_qsurf
@@ -316,5 +316,5 @@
 
 !------------------                 Pour ECUME                 --------------------
-       ELSE IF ((choix_bulk == 4) .and. (nsrf == is_oce)) THEN
+       ELSE IF ((choix_bulk == 4) .AND. (nsrf == is_oce)) THEN
          OPRECIP = .FALSE.
          OPWEBB  = .FALSE.
@@ -339,10 +339,10 @@
 
 !------------------                 Pour COARE CNRM                 --------------------
-       ELSE IF ((choix_bulk == 5) .and. (nsrf == is_oce)) THEN
+       ELSE IF ((choix_bulk == 5) .AND. (nsrf == is_oce)) THEN
          LPRECIP = .FALSE.
          LPWG    = .FALSE.
          CALL ini_csts
          block
-           real, dimension(1) :: z0m_1d, z_0h_1d, sqrt_zdu2_1d, zgeop1_rg_1d  ! convert scalar to 1D for call
+           REAL, DIMENSION(1) :: z0m_1d, z_0h_1d, sqrt_zdu2_1d, zgeop1_rg_1d  ! convert scalar to 1D for call
            z0m_1d = z0m
            z_0h_1d = z0h
@@ -362,5 +362,5 @@
 
 !------------------                 Pour COARE Maison                 --------------------
-       ELSE IF ((choix_bulk == 1) .and. (nsrf == is_oce)) THEN
+       ELSE IF ((choix_bulk == 1) .AND. (nsrf == is_oce)) THEN
          IF ( pblh(i) == 0. ) THEN
            pblh(i) = 1500.
@@ -474,5 +474,5 @@
                   ENDIF
              CASE (5) ! MO
-                  if (zri(i) < 1./alpha) THEN
+                  IF (zri(i) < 1./alpha) THEN
                     FM(i)=MAX((1.-alpha*zri(i))**2,f_ri_cd_min)
                     FH(i)=FM(i)
@@ -607,5 +607,5 @@
                 FH(i)=FM(i)
            CASE (4)  ! King 2001
-                if (zri(i) < C2/2.) THEN
+                IF (zri(i) < C2/2.) THEN
                   FM(i)=MAX((1.-zri(i)/C2)**2,f_ri_cd_min)
                   FH(i)=  FM(i)
@@ -615,5 +615,5 @@
                 endif
            CASE (5) ! MO
-                if (zri(i) < 1./alpha) THEN
+                IF (zri(i) < 1./alpha) THEN
                   FM(i)=MAX((1.-alpha*zri(i))**2,f_ri_cd_min)
                   FH(i)=FM(i)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/clc_core_cp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/clc_core_cp.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/clc_core_cp.F90	(revision 5117)
@@ -17,6 +17,6 @@
   LOGICAL, INTENT(IN) :: mixte
   REAL, DIMENSION(3), INTENT(OUT) :: coeffs
-  real, intent(out) :: rugosm
-  real, intent(out) :: rugosh
+  REAL, INTENT(OUT) :: rugosm
+  REAL, INTENT(OUT) :: rugosh
 
 
@@ -48,6 +48,6 @@
        q0 = 1.64474                           ! q0 dzfinis mais pas reutilisée ds la suite ??
 
-  REAL, dimension(3) :: z
-  integer, dimension(2) :: tmp_shape
+  REAL, DIMENSION(3) :: z
+  INTEGER, DIMENSION(2) :: tmp_shape
   z = [zu, zt, zq]
  
@@ -75,5 +75,5 @@
 
 
-  if (mixte) THEN
+  IF (mixte) THEN
      z_0m = 1.e-4                             !!!!! pour l'initialisation on fixe z_0 a 10-4
      cd_n10 = k**2 / (log(10/z_0m))**2        !!!!! on calcul ensuite cd a 10 m d'après smith 
@@ -86,8 +86,8 @@
      cd_n10_rt = sqrt(cd_n10)                  !!!!!!
      z_0m = 10. * exp(-k/cd_n10_rt)            !!!!!!! on calcul le premier z_0
-  endif
-
-
-  if ( dt > 0. ) THEN
+  ENDIF
+
+
+  IF ( dt > 0. ) THEN
      ch_n10 = 0.018 * cd_n10_rt                !!!!!!! si regime stable calcul du ch
 !     z_0h = 10. * exp(-k/ch_n10)
@@ -95,5 +95,5 @@
      ch_n10 = 0.0327 * cd_n10_rt               !!!!!!! si regime instable calcul du ch
 !     z_0h = 10. * exp(-k/ch_n10)
-  endif
+  ENDIF
 
   ce_n10 = 3.46e-2 *cd_n10_rt                  !!!!!! calcul ensuite de ce
@@ -174,5 +174,5 @@
      u_N = u / ( 1 + cd_n10_rt / k * ( logzu_10 - psi(1,1)) )
 
-     if (mixte) THEN
+     IF (mixte) THEN
         z_0m=0.018*usr**2/9.81 + 0.11*14e-6 / (usr)
 !        z_0h=(0.11*14e-6 / (usr)) + 1.4e-5 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/climb_hq_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/climb_hq_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/climb_hq_mod.F90	(revision 5117)
@@ -220,5 +220,5 @@
 !****************************************************************************************
 !!! jyg le 07/02/2012
-!!jyg       IF (mod(iflag_pbl_split,2) .eq.1) THEN
+!!jyg       IF (mod(iflag_pbl_split,2) .EQ.1) THEN
        IF (mod(iflag_pbl_split,10) >=1) THEN
 !!! nrlmd le 02/05/2011
@@ -376,5 +376,5 @@
 
 !!! jyg le 07/02/2012
-!!jyg       IF (mod(iflag_pbl_split,2) .eq.1) THEN
+!!jyg       IF (mod(iflag_pbl_split,2) .EQ.1) THEN
        IF (mod(iflag_pbl_split,10) >=1) THEN
 !!! nrlmd le 02/05/2011
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/climb_wind_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/climb_wind_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/climb_wind_mod.F90	(revision 5117)
@@ -172,5 +172,5 @@
 !****************************************************************************************
 !!! jyg le 07/02/2012
-!!jyg       IF (mod(iflag_pbl_split,2) .eq.1) THEN
+!!jyg       IF (mod(iflag_pbl_split,2) .EQ.1) THEN
        IF (mod(iflag_pbl_split,10) >=1) THEN
 !!! nrlmd le 02/05/2011
@@ -304,5 +304,5 @@
 
 !!! jyg le 07/02/2012
-!!jyg       IF (mod(iflag_pbl_split,2) .eq.1) THEN
+!!jyg       IF (mod(iflag_pbl_split,2) .EQ.1) THEN
        IF (mod(iflag_pbl_split,10) >=1) THEN
 !!! nrlmd le 02/05/2011
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/clouds_gno.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/clouds_gno.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/clouds_gno.F90	(revision 5117)
@@ -220,5 +220,5 @@
           ! PRINT*,'avant test ',i,k,lconv(i),u(i),v(i),beta(i)
           ! stop
-          ! endif
+          ! END IF
           IF (abs(fprime)<1.E-11) THEN
             ! PRINT*,'avant test fprime<.e-11 '
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cmp_seri_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cmp_seri_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cmp_seri_mod.F90	(revision 5117)
@@ -34,5 +34,5 @@
     !======================================================================
 
-    if (first) THEN
+    IF (first) THEN
        ALLOCATE(u_prev(klon,klev))
        ALLOCATE(v_prev(klon,klev))
@@ -65,13 +65,13 @@
     ! Arguments :
     !------------
-    integer iflag
+    INTEGER iflag
     CHARACTER*(*) text
     ! Local :
     !--------
-    integer i, k
-    real du_seri(klon,klev), dv_seri(klon,klev), dql_seri(klon,klev), &
+    INTEGER i, k
+    REAL du_seri(klon,klev), dv_seri(klon,klev), dql_seri(klon,klev), &
          dqs_seri(klon,klev), dq_seri(klon,klev), dt_seri(klon,klev)
-    logical t_differ, u_differ, v_differ, ql_differ, qs_differ, q_differ
-    logical any_differ
+    LOGICAL t_differ, u_differ, v_differ, ql_differ, qs_differ, q_differ
+    LOGICAL any_differ
 
     any_differ = .FALSE.
@@ -79,5 +79,5 @@
     dt_seri(:,:)=t_seri(:,:)-t_prev(:,:)
     IF (any(t_seri/=t_prev)) THEN
-       if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
+       IF ( .NOT. any_differ ) write (*,*) "In cmp_seri, after ",text
        write (*,*) '*** t_seri has changed',minval(dt_seri),maxval(dt_seri)
        t_differ=.TRUE.
@@ -89,5 +89,5 @@
     dq_seri(:,:)=q_seri(:,:)-q_prev(:,:)
     IF (any(q_seri/=q_prev)) THEN
-       if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
+       IF ( .NOT. any_differ ) write (*,*) "In cmp_seri, after ",text
        write (*,*) '*** q_seri has changed',minval(dq_seri),maxval(dq_seri)
        q_differ=.TRUE.
@@ -99,5 +99,5 @@
     dql_seri(:,:)=ql_seri(:,:)-ql_prev(:,:)
     IF (any(ql_seri/=ql_prev)) THEN
-       if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
+       IF ( .NOT. any_differ ) write (*,*) "In cmp_seri, after ",text
        write (*,*) '*** ql_seri has changed',minval(dql_seri),maxval(dql_seri)
        ql_differ=.TRUE.
@@ -109,5 +109,5 @@
     dqs_seri(:,:)=qs_seri(:,:)-qs_prev(:,:)
     IF (any(qs_seri/=qs_prev)) THEN
-       if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
+       IF ( .NOT. any_differ ) write (*,*) "In cmp_seri, after ",text
        write (*,*) '*** qs_seri has changed',minval(dqs_seri),maxval(dqs_seri)
        qs_differ=.TRUE.
@@ -119,5 +119,5 @@
     du_seri(:,:)=u_seri(:,:)-u_prev(:,:)
     IF (any(u_seri/=u_prev)) THEN
-       if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
+       IF ( .NOT. any_differ ) write (*,*) "In cmp_seri, after ",text
        write (*,*) '*** u_seri has changed',minval(du_seri),maxval(du_seri)
        u_differ=.TRUE.
@@ -129,5 +129,5 @@
     dv_seri(:,:)=v_seri(:,:)-v_prev(:,:)
     IF (any(v_seri/=v_prev)) THEN
-       if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
+       IF ( .NOT. any_differ ) write (*,*) "In cmp_seri, after ",text
        write (*,*) '*** v_seri has changed',minval(dv_seri),maxval(dv_seri)
        v_differ=.TRUE.
@@ -137,6 +137,6 @@
     END IF
 
-    if (any_differ) THEN
-       IF (iflag >= 2 .and. prt_level >= 5) THEN
+    IF (any_differ) THEN
+       IF (iflag >= 2 .AND. prt_level >= 5) THEN
           i=1
           DO k = 1, klev
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/coare30_flux_cnrm_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/coare30_flux_cnrm_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/coare30_flux_cnrm_mod.F90	(revision 5117)
@@ -143,5 +143,5 @@
 LOGICAL,            INTENT(IN)    :: LPRECIP   !
 LOGICAL,            INTENT(IN)    :: LPWG    !
-real, dimension(3), intent(inout)      :: coeffs
+REAL, DIMENSION(3), INTENT(INOUT)      :: coeffs
 
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/coare_cp_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/coare_cp_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/coare_cp_mod.F90	(revision 5117)
@@ -6,7 +6,7 @@
 contains
 
-  real function psit_30(zet)
+  REAL function psit_30(zet)
     IMPLICIT NONE
-    real, intent(in) :: zet
+    REAL, INTENT(IN) :: zet
 
     REAL :: x, psik, psic, f, c
@@ -26,11 +26,11 @@
   END FUNCTION psit_30
 
-  real function psiuo(zet)
+  REAL function psiuo(zet)
     IMPLICIT NONE
-    real, intent(in) :: zet
+    REAL, INTENT(IN) :: zet
 
     REAL :: x, psik, psic, f, c
 
-    if (zet<0) THEN
+    IF (zet<0) THEN
        x=(1.-15.*zet)**.25
        psik=2.*log((1.+x)/2.)+log((1.+x*x)/2.)-2.*atan(x)+2.*atan(1.)
@@ -42,5 +42,5 @@
      c=min(50.,.35*zet)
      psiuo=-((1.+1.0*zet)**1.0+.667*(zet-14.28)/exp(c)+8.525)
-  endif
+  ENDIF
 
 END FUNCTION psiuo
@@ -67,20 +67,20 @@
   IMPLICIT NONE
 
-  real, intent(in) :: du,dt,dq,t,q
-  real, intent(in) :: zu,zt,zq,p,zi
-  integer, intent(in) :: nits
-  ! real, dimension (nits), intent(out) :: zo,tau,hsb,hlb
-  ! real, dimension(nits,3), intent(out) :: var
-  real, dimension(3), intent(out) :: coeffs
-  real, intent(out) :: rugosm
-  real, intent(out) :: rugosh
-
-  real, parameter ::  beta=1.2, von=.4, fdg = 1. ,&
+  REAL, INTENT(IN) :: du,dt,dq,t,q
+  REAL, INTENT(IN) :: zu,zt,zq,p,zi
+  INTEGER, INTENT(IN) :: nits
+  ! REAL, dimension (nits), INTENT(OUT) :: zo,tau,hsb,hlb
+  ! REAL, DIMENSION(nits,3), INTENT(OUT) :: var
+  REAL, DIMENSION(3), INTENT(OUT) :: coeffs
+  REAL, INTENT(OUT) :: rugosm
+  REAL, INTENT(OUT) :: rugosh
+
+  REAL, parameter ::  beta=1.2, von=.4, fdg = 1. ,&
        tdk = 273.16, pi = 3.141593, grav = 9.82,&
        rgas = 287.1
 
-  integer, dimension(3) :: shape_input
-
-  real bf, cc, rhoa, visa,&
+  INTEGER, DIMENSION(3) :: shape_input
+
+  REAL bf, cc, rhoa, visa,&
        u10, ut, uts, ut0, ug,&
        cd10, ch10, ct, ct10,&
@@ -98,8 +98,8 @@
 
 
-  real old_usr, old_tsr, old_qsr,tmp
-
-  real, external :: grv
-  integer i,j,k
+  REAL old_usr, old_tsr, old_qsr,tmp
+
+  REAL, external :: grv
+  INTEGER i,j,k
 !---------------- Rajout pour prendre en compte différent Z0 --------------------------------!
 !  INTEGER :: NGRVWAVES        ! Pour le choix du z0
@@ -153,9 +153,9 @@
   Ribu=grav*zu/t*(dt+.61*t*dq)/ut**2
 
-  if (Ribu < 0) THEN
+  IF (Ribu < 0) THEN
      zetu=CC*Ribu/(1+Ribu/Ribcu)
   else
      zetu=CC*Ribu*(1+27/9*Ribu/CC)
-  endif
+  ENDIF
 
   L10=zu/zetu
@@ -163,5 +163,5 @@
   ! if (zetu .GT. 50) THEN
   !    nits=1
-  ! endif
+  ! END IF
 
   usr=ut*von/(log(zu/zom10)-psiuo(zetu))
@@ -171,13 +171,13 @@
 
   ! charnock constant - lin par morceau - constant
-  if ( ut <= 10. ) THEN
+  IF ( ut <= 10. ) THEN
      charn=0.011
   else
-     if (ut > 18) THEN
+     IF (ut > 18) THEN
         charn=0.018
      else
         charn=0.011+(ut-10)/(18-10)*(0.018-0.011)
      endif
-  endif
+  ENDIF
 
 !  ZHWAVE = 0.018*ut*ut*(1.+0.015*ut)
@@ -220,5 +220,5 @@
      Bf=-grav/t*usr*(tsr+.61*t*qsr)
 
-     if (Bf > 0) THEN
+     IF (Bf > 0) THEN
         ug=Beta*(Bf*zi)**.333
      else
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/coef_diff_turb_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/coef_diff_turb_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/coef_diff_turb_mod.F90	(revision 5117)
@@ -165,5 +165,5 @@
        ! Mais ca fait planter le replay.
        ! En attendant une réécriture, on a joute des if (Fredho)
-       if ( klon>1 .or. (klon==1 .and. knon==1) ) THEN
+       IF ( klon>1 .OR. (klon==1 .AND. knon==1) ) THEN
           CALL ustarhb(knon,klev,knon,yu,yv,ycdragm, yustar)
        endif
@@ -175,5 +175,5 @@
 !   iflag_pbl peut etre utilise comme longuer de melange
        IF (iflag_pbl>=31) THEN
-          if ( klon>1 .or. (klon==1 .and. knon==1) ) THEN
+          IF ( klon>1 .OR. (klon==1 .AND. knon==1) ) THEN
           CALL vdif_kcay(knon,klev,knon,dtime,RG,RD,ypaprs,yt, &
                yzlev,yzlay,yu,yv,yteta, &
@@ -403,5 +403,5 @@
 !           calculer la fraction nuageuse (processus humide):
 
-          if (zq /= 0.) THEN
+          IF (zq /= 0.) THEN
              zfr = (zq+ratqs*zq-zqs) / (2.0*ratqs*zq)
           else
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/coefcdrag.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/coefcdrag.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/coefcdrag.F90	(revision 5117)
@@ -42,11 +42,11 @@
 ! pref---output-R- pression au niveau zgeop/RG
 
-      INTEGER, intent(in) :: klon, knon, nsrf
-      LOGICAL, intent(in) :: zxli 
-      REAL, dimension(klon), intent(in) :: speed, t, q, zgeop, psol
-      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos, ri1 
-      LOGICAL, intent(in) :: okri    
+      INTEGER, INTENT(IN) :: klon, knon, nsrf
+      LOGICAL, INTENT(IN) :: zxli
+      REAL, DIMENSION(klon), INTENT(IN) :: speed, t, q, zgeop, psol
+      REAL, DIMENSION(klon), INTENT(IN) :: ts, qsurf, rugos, ri1
+      LOGICAL, INTENT(IN) :: okri
 
-      REAL, dimension(klon), intent(out) :: cdram, cdrah, cdran, zri1, pref
+      REAL, DIMENSION(klon), INTENT(OUT) :: cdram, cdrah, cdran, zri1, pref
 !-------------------------------------------------------------------------
 
@@ -59,9 +59,9 @@
 ! Variables locales :
       INTEGER :: i
-      REAL, dimension(klon) :: zdu2, zdphi, ztsolv, ztvd
-      REAL, dimension(klon) :: zscf, friv, frih, zucf, zcr
-      REAL, dimension(klon) :: zcfm1, zcfh1
-      REAL, dimension(klon) :: zcfm2, zcfh2
-      REAL, dimension(klon) :: trm0, trm1
+      REAL, DIMENSION(klon) :: zdu2, zdphi, ztsolv, ztvd
+      REAL, DIMENSION(klon) :: zscf, friv, frih, zucf, zcr
+      REAL, DIMENSION(klon) :: zcfm1, zcfh1
+      REAL, DIMENSION(klon) :: zcfm2, zcfh2
+      REAL, DIMENSION(klon) :: trm0, trm1
 
   CHARACTER (LEN=80) :: abort_message
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/compbl.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/compbl.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/compbl.h	(revision 5117)
@@ -7,5 +7,5 @@
 !!FC      integer iflag_pbl, iflag_pbl_split, iflag_order2_sollw
 !FC      common/compbl/iflag_pbl, iflag_pbl_split, iflag_order2_sollw
-      integer iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree
+      INTEGER iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree
       common/compbl/iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree
 !>jyg+al1
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/comsoil.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/comsoil.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/comsoil.h	(revision 5117)
@@ -4,5 +4,5 @@
       common /comsoil/inertie_sol,inertie_sno,inertie_sic,inertie_lic,  &
      &                iflag_sic,iflag_inertie
-      real inertie_sol,inertie_sno,inertie_sic,inertie_lic
-      integer iflag_sic,iflag_inertie
+      REAL inertie_sol,inertie_sno,inertie_sic,inertie_lic
+      INTEGER iflag_sic,iflag_inertie
 !$OMP THREADPRIVATE(/comsoil/)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/conema3.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/conema3.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/conema3.h	(revision 5117)
@@ -3,13 +3,13 @@
 !-- Modified by : Filiberti M-A 06/2005
 
-      real epmax             ! 0.993
-      real coef_epmax_cape             ! 0.993
+      REAL epmax             ! 0.993
+      REAL coef_epmax_cape             ! 0.993
 !jyg<
       REAL  cvl_comp_threshold     ! 0.
 !>jyg
-      logical ok_adj_ema      ! F
-      integer iflag_clw      ! 0
-      integer iflag_cvl_sigd
-      real cvl_sig2feed      ! 0.97
+      LOGICAL ok_adj_ema      ! F
+      INTEGER iflag_clw      ! 0
+      INTEGER iflag_cvl_sigd
+      REAL cvl_sig2feed      ! 0.97
 
 !jyg<
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/conemav.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/conemav.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/conemav.F90	(revision 5117)
@@ -120,9 +120,9 @@
   END DO
   ! CALL dump2d(iim,jjm-1,rflag(2:klon-1),'FLAG CONVECTION   ')
-  ! if (klon.eq.1) THEN
+  ! if (klon.EQ.1) THEN
   ! PRINT*,'IFLAG ',iflag
   ! else
   ! WRITE(*,'(96i1)') (iflag(i),i=2,klon-1)
-  ! endif
+  ! END IF
   DO k = 1, klev
     DO i = 1, klon
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/conf_phys_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/conf_phys_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/conf_phys_m.F90	(revision 5117)
@@ -32,5 +32,5 @@
     USE lmdz_grid_phy, ONLY: klon_glo
     USE lmdz_print_control, ONLY: lunout
-    use config_ocean_skin_m, ONLY: config_ocean_skin
+    USE config_ocean_skin_m, ONLY: config_ocean_skin
     USE phys_state_var_mod, ONLY: phys_tstep
     USE infotrac_phy, ONLY: type_trac
@@ -2300,5 +2300,5 @@
     ok_veget = .TRUE.
     type_veget = type_veget_omp
-    IF (type_veget=='n' .or. type_veget=='bucket' .or. type_veget=='betaclim') THEN
+    IF (type_veget=='n' .OR. type_veget=='bucket' .OR. type_veget=='betaclim') THEN
       ok_veget = .FALSE.
     ENDIF
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/convect2.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/convect2.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/convect2.F90	(revision 5117)
@@ -509,8 +509,8 @@
         ! PRINT*,tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd
         tp(i, k) = (ah0(i)-(cl-cpd)*qnk(i)*t(i,k)-gz(i,k)-alv*qg)/cpd
-        ! if (.not.cpd.gt.1000.) THEN
+        ! if (.NOT.cpd.gt.1000.) THEN
         ! PRINT*,'CPD=',cpd
         ! stop
-        ! endif
+        ! END IF
         clw(i, k) = qnk(i) - qg
         clw(i, k) = max(0.0, clw(i,k))
@@ -576,5 +576,5 @@
     wt(i, 1) = omtsnow
     hp(i, 1) = h(i, 1)
-    ! IF(.not.cpn(i,1).gt.900.) THEN
+    ! IF(.NOT.cpn(i,1).gt.900.) THEN
     ! PRINT*,'i,lv(i,1),cpn(i,1)'
     ! PRINT*, i,lv(i,1),cpn(i,1)
@@ -582,5 +582,5 @@
     ! PRINT*,'i,k',mod(i,ncum),k,'  cpn',cpn(mod(i,ncum),k)
     ! stop
-    ! endif
+    ! END IF
     lvcp(i, 1) = lv(i, 1)/cpn(i, 1)
   END DO
@@ -640,6 +640,6 @@
   ! inb(i)=k+1
   ! capem(i)=cape(i)
-  ! endif
-  ! endif
+  ! END IF
+  ! END IF
   ! 520    continue
   ! 530  continue
@@ -667,6 +667,6 @@
   ! capem(i)=cape(i)
   ! byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-  ! endif
-  ! endif
+  ! END IF
+  ! END IF
   ! 520    continue
   ! 530  continue
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cpl_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cpl_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cpl_mod.F90	(revision 5117)
@@ -242,9 +242,9 @@
     sum_error = sum_error + error
 
-    if (activate_ocean_skin >= 1) THEN
+    IF (activate_ocean_skin >= 1) THEN
        ALLOCATE(read_sss(nbp_lon, jj_nb), stat = error)
        sum_error = sum_error + error
     
-       if (activate_ocean_skin == 2) THEN
+       IF (activate_ocean_skin == 2) THEN
           ALLOCATE(cpl_delta_sst(klon), cpl_delta_sal(klon), cpl_dter(klon), &
                cpl_dser(klon), cpl_dt_ds(klon), stat = error)
@@ -413,5 +413,5 @@
     USE time_phylmdz_mod, ONLY: start_time, itau_phy
     USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
-    use config_ocean_skin_m, ONLY: activate_ocean_skin
+    USE config_ocean_skin_m, ONLY: activate_ocean_skin
 
     INCLUDE "YOMCST.h"
@@ -475,5 +475,5 @@
        read_alb_sic(:,:) = tab_read_flds(:,:,idr_icealw)  ! Albedo at sea ice
        read_sit(:,:)     = tab_read_flds(:,:,idr_icetem)  ! Sea ice temperature
-       if (activate_ocean_skin >= 1) read_sss(:,:) = tab_read_flds(:,:,idr_sss)
+       IF (activate_ocean_skin >= 1) read_sss(:,:) = tab_read_flds(:,:,idr_sss)
 !$OMP END MASTER
 
@@ -540,5 +540,5 @@
     USE carbon_cycle_mod, ONLY: carbon_cycle_cpl, fco2_ocn_day
     USE indice_sol_mod
-    use config_ocean_skin_m, ONLY: activate_ocean_skin
+    USE config_ocean_skin_m, ONLY: activate_ocean_skin
 
 ! Input arguments
@@ -568,5 +568,5 @@
 !*************************************************************************************
     CALL cpl2gath(read_sst, tsurf_new, knon, knindex)
-    if (activate_ocean_skin >= 1) CALL cpl2gath(read_sss, sss, knon, knindex)
+    IF (activate_ocean_skin >= 1) CALL cpl2gath(read_sss, sss, knon, knindex)
     CALL cpl2gath(read_sic, sic_new, knon, knindex)
     CALL cpl2gath(read_u0, u0_new, knon, knindex)
@@ -663,5 +663,5 @@
     USE indice_sol_mod
     USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
-    use config_ocean_skin_m, ONLY: activate_ocean_skin
+    USE config_ocean_skin_m, ONLY: activate_ocean_skin
     USE lmdz_abort_physic, ONLY: abort_physic
 
@@ -679,21 +679,21 @@
     REAL, DIMENSION(klon), INTENT(IN)       :: lat_prec_liq, lat_prec_sol
     
-    REAL, intent(in):: delta_sst(:) ! (knon)
+    REAL, INTENT(IN):: delta_sst(:) ! (knon)
     ! Ocean-air interface temperature minus bulk SST, in
     ! K. Defined only if activate_ocean_skin >= 1.
 
-    real, intent(in):: delta_sal(:) ! (knon)
+    REAL, INTENT(IN):: delta_sal(:) ! (knon)
     ! Ocean-air interface salinity minus bulk salinity, in ppt.
 
-    REAL, intent(in):: dter(:) ! (knon)
+    REAL, INTENT(IN):: dter(:) ! (knon)
     ! Temperature variation in the diffusive microlayer, that is
     ! ocean-air interface temperature minus subskin temperature. In
     ! K.
 
-    REAL, intent(in):: dser(:) ! (knon)
+    REAL, INTENT(IN):: dser(:) ! (knon)
     ! Salinity variation in the diffusive microlayer, that is
     ! ocean-air interface salinity minus subskin salinity. In ppt.
 
-    real, intent(in):: dt_ds(:) ! (knon)
+    REAL, INTENT(IN):: dt_ds(:) ! (knon)
     ! (tks / tkt) * dTer, in K
 
@@ -733,5 +733,5 @@
        IF (carbon_cycle_cpl) cpl_atm_co2(1:knon,cpl_index) = 0.0
 
-       if (activate_ocean_skin == 2) THEN
+       IF (activate_ocean_skin == 2) THEN
           cpl_delta_sst = 0.
           cpl_delta_sal = 0.
@@ -782,5 +782,5 @@
        ENDIF
 
-       if (activate_ocean_skin == 2) THEN
+       IF (activate_ocean_skin == 2) THEN
           cpl_delta_sst(ig) = cpl_delta_sst(ig) + delta_sst(ig) / REAL(nexca)
           cpl_delta_sal(ig) = cpl_delta_sal(ig) + delta_sal(ig) / REAL(nexca)
@@ -835,5 +835,5 @@
           ENDIF
 
-          if (activate_ocean_skin == 2) THEN
+          IF (activate_ocean_skin == 2) THEN
              ALLOCATE(cpl_delta_sst_2D(nbp_lon, jj_nb), &
                   cpl_delta_sal_2D(nbp_lon, jj_nb), &
@@ -897,5 +897,5 @@
        IF (carbon_cycle_cpl) &
             CALL gath2cpl(cpl_atm_co2(:,cpl_index), cpl_atm_co22D(:,:), knon, knindex)
-       if (activate_ocean_skin == 2) THEN
+       IF (activate_ocean_skin == 2) THEN
           CALL gath2cpl(cpl_delta_sst, cpl_delta_sst_2D, knon, knindex)
           CALL gath2cpl(cpl_delta_sal, cpl_delta_sal_2D, knon, knindex)
@@ -1293,5 +1293,5 @@
     tab_flds(:,:,ids_qsnoic) = cpl_sens_snow2D(:,:,2)
 
-    if (activate_ocean_skin == 2) THEN
+    IF (activate_ocean_skin == 2) THEN
        tab_flds(:, :, ids_delta_sst) = cpl_delta_sst_2D
        tab_flds(:, :, ids_delta_sal) = cpl_delta_sal_2D
@@ -1532,5 +1532,5 @@
     ENDIF
 
-    if (activate_ocean_skin == 2) deallocate(cpl_delta_sst_2d, &
+    IF (activate_ocean_skin == 2) deallocate(cpl_delta_sst_2d, &
          cpl_delta_sal_2d, cpl_dter_2d, cpl_dser_2d, cpl_dt_ds_2d)
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/create_limit_unstruct_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/create_limit_unstruct_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/create_limit_unstruct_mod.F90	(revision 5117)
@@ -214,5 +214,5 @@
      yder = pchsp_95(timeyear, field_in(ij, :), ibeg=2, iend=2, vc_beg=0., vc_end=0.)
      CALL pchfe_95(timeyear, field_in(ij, :), yder, skip, arth(0., real(ndays_in) / ndays, ndays), field_out(ij, :), ierr)
-     if (ierr < 0) THEN
+     IF (ierr < 0) THEN
         abort_message='error in pchfe_95'
         CALL abort_physic(modname,abort_message,1)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv30_routines.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv30_routines.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv30_routines.F90	(revision 5117)
@@ -206,5 +206,5 @@
   ! @       do 200 k=2,nlp
   ! @         do 190 i=1,len
-  ! @          if((hm(i,k).lt.work(i)).and.
+  ! @          if((hm(i,k).lt.work(i)).AND.
   ! @      &      (hm(i,k).lt.hm(i,k-1)))THEN
   ! @            work(i)=hm(i,k)
@@ -231,5 +231,5 @@
   ! @       do 240 k=minorig+1,nl
   ! @         do 230 i=1,len
-  ! @          if((hm(i,k).gt.work(i)).and.(k.le.ihmin(i)))THEN
+  ! @          if((hm(i,k).gt.work(i)).AND.(k.le.ihmin(i)))THEN
   ! @            work(i)=hm(i,k)
   ! @            nk(i)=k
@@ -251,5 +251,5 @@
   ! -------------------------------------------------------------------
   DO i = 1, len
-    IF (((t(i, nk(i))<250.0) .OR. (q(i, nk(i))<=0.0)) & ! @      &       .or.(
+    IF (((t(i, nk(i))<250.0) .OR. (q(i, nk(i))<=0.0)) & ! @      &       .OR.(
             ! p(i,ihmin(i)).lt.400.0
             ! )  )
@@ -296,5 +296,5 @@
   ! @      do 290 k=minorig,nl
   ! @        do 280 i=1,len
-  ! @          if((k.ge.(nk(i)+1)).and.(p(i,k).lt.plcl(i)))
+  ! @          if((k.ge.(nk(i)+1)).AND.(p(i,k).lt.plcl(i)))
   ! @     &    icb(i)=min(icb(i),k)
   ! @ 280    continue
@@ -302,5 +302,5 @@
   ! @c
   ! @      do 300 i=1,len
-  ! @        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
+  ! @        if((icb(i).ge.nlm).AND.(iflag(i).EQ.0))iflag(i)=9
   ! @ 300  continue
 
@@ -319,5 +319,5 @@
 
   DO i = 1, len
-    ! @        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
+    ! @        if((icb(i).ge.nlm).AND.(iflag(i).EQ.0))iflag(i)=9
     IF ((icb(i)==nlm) .AND. (iflag(i)==0)) iflag(i) = 9
   END DO
@@ -683,5 +683,5 @@
   ! oct3       ath  = th(i,icb(i)-1) - dttrig
   ! oct3
-  ! oct3       if (tdif.lt.dtcrit .or. ath.gt.ath1) THEN
+  ! oct3       if (tdif.lt.dtcrit .OR. ath.gt.ath1) THEN
   ! oct3         do 60 k=1,nl
   ! oct3            sig(i,k) = beta*sig(i,k) - 2.*alpha*tdif*tdif
@@ -794,8 +794,8 @@
   ! nn=0
   ! do 101 i=1,len
-  ! IF(iflag1(i).eq.0)THEN
+  ! IF(iflag1(i).EQ.0)THEN
   ! nn=nn+1
   ! tra(nn,k,j)=tra1(i,k,j)
-  ! endif
+  ! END IF
   ! 101  continue
   ! 111  continue
@@ -1103,6 +1103,6 @@
   ! inb(i)=k+1
   ! capem(i)=cape(i)
-  ! endif
-  ! endif
+  ! END IF
+  ! END IF
   ! 520    continue
   ! 530  continue
@@ -1130,6 +1130,6 @@
   ! capem(i)=cape(i)
   ! byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-  ! endif
-  ! endif
+  ! END IF
+  ! END IF
   ! 520    continue
   ! 530  continue
@@ -1153,5 +1153,5 @@
   ! ori        do 520 i=1,ncum
   ! ori          IF(cape(i).lt.0.0)lcape(i)=.FALSE.
-  ! ori          if((k.ge.(icb(i)+1)).and.lcape(i))THEN
+  ! ori          if((k.ge.(icb(i)+1)).AND.lcape(i))THEN
   ! ori            by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
   ! ori            byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
@@ -1551,9 +1551,9 @@
     ! do j=minorig,nl
     ! do il=1,ncum
-    ! IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
-    ! :       (j.ge.(icb(il)-1)).and.(j.le.inb(il)))THEN
+    ! IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND.
+    ! :       (j.ge.(icb(il)-1)).AND.(j.le.inb(il)))THEN
     ! traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
     ! :            +(1.-sij(il,i,j))*tra(il,nk(il),k)
-    ! endif
+    ! END IF
     ! enddo
     ! enddo
@@ -1571,5 +1571,5 @@
     DO il = 1, ncum
       IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (nent(il, i)==0)) THEN
-        ! @      IF(nent(il,i).eq.0)THEN
+        ! @      IF(nent(il,i).EQ.0)THEN
         ment(il, i, i) = m(il, i)
         qent(il, i, i) = rr(il, nk(il)) - ep(il, i) * clw(il, i)
@@ -1586,7 +1586,7 @@
   ! do i=minorig+1,nl
   ! do il=1,ncum
-  ! if (i.ge.icb(il) .and. i.le.inb(il) .and. nent(il,i).eq.0) THEN
+  ! if (i.ge.icb(il) .AND. i.le.inb(il) .AND. nent(il,i).EQ.0) THEN
   ! traent(il,i,i,j)=tra(il,nk(il),j)
-  ! endif
+  ! END IF
   ! enddo
   ! enddo
@@ -1759,8 +1759,8 @@
     ! do j=1,ntra
     ! do il=1,ncum
-    ! if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
-    ! :     .and. csum(il,i).lt.m(il,i) ) THEN
+    ! if ( i.ge.icb(il) .AND. i.le.inb(il) .AND. lwork(il)
+    ! :     .AND. csum(il,i).lt.m(il,i) ) THEN
     ! traent(il,i,i,j)=tra(il,nk(il),j)
-    ! endif
+    ! END IF
     ! enddo
     ! enddo
@@ -2094,5 +2094,5 @@
           END IF
 
-        END IF ! i.eq.1
+        END IF ! i.EQ.1
 
         ! ***       find mixing ratio of precipitating downdraft     ***
@@ -2373,5 +2373,5 @@
   ! :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
   ! :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
-  ! endif
+  ! END IF
   ! enddo
   ! enddo
@@ -2409,7 +2409,7 @@
   ! ftra(il,1,k)=ftra(il,1,k)+0.1*work(il)*ment(il,j,1)
   ! :                *(traent(il,j,1,k)-tra(il,1,k))
-  ! endif
-
-  ! endif
+  ! END IF
+
+  ! END IF
   ! enddo
   ! enddo
@@ -2531,6 +2531,6 @@
     ! :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
     ! :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
-    ! endif
-    ! endif
+    ! END IF
+    ! END IF
     ! enddo
     ! enddo
@@ -2580,6 +2580,6 @@
     ! ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
     ! :        *(traent(il,k,i,j)-tra(il,i,j))
-    ! endif
-    ! endif
+    ! END IF
+    ! END IF
     ! enddo
     ! enddo
@@ -2614,5 +2614,5 @@
     ! do k=i,nl+1
     ! do il=1,ncum
-    ! if (i.le.inb(il) .and. k.le.inb(il)) THEN
+    ! if (i.le.inb(il) .AND. k.le.inb(il)) THEN
     ! dpinv=1.0/(ph(il,i)-ph(il,i+1))
     ! cpinv=1.0/cpn(il,i)
@@ -2623,6 +2623,6 @@
     ! ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
     ! :             *(traent(il,k,i,j)-tra(il,i,j))
-    ! endif
-    ! endif ! i and k
+    ! END IF
+    ! END IF ! i and k
     ! enddo
     ! enddo
@@ -2698,6 +2698,6 @@
     ! :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
     ! :     -mp(il,i)*(trap(il,i,j)-tra(il,i-1,j)))
-    ! endif
-    ! endif ! i
+    ! END IF
+    ! END IF ! i
     ! enddo
     ! enddo
@@ -2844,5 +2844,5 @@
     DO k = i, nl
       DO il = 1, ncum
-        ! test         if (i.ge.icb(il).and.i.le.inb(il).and.k.le.inb(il))
+        ! test         if (i.ge.icb(il).AND.i.le.inb(il).AND.k.le.inb(il))
         ! THEN
         IF (i<=inb(il) .AND. k<=inb(il)) THEN
@@ -3259,17 +3259,17 @@
 
   ! inputs:
-  integer ncum, nd, nloc
-  integer icb(nloc), inb(nloc)
-  real cape(nloc)
-  real clw(nloc, nd), lv(nloc, nd), t(nloc, nd), h(nloc, nd)
-  integer nk(nloc)
+  INTEGER ncum, nd, nloc
+  INTEGER icb(nloc), inb(nloc)
+  REAL cape(nloc)
+  REAL clw(nloc, nd), lv(nloc, nd), t(nloc, nd), h(nloc, nd)
+  INTEGER nk(nloc)
   ! inouts:
-  real ep(nloc, nd)
-  real hp(nloc, nd)
+  REAL ep(nloc, nd)
+  REAL hp(nloc, nd)
   ! outputs ou local
-  real epmax_diag(nloc)
+  REAL epmax_diag(nloc)
   ! locals
-  integer i, k
-  real hp_bak(nloc, nd)
+  INTEGER i, k
+  REAL hp_bak(nloc, nd)
   CHARACTER (LEN = 20) :: modname = 'cv30_epmax_fn_cape'
   CHARACTER (LEN = 80) :: abort_message
@@ -3277,5 +3277,5 @@
   ! on recalcule ep et hp
 
-  if (coef_epmax_cape>1e-12) THEN
+  IF (coef_epmax_cape>1e-12) THEN
     do i = 1, ncum
       epmax_diag(i) = epmax - coef_epmax_cape * sqrt(cape(i))
@@ -3300,5 +3300,5 @@
     do k = minorig + 1, nl
       do i = 1, ncum
-        if((k>=icb(i)).and.(k<=inb(i)))THEN
+        IF((k>=icb(i)).AND.(k<=inb(i)))THEN
           hp(i, k) = h(i, nk(i)) + (lv(i, k) + (cpd - cpv) * t(i, k)) * ep(i, k) * clw(i, k)
         endif
@@ -3308,5 +3308,5 @@
     do i = 1, ncum
       do k = 1, nl
-        if (abs(hp_bak(i, k) - hp(i, k))>0.01) THEN
+        IF (abs(hp_bak(i, k) - hp(i, k))>0.01) THEN
           WRITE(*, *) 'i,k=', i, k
           WRITE(*, *) 'coef_epmax_cape=', coef_epmax_cape
@@ -3326,5 +3326,5 @@
       enddo !do k=1,nl
     enddo !do i=1,ncum
-  endif !if (coef_epmax_cape.gt.1e-12) THEN
+  ENDIF !if (coef_epmax_cape.gt.1e-12) THEN
 END SUBROUTINE  cv30_epmax_fn_cape
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv30param.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv30param.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv30param.h	(revision 5117)
@@ -10,13 +10,13 @@
 !------------------------------------------------------------
 
-      integer noff, minorig, nl, nlp, nlm
-      real sigd, spfac
+      INTEGER noff, minorig, nl, nlp, nlm
+      REAL sigd, spfac
 !IM cf. FH : pour compatibilite avec conema3 TEMPORAIRE   real pbcrit, ptcrit, epmax
-      real pbcrit, ptcrit
-      real omtrain
-      real dtovsh, dpbase, dttrig
-      real dtcrit, tau, beta, alpha
-      real delta
-      real betad
+      REAL pbcrit, ptcrit
+      REAL omtrain
+      REAL dtovsh, dpbase, dttrig
+      REAL dtcrit, tau, beta, alpha
+      REAL delta
+      REAL betad
 
       COMMON /cv30param/  sigd, spfac &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_inicp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_inicp.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_inicp.F90	(revision 5117)
@@ -68,5 +68,5 @@
   ! read(57,*)
   ! read(57,*) alphas
-  ! endif
+  ! END IF
   ! close(57)
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_routines.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_routines.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_routines.F90	(revision 5117)
@@ -8,5 +8,5 @@
 
   USE lmdz_ioipsl_getin_p, ONLY: getin_p
-  use lmdz_phys_para
+  USE lmdz_phys_para
   IMPLICIT NONE
 
@@ -554,5 +554,5 @@
 !@      do 290 k=minorig,nl
 !@        do 280 i=1,len
-!@          if((k.ge.(nk(i)+1)).and.(p(i,k).lt.plcl(i)))
+!@          if((k.ge.(nk(i)+1)).AND.(p(i,k).lt.plcl(i)))
 !@     &    icb(i)=min(icb(i),k)
 !@ 280    continue
@@ -560,5 +560,5 @@
 !@c
 !@      do 300 i=1,len
-!@        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
+!@        if((icb(i).ge.nlm).AND.(iflag(i).EQ.0))iflag(i)=9
 !@ 300  continue
 
@@ -582,5 +582,5 @@
 
   DO i = 1, len
-!@        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
+!@        if((icb(i).ge.nlm).AND.(iflag(i).EQ.0))iflag(i)=9
     IF ((icb(i)==nlm) .AND. (iflag(i)==0)) iflag(i) = 9
   END DO
@@ -942,5 +942,5 @@
 ! oct3       ath  = th(i,icb(i)-1) - dttrig
 ! oct3
-! oct3       if (tdif.lt.dtcrit .or. ath.gt.ath1) THEN
+! oct3       if (tdif.lt.dtcrit .OR. ath.gt.ath1) THEN
 ! oct3         do 60 k=1,nl
 ! oct3            sig(i,k) = beta*sig(i,k) - 2.*alpha*tdif*tdif
@@ -1063,5 +1063,5 @@
 !AC!       nn=0
 !AC!      do 101 i=1,len
-!AC!      IF(iflag1(i).eq.0)THEN
+!AC!      IF(iflag1(i).EQ.0)THEN
 !AC!       nn=nn+1
 !AC!       tra(nn,k,j)=tra1(i,k,j)
@@ -1874,5 +1874,5 @@
 !  ENDDO
 
-  endif
+  ENDIF
 
 ! -- end convect3
@@ -1947,5 +1947,5 @@
 ! ori        do 520 i=1,ncum
 ! ori          IF(cape(i).lt.0.0)lcape(i)=.FALSE.
-! ori          if((k.ge.(icb(i)+1)).and.lcape(i))THEN
+! ori          if((k.ge.(icb(i)+1)).AND.lcape(i))THEN
 ! ori            by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
 ! ori            byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
@@ -2230,5 +2230,5 @@
 ! c      do k= 1,nl
 ! c       do i = 1,ncum
-! c        IF (k .ge. icb(i) .and. k .le. inb(i)) THEN
+! c        IF (k .ge. icb(i) .AND. k .le. inb(i)) THEN
 ! c         cbmflast(i) = cbmflast(i)+M(i,k)
 ! c        ENDIF
@@ -2446,6 +2446,6 @@
 !AC!        do j=minorig,nl
 !AC!         do il=1,ncum
-!AC!          IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
-!AC!     :       (j.ge.(icb(il)-1)).and.(j.le.inb(il)))THEN
+!AC!          IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND.
+!AC!     :       (j.ge.(icb(il)-1)).AND.(j.le.inb(il)))THEN
 !AC!            traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
 !AC!     :            +(1.-sij(il,i,j))*tra(il,nk(il),k)
@@ -2464,5 +2464,5 @@
     DO il = 1, ncum
       IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (nent(il,i)==0)) THEN
-! @      IF(nent(il,i).eq.0)THEN
+! @      IF(nent(il,i).EQ.0)THEN
         ment(il, i, i) = m(il, i)
         qent(il, i, i) = qnk(il) - ep(il, i)*clw(il, i)
@@ -2479,5 +2479,5 @@
 !AC!       do i=minorig+1,nl
 !AC!        do il=1,ncum
-!AC!         if (i.ge.icb(il) .and. i.le.inb(il) .and. nent(il,i).eq.0) THEN
+!AC!         if (i.ge.icb(il) .AND. i.le.inb(il) .AND. nent(il,i).EQ.0) THEN
 !AC!          traent(il,i,i,j)=tra(il,nk(il),j)
 !AC!         endif
@@ -2662,6 +2662,6 @@
 !AC!      do j=1,ntra
 !AC!       do il=1,ncum
-!AC!        if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
-!AC!     :     .and. csum(il,i).lt.m(il,i) ) THEN
+!AC!        if ( i.ge.icb(il) .AND. i.le.inb(il) .AND. lwork(il)
+!AC!     :     .AND. csum(il,i).lt.m(il,i) ) THEN
 !AC!         traent(il,i,i,j)=tra(il,nk(il),j)
 !AC!        endif
@@ -3108,5 +3108,5 @@
 !JYG----   Correction : si c6 <= 0, water(il,i)=0.
 ! prec(il,i)=0.
-! endif
+! END IF
 
 !JYG---   Dans tous les cas, evaporation = [tt ce qui entre dans la couche i]
@@ -3181,5 +3181,5 @@
 
         END IF
-      END IF !(i.le.inb(il) .and. lwork(il))
+      END IF !(i.le.inb(il) .AND. lwork(il))
     END DO
 ! ----------------------------------------------------------------
@@ -3222,5 +3222,5 @@
         END IF
 
-      END IF !(i.le.inb(il) .and. lwork(il) .and. i.ne.1)
+      END IF !(i.le.inb(il) .AND. lwork(il) .AND. i.NE.1)
       IF (prt_level >= 20) THEN
         PRINT *,'cv3_unsat, mp hydrostatic ', i, mp(il,i)
@@ -3343,5 +3343,5 @@
 !>jyg
 
-      END IF ! (i.le.inb(il) .and. lwork(il) .and. i.ne.1)
+      END IF ! (i.le.inb(il) .AND. lwork(il) .AND. i.NE.1)
     END DO
 ! ----------------------------------------------------------------
@@ -3357,5 +3357,5 @@
       IF (i<inb(il) .AND. lwork(il)) THEN
         mplus(il) = mp(il, i) > mp(il, i+1)
-      END IF ! (i.lt.inb(il) .and. lwork(il))
+      END IF ! (i.lt.inb(il) .AND. lwork(il))
     END DO
 
@@ -3393,10 +3393,10 @@
             vp(il, i) = vp(il, i+1)
           END IF ! (mp(il,i+1).gt.1.0e-16)
-        END IF ! (mplus(il)) else if (.not.mplus(il))
+        END IF ! (mplus(il)) ELSE IF (.NOT.mplus(il))
 
         rp(il, i) = amin1(rp(il,i), rs(il,i))
         rp(il, i) = max(rp(il,i), 0.0)
 
-      END IF ! (i.lt.inb(il) .and. lwork(il))
+      END IF ! (i.lt.inb(il) .AND. lwork(il))
     END DO
 ! ----------------------------------------------------------------
@@ -3406,5 +3406,5 @@
 !AC!      do j=1,ntra
 !AC!       do il = 1,ncum
-!AC!       if (i.lt.inb(il) .and. lwork(il)) THEN
+!AC!       if (i.lt.inb(il) .AND. lwork(il)) THEN
 !AC!c
 !AC!         IF(mplus(il))THEN
@@ -3416,7 +3416,7 @@
 !AC!           trap(il,i,j)=trap(il,i+1,j)
 !AC!          endif
-!AC!         endif ! (mplus(il)) else if (.not.mplus(il))
+!AC!         endif ! (mplus(il)) ELSE IF (.NOT.mplus(il))
 !AC!c
-!AC!        endif ! (i.lt.inb(il) .and. lwork(il))
+!AC!        endif ! (i.lt.inb(il) .AND. lwork(il))
 !AC!       enddo
 !AC!      END DO
@@ -3822,5 +3822,5 @@
 !AC!       do j=2,nl
 !AC!        do il=1,ncum
-!AC!         if (j.le.inb(il) .and. iflag(il) .le. 1) THEN
+!AC!         if (j.le.inb(il) .AND. iflag(il) .le. 1) THEN
 !AC!
 !AC!          if (cvflag_grav) THEN
@@ -4170,5 +4170,5 @@
 !AC!      do k=1,ntra
 !AC!       do il=1,ncum
-!AC!        if (i.le.inb(il) .and. iflag(il) .le. 1) THEN
+!AC!        if (i.le.inb(il) .AND. iflag(il) .le. 1) THEN
 !AC!         dpinv=1.0/(ph(il,i)-ph(il,i+1))
 !AC!         cpinv=1.0/cpn(il,i)
@@ -4228,5 +4228,5 @@
 !AC!       do k=1,i-1
 !AC!        do il=1,ncum
-!AC!         if (i.le.inb(il) .and. iflag(il) .le. 1) THEN
+!AC!         if (i.le.inb(il) .AND. iflag(il) .le. 1) THEN
 !AC!          dpinv=1.0/(ph(il,i)-ph(il,i+1))
 !AC!          cpinv=1.0/cpn(il,i)
@@ -4276,6 +4276,6 @@
 !AC!       do k=i,nl+1
 !AC!        do il=1,ncum
-!AC!         if (i.le.inb(il) .and. k.le.inb(il)
-!AC!     $                .and. iflag(il) .le. 1) THEN
+!AC!         if (i.le.inb(il) .AND. k.le.inb(il)
+!AC!     $                .AND. iflag(il) .le. 1) THEN
 !AC!          dpinv=1.0/(ph(il,i)-ph(il,i+1))
 !AC!          cpinv=1.0/cpn(il,i)
@@ -4345,5 +4345,5 @@
 !AC!      do j=1,ntra
 !AC!       do il=1,ncum
-!AC!        if (i.le.inb(il) .and. iflag(il) .le. 1) THEN
+!AC!        if (i.le.inb(il) .AND. iflag(il) .le. 1) THEN
 !AC!         dpinv=1.0/(ph(il,i)-ph(il,i+1))
 !AC!         cpinv=1.0/cpn(il,i)
@@ -4726,5 +4726,5 @@
     DO k = i, nl
       DO il = 1, ncum
-! test         if (i.ge.icb(il).and.i.le.inb(il).and.k.le.inb(il)) THEN
+! test         if (i.ge.icb(il).AND.i.le.inb(il).AND.k.le.inb(il)) THEN
         IF (i<=inb(il) .AND. k<=inb(il)) THEN
           upwd(il, i) = upwd(il, i) + up1(il, k, i)
@@ -4989,5 +4989,5 @@
       DO i = 1, ncum
         IF (k>=icb(i) .AND. k<=inb(i) .AND. & 
-!!jyg              j.ge.k.and.j.le.inb(i)) THEN
+!!jyg              j.ge.k.AND.j.le.inb(i)) THEN
 !!jyg             epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/elij(i,k,j)
             j>k .AND. j<=inb(i)) THEN
@@ -5159,14 +5159,14 @@
 
 ! local
-      integer i,k    
+      INTEGER i,k
 !      real hp_bak(nloc,nd)
 !      real ep_bak(nloc,nd)
-      real m_loc(nloc,nd)
-      real sig_loc(nloc,nd)
-      real w0_loc(nloc,nd)
-      integer iflag_loc(nloc)
-      real cape(nloc)
+      REAL m_loc(nloc,nd)
+      REAL sig_loc(nloc,nd)
+      REAL w0_loc(nloc,nd)
+      INTEGER iflag_loc(nloc)
+      REAL cape(nloc)
         
-        if (coef_epmax_cape>1e-12) THEN
+        IF (coef_epmax_cape>1e-12) THEN
         ! il faut calculer la cape: on fait un calcule simple car tant qu'on ne
         ! connait pas ep, on ne connait pas les mélanges, ddfts etc... qui sont
@@ -5221,5 +5221,5 @@
       do k=minorig+1,nl
        do i=1,ncum
-        if((k>=icb(i)).and.(k<=inb(i)))THEN
+        IF((k>=icb(i)).AND.(k<=inb(i)))THEN
           hp(i, k) = hnk(i) + (lv(i,k)+(cpd-cpv)*t(i,k)+frac(i,k)*lf(i,k))* &
                               ep(i, k)*clw(i, k)
@@ -5241,6 +5241,6 @@
 !      do i=1,ncum  
 !       do k=1,nl
-!        if ((abs(hp_bak(i,k)-hp(i,k))/hp_bak(i,k).gt.1e-1).or. &
-!            ((abs(hp_bak(i,k)-hp(i,k))/hp_bak(i,k).gt.1e-4).and. &
+!        if ((abs(hp_bak(i,k)-hp(i,k))/hp_bak(i,k).gt.1e-1).OR. &
+!            ((abs(hp_bak(i,k)-hp(i,k))/hp_bak(i,k).gt.1e-4).AND. &
 !            (ep(i,k)-ep_bak(i,k).lt.1e-4))) THEN
 !           WRITE(*,*) 'i,k=',i,k
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv3a_compress.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv3a_compress.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv3a_compress.F90	(revision 5117)
@@ -143,5 +143,5 @@
   ! AC!       nn=0
   ! AC!      do 101 i=1,len
-  ! AC!      IF(iflag1(i).eq.0)THEN
+  ! AC!      IF(iflag1(i).EQ.0)THEN
   ! AC!       nn=nn+1
   ! AC!       tra(nn,k,j)=tra1(i,k,j)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p1_closure.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p1_closure.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p1_closure.F90	(revision 5117)
@@ -513,6 +513,6 @@
   DO k = 1, nl
     DO il = 1, ncum
-      ! old       IF (k .ge. icb(il) .and. k .le. inb(il)) THEN
-      ! IM        IF (k .ge. icb(il)+1 .and. k .le. inb(il)) THEN
+      ! old       IF (k .ge. icb(il) .AND. k .le. inb(il)) THEN
+      ! IM        IF (k .ge. icb(il)+1 .AND. k .le. inb(il)) THEN
       IF (k>=icb(il) .AND. k<=inb(il) & !cor jyg
           .AND. icb(il)+1<=inb(il)) THEN !cor jyg
@@ -556,5 +556,5 @@
   DO k=1,nl
      DO il=1,ncum
-        if ((plfc(il)<ph(il,k)).and.(plfc(il)>=ph(il,k+1))) THEN
+        IF ((plfc(il)<ph(il,k)).AND.(plfc(il)>=ph(il,k+1))) THEN
            klfc(il)=k
         endif
@@ -569,5 +569,5 @@
 !CR: Add large-scale component to the mass-flux
 !encore connu sous le nom "Experience du tube de dentifrice"
-    if ((coef_clos_ls>0.).and.(plfc(il)>0.)) THEN
+    IF ((coef_clos_ls>0.).AND.(plfc(il)>0.)) THEN
        cbmf1(il) = cbmf1(il) - coef_clos_ls*min(0.,1./RG*omega(il,klfc(il)))
     endif
@@ -589,5 +589,5 @@
       ! else
       ! cbmf(il) = cbmf1(il)
-      ! endif
+      ! END IF
       ! PRINT*,'cbmf',cbmf1(il),cbmfmax(il)
     END IF
@@ -724,5 +724,5 @@
     DO il = 1, ncum
       IF (k>=icb(il) .AND. k<=inb(il)) THEN
-          !IMpropo??      IF ((k.ge.(icb(il)+1)).and.(k.le.inb(il))) THEN
+          !IMpropo??      IF ((k.ge.(icb(il)+1)).AND.(k.le.inb(il))) THEN
         cbmflast(il) = cbmflast(il) + m(il, k)
       END IF
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p2_closure.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p2_closure.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p2_closure.F90	(revision 5117)
@@ -584,6 +584,6 @@
   DO k = 1, nl
     DO il = 1, ncum
-      ! old       IF (k .ge. icb(il) .and. k .le. inb(il)) THEN
-      ! IM        IF (k .ge. icb(il)+1 .and. k .le. inb(il)) THEN
+      ! old       IF (k .ge. icb(il) .AND. k .le. inb(il)) THEN
+      ! IM        IF (k .ge. icb(il)+1 .AND. k .le. inb(il)) THEN
       IF (k>=icb(il) .AND. k<=inb(il) & !cor jyg
           .AND. icb(il)+1<=inb(il)) THEN !cor jyg
@@ -625,5 +625,5 @@
   DO k=1,nl
      DO il=1,ncum
-        if ((plfc(il)<ph(il,k)).and.(plfc(il)>=ph(il,k+1))) THEN
+        IF ((plfc(il)<ph(il,k)).AND.(plfc(il)>=ph(il,k+1))) THEN
            klfc(il)=k
         endif
@@ -638,5 +638,5 @@
 !CR: Add large-scale component to the mass-flux
 !encore connu sous le nom "Experience du tube de dentifrice"
-    if ((coef_clos_ls>0.).and.(plfc(il)>0.)) THEN
+    IF ((coef_clos_ls>0.).AND.(plfc(il)>0.)) THEN
        cbmfalp(il) = cbmfalp(il) - coef_clos_ls*min(0.,1./RG*omega(il,klfc(il)))
     endif
@@ -668,5 +668,5 @@
       ! else
       ! cbmfalpb(il) = cbmfalp(il)
-      ! endif
+      ! END IF
       ! PRINT*,'cbmfalpb',cbmfalp(il),cbmfmax(il)
     END IF
@@ -804,5 +804,5 @@
     DO il = 1, ncum
       IF (k>=icb(il) .AND. k<=inb(il)) THEN
-          !IMpropo??      IF ((k.ge.(icb(il)+1)).and.(k.le.inb(il))) THEN
+          !IMpropo??      IF ((k.ge.(icb(il)+1)).AND.(k.le.inb(il))) THEN
         cbmflast(il) = cbmflast(il) + m(il, k)
       END IF
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p_mixing.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p_mixing.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p_mixing.F90	(revision 5117)
@@ -251,5 +251,5 @@
     DO il = 1, ncum
       IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (nent(il,i)==0)) THEN
-! @      IF(nent(il,i).eq.0)THEN
+! @      IF(nent(il,i).EQ.0)THEN
 !!!       Ment(il,i,i)=m(il,i)
         Ment(il, i, i) = 1.
@@ -522,5 +522,5 @@
     cpm = cpd+Qent(il,i,j)*(cpv-cpd)
 
-    IF (cvflag_ice .and. frac(il,j) > 0.) THEN
+    IF (cvflag_ice .AND. frac(il,j) > 0.) THEN
             elij(il, i, j) = Qent(il, i, j) - rs(il, j)
             elij(il, i, j) = elij(il, i, j) + &
@@ -557,5 +557,5 @@
 !            hent(il, i, j) = hent(il, i, j) + (lv(il,j)+(cpd-cpv)*t(il,j))*awat
 ! Mixed draught temperature at level j
-    IF (cvflag_ice .and. frac(il,j) > 0.) THEN
+    IF (cvflag_ice .AND. frac(il,j) > 0.) THEN
           Tm = t(il,j) + (Qent(il,i,j)-elij(il,i,j)-rs(il,j))*rrv*t(il,j)*t(il,j)/(lv(il,j)*rs(il,j))
           hent(il, i, j) = hent(il, i, j) + (lv(il,j)+frac(il,j)*lf(il,j)+(cpd-cpv)*Tm)*awat
@@ -665,5 +665,5 @@
     DO il = 1, ncum
       IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. csum(il,i)<1.) THEN
-! cc     :     .and. csum(il,i).lt.m(il,i) ) THEN
+! cc     :     .AND. csum(il,i).lt.m(il,i) ) THEN
         nent(il, i) = 0
 ! cc        Ment(il,i,i)=m(il,i)
@@ -686,5 +686,5 @@
 !jyg!      DO il = 1, ncum
 !jyg!        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. csum(il,i)<1.) THEN
-!jyg!! cc     :     .and. csum(il,i).lt.m(il,i) ) THEN
+!jyg!! cc     :     .AND. csum(il,i).lt.m(il,i) ) THEN
 !jyg!          traent(il, i, i, j) = tra(il, nk(il), j)
 !jyg!        END IF
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv3param.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv3param.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv3param.h	(revision 5117)
@@ -7,22 +7,22 @@
 !------------------------------------------------------------
 
-      integer flag_epKEorig
-      real flag_wb
-      integer cv_flag_feed
-      integer noff, minorig, nl, nlp, nlm
-      real sigdz, spfac
-      real pbcrit, ptcrit
-      real elcrit, tlcrit
-      real coef_peel
-      real omtrain
-      real dtovsh, dpbase, dttrig
-      real dtcrit, tau, beta, alpha, alpha1
-      real T_top_max
-      real tau_stop, noconv_stop
-      real wbmax
-      real delta
-      real betad
-      real ejectliq
-      real ejectice
+      INTEGER flag_epKEorig
+      REAL flag_wb
+      INTEGER cv_flag_feed
+      INTEGER noff, minorig, nl, nlp, nlm
+      REAL sigdz, spfac
+      REAL pbcrit, ptcrit
+      REAL elcrit, tlcrit
+      REAL coef_peel
+      REAL omtrain
+      REAL dtovsh, dpbase, dttrig
+      REAL dtcrit, tau, beta, alpha, alpha1
+      REAL T_top_max
+      REAL tau_stop, noconv_stop
+      REAL wbmax
+      REAL delta
+      REAL betad
+      REAL ejectliq
+      REAL ejectice
 
       COMMON /cv3param/ sigdz, spfac &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv_routines.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv_routines.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv_routines.F90	(revision 5117)
@@ -592,8 +592,8 @@
         ! PRINT*,tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd
         tp(i, k) = (ah0(i)-(cl-cpd)*qnk(i)*t(i,k)-gz(i,k)-alv*qg)/cpd
-        ! if (.not.cpd.gt.1000.) THEN
+        ! if (.NOT.cpd.gt.1000.) THEN
         ! PRINT*,'CPD=',cpd
         ! stop
-        ! endif
+        ! END IF
         clw(i, k) = qnk(i) - qg
         clw(i, k) = max(0.0, clw(i,k))
@@ -671,6 +671,6 @@
   ! inb(i)=k+1
   ! capem(i)=cape(i)
-  ! endif
-  ! endif
+  ! END IF
+  ! END IF
   ! 520    continue
   ! 530  continue
@@ -698,6 +698,6 @@
   ! capem(i)=cape(i)
   ! byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-  ! endif
-  ! endif
+  ! END IF
+  ! END IF
   ! 520    continue
   ! 530  continue
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cva_driver.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cva_driver.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cva_driver.F90	(revision 5117)
@@ -691,5 +691,5 @@
     END IF
 ! PRINT*,'t1, q1 ',t1,q1
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_prelim'
     CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, &           ! nd->na
@@ -697,5 +697,5 @@
 
 
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_prelim'
     CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, & ! nd->na
@@ -707,5 +707,5 @@
   IF (iflag_con==4) THEN
     PRINT *, 'Emanuel version 4 '
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_prelim'
     CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
@@ -752,5 +752,5 @@
 ! WRITE(*,'(64i1)') iflag1(2:len-1)
 
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_feed'
     CALL cv3_feed(len, nd, ok_conserv_q, &                 ! nd->na
@@ -766,5 +766,5 @@
 
   IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_feed'
     CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, &
@@ -783,5 +783,5 @@
   IF (iflag_con==3) THEN
 
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_undilute1'
     CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1, & ! nd->na
@@ -791,5 +791,5 @@
 
   IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_undilute1'
     CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
@@ -805,5 +805,5 @@
   IF (iflag_con==3) THEN
 
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_trigger'
     CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
@@ -819,5 +819,5 @@
 
   IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_trigger'
     CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
@@ -860,5 +860,5 @@
   compress = ncum < len*comp_threshold
 
-  IF (.not. compress) THEN
+  IF (.NOT. compress) THEN
     DO i = 1,len
       idcum(i) = i
@@ -867,5 +867,5 @@
 
 !>jyg
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3a_compress'
       CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
@@ -897,5 +897,5 @@
 
     IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_compress'
       CALL cv_compress(len, nloc, ncum, nd, &
@@ -921,5 +921,5 @@
 
     IF (iflag_con==3) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_undilute2'
       CALL cv3_undilute2(nloc, ncum, nd, iflag, icb, icbs, nk, &        !na->nd
@@ -931,5 +931,5 @@
 
     IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_undilute2'
       CALL cv_undilute2(nloc, ncum, nd, icb, nk, &
@@ -941,5 +941,5 @@
     ! epmax_cape
     ! on recalcule ep et hp    
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_epmax_cape'
     CALL cv3_epmax_fn_cape(nloc,ncum,nd &
@@ -959,5 +959,5 @@
       IF (iflag_mix>=1) THEN
         CALL zilch(supmax, nloc*nd)
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3p_mixing'
         CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &           ! na->nd
@@ -980,5 +980,5 @@
     IF (iflag_con==3) THEN
       IF (iflag_clos==0) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_closure'
         CALL cv3_closure(nloc, ncum, nd, icb, inb, &           ! na->nd
@@ -998,5 +998,5 @@
 
       IF (iflag_clos==2) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3p1_closure'
         CALL cv3p1_closure(nloc, ncum, nd, icb, inb, &         ! na->nd
@@ -1006,10 +1006,10 @@
                            Plim1, plim2, asupmax, supmax0, &
                            asupmaxmin, cbmf, plfc, wbeff)
-        if (prt_level >= 10) &
+        IF (prt_level >= 10) &
              PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
       END IF   ! iflag_clos==2
 
       IF (iflag_clos==3) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3p2_closure'
         CALL cv3p2_closure(nloc, ncum, nd, icb, inb, &         ! na->nd
@@ -1019,5 +1019,5 @@
                            Plim1, plim2, asupmax, supmax0, &
                            asupmaxmin, cbmf, plfc, wbeff)
-        if (prt_level >= 10) &
+        IF (prt_level >= 10) &
              PRINT *, 'cv3p2_closure-> plfc,wbeff ', plfc(1), wbeff(1)
       END IF   ! iflag_clos==3
@@ -1025,5 +1025,5 @@
 
     IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_closure'
       CALL cv_closure(nloc, ncum, nd, nk, icb, &
@@ -1040,5 +1040,5 @@
     IF (iflag_con==3) THEN
       IF (iflag_mix==0) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_mixing'
         CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &             ! na->nd
@@ -1062,5 +1062,5 @@
 
     IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_mixing'
       CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, &
@@ -1085,5 +1085,5 @@
       END IF !(debut) THEN
 
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_unsat'
       CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, &              ! na->nd
@@ -1114,5 +1114,5 @@
 
     IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_unsat'
       CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, &
@@ -1135,5 +1135,5 @@
     IF (iflag_con==3) THEN
 
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_yield'
       CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, &                      ! na->nd
@@ -1169,5 +1169,5 @@
 
     IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_yield'
       CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, &
@@ -1189,5 +1189,5 @@
     IF (iflag_con==3) THEN
 !RomP >>>
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_tracer'
       CALL cv3_tracer(nloc, len, ncum, nd, nd, &
@@ -1206,5 +1206,5 @@
 
     IF (iflag_con==3) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3a_uncompress'
       CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
@@ -1246,5 +1246,5 @@
 
     IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_uncompress'
       CALL cv_uncompress(nloc, len, ncum, nd, idcum, &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cvflag.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cvflag.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cvflag.h	(revision 5117)
@@ -2,16 +2,16 @@
 ! $Header$
 
-      logical cvflag_grav
-      logical cvflag_ice
-      logical ok_optim_yield
-      logical ok_entrain
-      logical ok_homo_tend
-      logical ok_convstop
-      logical ok_intermittent
-      logical cvflag_prec_eject
-      logical qsat_depends_on_qt
-      logical adiab_ascent_mass_flux_depends_on_ejectliq
-      logical keepbug_ice_frac
-      integer icvflag_Tpa
+      LOGICAL cvflag_grav
+      LOGICAL cvflag_ice
+      LOGICAL ok_optim_yield
+      LOGICAL ok_entrain
+      LOGICAL ok_homo_tend
+      LOGICAL ok_convstop
+      LOGICAL ok_intermittent
+      LOGICAL cvflag_prec_eject
+      LOGICAL qsat_depends_on_qt
+      LOGICAL adiab_ascent_mass_flux_depends_on_ejectliq
+      LOGICAL keepbug_ice_frac
+      INTEGER icvflag_Tpa
 
       COMMON /cvflag/ icvflag_Tpa, &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr.F90	(revision 5117)
@@ -141,5 +141,5 @@
 !   ccntrENV_coef    = 0.
 !   coefcoli         = 0.
-!  endif
+!  ENDIF
 
 ! ======================================================
@@ -258,5 +258,5 @@
    DO i = 1,klon
      NO_precip(i,j) = (pmflxr(i,j+1)+pmflxs(i,j+1))<1.e-10&
-                    .and.Pa(i,j)<1.e-10.and.Pm(i,j)<1.e-10
+                    .AND.Pa(i,j)<1.e-10.AND.Pm(i,j)<1.e-10
    END DO
   END DO
@@ -397,5 +397,5 @@
   DO j=1,klev
      DO i=1,klon
-        IF(j>=icb(i).and.j<=inb(i)) THEN
+        IF(j>=icb(i).AND.j<=inb(i)) THEN
           IF(clw(i,j)>1.e-16) THEN
            qPa(i,j,it)=ccntrAA_coef*tr(i,1,it)/clw(i,j)
@@ -413,5 +413,5 @@
       DO k=1,j-1
         DO i=1,klon
-        IF(k>=icb(i).and.k<=inb(i).and.&
+        IF(k>=icb(i).AND.k<=inb(i).AND.&
            j<=inb(i)) THEN
             IF(elij(i,k,j)>1.e-16) THEN
@@ -442,10 +442,10 @@
    DO j=klev-1,1,-1
     DO i=1,klon
-     IF(mp(i,j+1)>mp(i,j).and.mp(i,j+1)>1.e-10) then  ! detrainement
+     IF(mp(i,j+1)>mp(i,j).AND.mp(i,j+1)>1.e-10) then  ! detrainement
        kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
                 (-mp(i,j+1)-imp(i,j)/RG*dxpres(i,j))&
                 + (imp(i,j)/RG*dxpres(i,j))*(evap(i,j)/RG*dxpres(i,j)))
              
-     elseif(mp(i,j)>mp(i,j+1).and.mp(i,j)>1.e-10) then! entrainement
+     elseif(mp(i,j)>mp(i,j+1).AND.mp(i,j)>1.e-10) then! entrainement
        IF(j==1) THEN
         kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
@@ -465,11 +465,11 @@
   DO j=klev-1,1,-1
    DO i=1,klon
-    if (abs(kappa(i,j))<1.e-25) then    !si denominateur nul (il peut y avoir des mp!=0)
+    IF (abs(kappa(i,j))<1.e-25) then    !si denominateur nul (il peut y avoir des mp!=0)
      kappa(i,j)=1.
      IF(j==1) THEN
        qDi(i,j,it)=qDi(i,j+1,it) !orig tr(i,j,it)   ! mp(1)=0 donc tout vient de la couche supérieure
-     elseif(mp(i,j+1)>mp(i,j).and.mp(i,j+1)>1.e-10) THEN
+     elseif(mp(i,j+1)>mp(i,j).AND.mp(i,j+1)>1.e-10) THEN
        qDi(i,j,it)=qDi(i,j+1,it)
-     elseif(mp(i,j)>mp(i,j+1).and.mp(i,j)>1.e-10) then! entrainement
+     elseif(mp(i,j)>mp(i,j+1).AND.mp(i,j)>1.e-10) then! entrainement
        qDi(i,j,it)=(-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it))/(-mp(i,j))
      else  ! si  mp (i)=0 et mp(j+1)=0
@@ -527,8 +527,8 @@
       endif  !mp(2) nul ou non
 
-! vvv  (j!=1.and.j.lt.inb(i))  en-dessous du sommet nuage   vvv
+! vvv  (j!=1.AND.j.lt.inb(i))  en-dessous du sommet nuage   vvv
      else 
 !------------------------------------------------------------- detrainement 
-      IF(mp(i,j+1)>mp(i,j).and.mp(i,j+1)>1.e-10) then !mp(i,j).gt.1.e-10) THEN
+      IF(mp(i,j+1)>mp(i,j).AND.mp(i,j+1)>1.e-10) then !mp(i,j).gt.1.e-10) THEN
          IF(NO_precip(i,j)) THEN
           qDi(i,j,it)=qDi(i,j+1,it)
@@ -548,5 +548,5 @@
          endif !precip
 !------------------------------------------------------------- entrainement 
-      elseif(mp(i,j)>mp(i,j+1).and.mp(i,j)>1.e-10) THEN
+      elseif(mp(i,j)>mp(i,j+1).AND.mp(i,j)>1.e-10) THEN
          IF(NO_precip(i,j)) THEN
           qDi(i,j,it)=(-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it))/(-mp(i,j))
@@ -566,5 +566,5 @@
             (imp(i,j)/RG*dxpres(i,j)))
          endif !precip
-!------------------------------------------------------------- endif ! ent/det
+!------------------------------------------------------------- END IF ! ent/det
       else  !mp nul
         qDi(i,j,it)=tr(i,j,it) ! orig 0.
@@ -586,5 +586,5 @@
 !  DO j=klev,1,-1
 !   DO i=1,klon
-!     IF(it.eq.3) THEN
+!     IF(it.EQ.3) THEN
 !   WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)') j,&
 !!         'zmfdam',zmfdam(i,j,it),'zmfpsi',zmfphi2(i,j,it),&
@@ -614,19 +614,19 @@
                -zmfdam(i,k,it)*ccntrAA_coef
 ! lessivage courants insatures
-   IF(k<=inb(i).and.k>1) then   ! tendances dans le nuage
+   IF(k<=inb(i).AND.k>1) then   ! tendances dans le nuage
 !------------------------------------------------------------- detrainement
-      IF(mp(i,k+1)>mp(i,k).and.mp(i,k+1)>1.e-10) THEN
+      IF(mp(i,k+1)>mp(i,k).AND.mp(i,k+1)>1.e-10) THEN
         uscavtrac= (-mp(i,k)+mp(i,k+1))*(qDi(i,k,it)-tr(i,k,it))&
                    + mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))
 
-!        IF(it.eq.3) WRITE(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' det incloud',&
+!        IF(it.EQ.3) WRITE(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' det incloud',&
 !                    (-mp(i,k)+mp(i,k+1))*(qDi(i,k,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k)+&
 !                    mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k),&
 !                    'mp',mp(i,k)
 !------------------------------------------------------------- entrainement 
-      elseif(mp(i,k)>mp(i,k+1).and.mp(i,k)>1.e-10) THEN
+      elseif(mp(i,k)>mp(i,k+1).AND.mp(i,k)>1.e-10) THEN
          uscavtrac= mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))
 
-!         IF(it.eq.3) WRITE(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
+!         IF(it.EQ.3) WRITE(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
 !=!------------------------------------------------------------- end ent/det 
       else !        mp(i,k+1)=0. et mp(i,k)=0.    pluie directement sur l environnement
@@ -634,8 +634,8 @@
         IF(NO_precip(i,k)) THEN
           uscavtrac=0.
-!         IF(it.eq.3) WRITE(*,'(I2,1X,a,e20.12,82X,a,e20.12)')k,' no P ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
+!         IF(it.EQ.3) WRITE(*,'(I2,1X,a,e20.12,82X,a,e20.12)')k,' no P ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
         else
           uscavtrac=-imp(i,k)*tr(i,k,it)*dxpres(i,k)/RG+evap(i,k)*qPr(i,k,it)*dxpres(i,k)/RG
-!         IF(it.eq.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
+!         IF(it.EQ.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
         endif
       endif  ! mp/det/ent
@@ -646,5 +646,5 @@
 !                   + mp(i,2)*(0.-tr(i,k,it))
 
-!       IF(it.eq.3) WRITE(*,'(I2,1X,a,e20.12,84X,a,e20.12)')k,' 1 det',&
+!       IF(it.EQ.3) WRITE(*,'(I2,1X,a,e20.12,84X,a,e20.12)')k,' 1 det',&
 !                  (-0.+mp(i,2))*(qDi(i,k,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k)+&
 !                  mp(i,2)*(0.-tr(i,k,it))*pdtimeRG/dxpres(i,k),&
@@ -656,5 +656,5 @@
           uscavtrac=-imp(i,k)*tr(i,k,it)*dxpres(i,k)/RG+evap(i,k)*qPr(i,k,it)*dxpres(i,k)/RG
         endif
-!         IF(it.eq.3) WRITE(*,'(I2,1X,a,2X,e20.12,82X,a,e20.12)')k,'1 P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
+!         IF(it.EQ.3) WRITE(*,'(I2,1X,a,2X,e20.12,82X,a,e20.12)')k,'1 P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
       endif
 
@@ -686,5 +686,5 @@
 !        (paprs(i,k)-paprs(i,k+1))/RG
 
-!      IF(it.eq.3)  WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)') k,&
+!      IF(it.EQ.3)  WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)') k,&
 !         'MA td ',dtrcvMA(i,k,it)*dxpres(i,k)/RG,&
 !         ' td',dtrcv(i,k,it)*dxpres(i,k)/RG,'         conservMA ',conservMA,'conserv ',conserv
@@ -692,5 +692,5 @@
 !        ENDDO
 !      ENDDO
-!       IF(it.eq.3) print *,'it',it,'conserv ',conserv,'conservMA ',conservMA
+!       IF(it.EQ.3) print *,'it',it,'conserv ',conserv,'conservMA ',conservMA
 
 END SUBROUTINE cvltr
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_noscav.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_noscav.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_noscav.F90	(revision 5117)
@@ -40,9 +40,9 @@
   REAL                            :: pdtimeRG
   REAL                            :: smallest_mp
-  real conserv
-  real smfd
-  real smfu
-  real smfa
-  real smfp
+  REAL conserv
+  REAL smfd
+  REAL smfu
+  REAL smfa
+  REAL smfp
 ! =========================================
 ! calcul des tendances liees au downdraft
@@ -88,5 +88,5 @@
      DO j=k-1,1,-1
         DO i=1,klon
-!!           IF(mp(i,j+1).ne.0) THEN
+!!           IF(mp(i,j+1).NE.0) THEN
 !!              zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1))
 !!           ENDif
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_scav.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_scav.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_scav.F90	(revision 5117)
@@ -586,5 +586,5 @@
   !  DO j=klev,1,-1
   !   DO i=1,klon
-  !     IF(it.eq.3) THEN
+  !     IF(it.EQ.3) THEN
   !   WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)') j,&
   !!         'zmfdam',zmfdam(i,j,it),'zmfpsi',zmfphi2(i,j,it),&
@@ -623,5 +623,5 @@
                    + mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))
 
-              !        IF(it.eq.3) WRITE(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' det incloud',&
+              !        IF(it.EQ.3) WRITE(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' det incloud',&
               !                    (-mp(i,k)+mp(i,k+1))*(qDi(i,k,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k)+&
               !                    mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k),&
@@ -631,5 +631,5 @@
               uscavtrac= mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))
 
-              !         IF(it.eq.3) WRITE(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
+              !         IF(it.EQ.3) WRITE(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
               !=!------------------------------------------------------------- end ent/det 
            ELSE !        mp(i,k+1)=0. et mp(i,k)=0.    pluie directement sur l environnement
@@ -637,14 +637,14 @@
               IF(NO_precip(i,k)) THEN
                  uscavtrac=0.
-                 !         IF(it.eq.3) WRITE(*,'(I2,1X,a,e20.12,82X,a,e20.12)')k,' no P ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
+                 !         IF(it.EQ.3) WRITE(*,'(I2,1X,a,e20.12,82X,a,e20.12)')k,' no P ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
               ELSE
                  uscavtrac=-imp(i,k)*tr(i,k,it)*dxpres(i,k)/RG+evap(i,k)*qPr(i,k,it)*dxpres(i,k)/RG
-                 !         IF(it.eq.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
+                 !         IF(it.EQ.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
                  !!JE adds
-                 !         IF(it.eq.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'imp',imp(i,k)
-                 !         IF(it.eq.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'tr',tr(i,k,it)
-                 !         IF(it.eq.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'evap',evap(i,k)
-                 !         IF(it.eq.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'qPr',qPr(i,k,it)
-                 !         IF(it.eq.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'dxpres',dxpres(i,k)
+                 !         IF(it.EQ.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'imp',imp(i,k)
+                 !         IF(it.EQ.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'tr',tr(i,k,it)
+                 !         IF(it.EQ.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'evap',evap(i,k)
+                 !         IF(it.EQ.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'qPr',qPr(i,k,it)
+                 !         IF(it.EQ.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'dxpres',dxpres(i,k)
                  !!Je end
 
@@ -657,5 +657,5 @@
               !                   + mp(i,2)*(0.-tr(i,k,it))
 
-              !       IF(it.eq.3) WRITE(*,'(I2,1X,a,e20.12,84X,a,e20.12)')k,' 1 det',&
+              !       IF(it.EQ.3) WRITE(*,'(I2,1X,a,e20.12,84X,a,e20.12)')k,' 1 det',&
               !                  (-0.+mp(i,2))*(qDi(i,k,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k)+&
               !                  mp(i,2)*(0.-tr(i,k,it))*pdtimeRG/dxpres(i,k),&
@@ -667,5 +667,5 @@
                  uscavtrac=-imp(i,k)*tr(i,k,it)*dxpres(i,k)/RG+evap(i,k)*qPr(i,k,it)*dxpres(i,k)/RG
               ENDIF
-              !         IF(it.eq.3) WRITE(*,'(I2,1X,a,2X,e20.12,82X,a,e20.12)')k,'1 P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
+              !         IF(it.EQ.3) WRITE(*,'(I2,1X,a,2X,e20.12,82X,a,e20.12)')k,'1 P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
            ENDIF
 
@@ -697,5 +697,5 @@
   !        (paprs(i,k)-paprs(i,k+1))/RG
 
-  !      IF(it.eq.3)  WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)') k,&
+  !      IF(it.EQ.3)  WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)') k,&
   !         'MA td ',dtrcvMA(i,k,it)*dxpres(i,k)/RG,&
   !         ' td',dtrcv(i,k,it)*dxpres(i,k)/RG,'         conservMA ',conservMA,'conserv ',conserv
@@ -703,5 +703,5 @@
   !        ENDDO
   !      ENDDO
-  !       IF(it.eq.3) print *,'it',it,'conserv ',conserv,'conservMA ',conservMA
+  !       IF(it.EQ.3) print *,'it',it,'conserv ',conserv,'conservMA ',conservMA
 
 END SUBROUTINE cvltr_scav
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_spl.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_spl.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_spl.F90	(revision 5117)
@@ -183,5 +183,5 @@
 !   ccntrENV_coef    = 0.
 !   coefcoli         = 0.
-!  endif
+!  ENDIF
 
 ! ======================================================
@@ -302,5 +302,5 @@
    DO i = 1,klon
      NO_precip(i,j) = (pmflxr(i,j+1)+pmflxs(i,j+1))<1.e-10&
-                    .and.Pa(i,j)<1.e-10.and.Pm(i,j)<1.e-10
+                    .AND.Pa(i,j)<1.e-10.AND.Pm(i,j)<1.e-10
    END DO
   END DO
@@ -526,5 +526,5 @@
   DO j=1,klev
      DO i=1,klon
-        IF(j>=icb(i).and.j<=inb(i)) THEN
+        IF(j>=icb(i).AND.j<=inb(i)) THEN
           IF(clw(i,j)>1.e-16) THEN
 !           qPa(i,j,it)=ccntrAA_coef*tr(i,1,it)/clw(i,j)
@@ -543,5 +543,5 @@
       DO k=1,j-1
         DO i=1,klon
-        IF(k>=icb(i).and.k<=inb(i).and.&
+        IF(k>=icb(i).AND.k<=inb(i).AND.&
            j<=inb(i)) THEN
             IF(elij(i,k,j)>1.e-16) THEN
@@ -575,10 +575,10 @@
    DO j=klev-1,1,-1
     DO i=1,klon
-     IF(mp(i,j+1)>mp(i,j).and.mp(i,j+1)>1.e-10) then  ! detrainement
+     IF(mp(i,j+1)>mp(i,j).AND.mp(i,j+1)>1.e-10) then  ! detrainement
        kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
                 (-mp(i,j+1)-imp(i,j)/RG*dxpres(i,j))&
                 + (imp(i,j)/RG*dxpres(i,j))*(evap(i,j)/RG*dxpres(i,j)))
              
-     elseif(mp(i,j)>mp(i,j+1).and.mp(i,j)>1.e-10) then! entrainement
+     elseif(mp(i,j)>mp(i,j+1).AND.mp(i,j)>1.e-10) then! entrainement
        IF(j==1) THEN
         kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
@@ -598,11 +598,11 @@
   DO j=klev-1,1,-1
    DO i=1,klon
-    if (abs(kappa(i,j))<1.e-25) then    !si denominateur nul (il peut y avoir des mp!=0)
+    IF (abs(kappa(i,j))<1.e-25) then    !si denominateur nul (il peut y avoir des mp!=0)
      kappa(i,j)=1.
      IF(j==1) THEN
        qDi(i,j,it)=qDi(i,j+1,it) !orig tr(i,j,it)   ! mp(1)=0 donc tout vient de la couche supérieure
-     elseif(mp(i,j+1)>mp(i,j).and.mp(i,j+1)>1.e-10) THEN
+     elseif(mp(i,j+1)>mp(i,j).AND.mp(i,j+1)>1.e-10) THEN
        qDi(i,j,it)=qDi(i,j+1,it)
-     elseif(mp(i,j)>mp(i,j+1).and.mp(i,j)>1.e-10) then! entrainement
+     elseif(mp(i,j)>mp(i,j+1).AND.mp(i,j)>1.e-10) then! entrainement
        qDi(i,j,it)=(-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it))/(-mp(i,j))
      else  ! si  mp (i)=0 et mp(j+1)=0
@@ -660,8 +660,8 @@
       endif  !mp(2) nul ou non
 
-! vvv  (j!=1.and.j.lt.inb(i))  en-dessous du sommet nuage   vvv
+! vvv  (j!=1.AND.j.lt.inb(i))  en-dessous du sommet nuage   vvv
      else 
 !------------------------------------------------------------- detrainement 
-      IF(mp(i,j+1)>mp(i,j).and.mp(i,j+1)>1.e-10) then !mp(i,j).gt.1.e-10) THEN
+      IF(mp(i,j+1)>mp(i,j).AND.mp(i,j+1)>1.e-10) then !mp(i,j).gt.1.e-10) THEN
          IF(NO_precip(i,j)) THEN
           qDi(i,j,it)=qDi(i,j+1,it)
@@ -681,5 +681,5 @@
          endif !precip
 !------------------------------------------------------------- entrainement 
-      elseif(mp(i,j)>mp(i,j+1).and.mp(i,j)>1.e-10) THEN
+      elseif(mp(i,j)>mp(i,j+1).AND.mp(i,j)>1.e-10) THEN
          IF(NO_precip(i,j)) THEN
           qDi(i,j,it)=(-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it))/(-mp(i,j))
@@ -699,5 +699,5 @@
             (imp(i,j)/RG*dxpres(i,j)))
          endif !precip
-!------------------------------------------------------------- endif ! ent/det
+!------------------------------------------------------------- END IF ! ent/det
       else  !mp nul
         qDi(i,j,it)=tr(i,j,it) ! orig 0.
@@ -719,5 +719,5 @@
 !  DO j=klev,1,-1
 !   DO i=1,klon
-!     IF(it.eq.3) THEN
+!     IF(it.EQ.3) THEN
 !   WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)') j,&
 !!         'zmfdam',zmfdam(i,j,it),'zmfpsi',zmfphi2(i,j,it),&
@@ -750,19 +750,19 @@
                -zmfdam(i,k,it)*ccntrAA_coef3d(i,k)
 ! lessivage courants insatures
-   IF(k<=inb(i).and.k>1) then   ! tendances dans le nuage
+   IF(k<=inb(i).AND.k>1) then   ! tendances dans le nuage
 !------------------------------------------------------------- detrainement
-      IF(mp(i,k+1)>mp(i,k).and.mp(i,k+1)>1.e-10) THEN
+      IF(mp(i,k+1)>mp(i,k).AND.mp(i,k+1)>1.e-10) THEN
         uscavtrac= (-mp(i,k)+mp(i,k+1))*(qDi(i,k,it)-tr(i,k,it))&
                    + mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))
 
-!        IF(it.eq.3) WRITE(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' det incloud',&
+!        IF(it.EQ.3) WRITE(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' det incloud',&
 !                    (-mp(i,k)+mp(i,k+1))*(qDi(i,k,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k)+&
 !                    mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k),&
 !                    'mp',mp(i,k)
 !------------------------------------------------------------- entrainement 
-      elseif(mp(i,k)>mp(i,k+1).and.mp(i,k)>1.e-10) THEN
+      elseif(mp(i,k)>mp(i,k+1).AND.mp(i,k)>1.e-10) THEN
          uscavtrac= mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))
 
-!         IF(it.eq.3) WRITE(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
+!         IF(it.EQ.3) WRITE(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
 !=!------------------------------------------------------------- end ent/det 
       else !        mp(i,k+1)=0. et mp(i,k)=0.    pluie directement sur l environnement
@@ -770,14 +770,14 @@
         IF(NO_precip(i,k)) THEN
           uscavtrac=0.
-!         IF(it.eq.3) WRITE(*,'(I2,1X,a,e20.12,82X,a,e20.12)')k,' no P ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
+!         IF(it.EQ.3) WRITE(*,'(I2,1X,a,e20.12,82X,a,e20.12)')k,' no P ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
         else
           uscavtrac=-imp(i,k)*tr(i,k,it)*dxpres(i,k)/RG+evap(i,k)*qPr(i,k,it)*dxpres(i,k)/RG
-!         IF(it.eq.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
+!         IF(it.EQ.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
 !!JE adds
-!         IF(it.eq.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'imp',imp(i,k)
-!         IF(it.eq.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'tr',tr(i,k,it)
-!         IF(it.eq.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'evap',evap(i,k)
-!         IF(it.eq.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'qPr',qPr(i,k,it)
-!         IF(it.eq.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'dxpres',dxpres(i,k)
+!         IF(it.EQ.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'imp',imp(i,k)
+!         IF(it.EQ.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'tr',tr(i,k,it)
+!         IF(it.EQ.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'evap',evap(i,k)
+!         IF(it.EQ.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'qPr',qPr(i,k,it)
+!         IF(it.EQ.3) WRITE(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac, 'dxpres',dxpres(i,k)
 !!Je end
 
@@ -790,5 +790,5 @@
 !                   + mp(i,2)*(0.-tr(i,k,it))
 
-!       IF(it.eq.3) WRITE(*,'(I2,1X,a,e20.12,84X,a,e20.12)')k,' 1 det',&
+!       IF(it.EQ.3) WRITE(*,'(I2,1X,a,e20.12,84X,a,e20.12)')k,' 1 det',&
 !                  (-0.+mp(i,2))*(qDi(i,k,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k)+&
 !                  mp(i,2)*(0.-tr(i,k,it))*pdtimeRG/dxpres(i,k),&
@@ -800,5 +800,5 @@
           uscavtrac=-imp(i,k)*tr(i,k,it)*dxpres(i,k)/RG+evap(i,k)*qPr(i,k,it)*dxpres(i,k)/RG
         endif
-!         IF(it.eq.3) WRITE(*,'(I2,1X,a,2X,e20.12,82X,a,e20.12)')k,'1 P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
+!         IF(it.EQ.3) WRITE(*,'(I2,1X,a,2X,e20.12,82X,a,e20.12)')k,'1 P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k)
       endif
 
@@ -830,5 +830,5 @@
 !        (paprs(i,k)-paprs(i,k+1))/RG
 
-!      IF(it.eq.3)  WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)') k,&
+!      IF(it.EQ.3)  WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)') k,&
 !         'MA td ',dtrcvMA(i,k,it)*dxpres(i,k)/RG,&
 !         ' td',dtrcv(i,k,it)*dxpres(i,k)/RG,'         conservMA ',conservMA,'conserv ',conserv
@@ -836,5 +836,5 @@
 !        ENDDO
 !      ENDDO
-!       IF(it.eq.3) print *,'it',it,'conserv ',conserv,'conservMA ',conservMA
+!       IF(it.EQ.3) print *,'it',it,'conserv ',conserv,'conservMA ',conservMA
 
 END SUBROUTINE cvltr_spl
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cvparam.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cvparam.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cvparam.h	(revision 5117)
@@ -10,14 +10,14 @@
 !------------------------------------------------------------
 
-      integer noff, minorig, nl, nlp, nlm
-      real elcrit, tlcrit
-      real entp
-      real sigs, sigd
-      real omtrain, omtsnow, coeffr, coeffs
-      real dtmax
-      real cu
-      real betad
-      real alpha, damp
-      real delta
+      INTEGER noff, minorig, nl, nlp, nlm
+      REAL elcrit, tlcrit
+      REAL entp
+      REAL sigs, sigd
+      REAL omtrain, omtsnow, coeffr, coeffs
+      REAL dtmax
+      REAL cu
+      REAL betad
+      REAL alpha, damp
+      REAL delta
 
       COMMON /cvparam/ elcrit, tlcrit &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cvthermo.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cvthermo.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cvthermo.h	(revision 5117)
@@ -4,9 +4,9 @@
 ! Thermodynamical constants for convectL:
 
-      real cpd, cpv, cl, ci, rrv, rrd, lv0, lf0, g, rowl, t0
-      real clmcpv, clmcpd, cpdmcp, cpvmcpd, cpvmcl, clmci
-      real eps, epsi, epsim1
-      real ginv, hrd
-      real grav
+      REAL cpd, cpv, cl, ci, rrv, rrd, lv0, lf0, g, rowl, t0
+      REAL clmcpv, clmcpd, cpdmcp, cpvmcpd, cpvmcl, clmci
+      REAL eps, epsi, epsim1
+      REAL ginv, hrd
+      REAL grav
 
       COMMON /cvthermo/ cpd, cpv, cl, ci, rrv, rrd, lv0, lf0, g, rowl &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/declare_STDlev.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/declare_STDlev.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/declare_STDlev.h	(revision 5117)
@@ -8,22 +8,22 @@
 !      real wwriteSTD(klon,nlevSTD,nfiles)
 
-      real twriteSTD3(klon,nlevSTD3)
-      real qwriteSTD3(klon,nlevSTD3)
-      real rhwriteSTD3(klon,nlevSTD3)
-      real phiwriteSTD3(klon,nlevSTD3)
-      real uwriteSTD3(klon,nlevSTD3)
-      real vwriteSTD3(klon,nlevSTD3)
-      real wwriteSTD3(klon,nlevSTD3)
+      REAL twriteSTD3(klon,nlevSTD3)
+      REAL qwriteSTD3(klon,nlevSTD3)
+      REAL rhwriteSTD3(klon,nlevSTD3)
+      REAL phiwriteSTD3(klon,nlevSTD3)
+      REAL uwriteSTD3(klon,nlevSTD3)
+      REAL vwriteSTD3(klon,nlevSTD3)
+      REAL wwriteSTD3(klon,nlevSTD3)
 
-      real tnondefSTD8(klon,nlevSTD8)
-      real twriteSTD8(klon,nlevSTD8)
-      real qwriteSTD8(klon,nlevSTD8)
-      real rhwriteSTD8(klon,nlevSTD8)
-      real phiwriteSTD8(klon,nlevSTD8)
-      real uwriteSTD8(klon,nlevSTD8)
-      real vwriteSTD8(klon,nlevSTD8)
-      real wwriteSTD8(klon,nlevSTD8)
+      REAL tnondefSTD8(klon,nlevSTD8)
+      REAL twriteSTD8(klon,nlevSTD8)
+      REAL qwriteSTD8(klon,nlevSTD8)
+      REAL rhwriteSTD8(klon,nlevSTD8)
+      REAL phiwriteSTD8(klon,nlevSTD8)
+      REAL uwriteSTD8(klon,nlevSTD8)
+      REAL vwriteSTD8(klon,nlevSTD8)
+      REAL wwriteSTD8(klon,nlevSTD8)
 
-      real, save :: rlevSTD(nlevSTD)
+      REAL, save :: rlevSTD(nlevSTD)
       DATA rlevSTD/100000., 92500., 85000., 70000., &
       60000., 50000., 40000., 30000., 25000., 20000., &
@@ -37,9 +37,9 @@
 !$OMP THREADPRIVATE(clevSTD)
 
-      real, save :: rlevSTD3(nlevSTD3)
+      REAL, save :: rlevSTD3(nlevSTD3)
       DATA rlevSTD3/85000., 50000., 25000./
 !$OMP THREADPRIVATE(rlevSTD3)
 
-      real, save :: rlevSTD8(nlevSTD8)
+      REAL, save :: rlevSTD8(nlevSTD8)
       DATA rlevSTD8/100000., 85000., 70000., 50000., 25000., 10000., &
            5000., 1000./
@@ -49,5 +49,5 @@
 
 ! nout : niveau de output des variables a une pression donnee
-      logical oknondef(klon,nlevSTD,nout)
+      LOGICAL oknondef(klon,nlevSTD,nout)
 
 ! les produits uvSTD, vqSTD, .., T2STD sont calcules
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dimphy.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dimphy.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dimphy.F90	(revision 5117)
@@ -14,5 +14,5 @@
 
 !$OMP THREADPRIVATE(klon,kfdia,kidia,kdlon)
-  REAL,save,allocatable,dimension(:) :: zmasq
+  REAL,SAVE,ALLOCATABLE,DIMENSION(:) :: zmasq
 !$OMP THREADPRIVATE(zmasq)   
 
@@ -22,6 +22,6 @@
   IMPLICIT NONE
   
-    INTEGER, INTENT(in) :: klon0
-    INTEGER, INTENT(in) :: klev0
+    INTEGER, INTENT(IN) :: klon0
+    INTEGER, INTENT(IN) :: klev0
     
     klon=klon0
@@ -45,6 +45,6 @@
   IMPLICIT NONE
   
-    INTEGER, INTENT(in) :: klon0
-    INTEGER, INTENT(in) :: klev0
+    INTEGER, INTENT(IN) :: klon0
+    INTEGER, INTENT(IN) :: klev0
     
     klon=klon0
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_decl_cases.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_decl_cases.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_decl_cases.h	(revision 5117)
@@ -4,36 +4,36 @@
 !        integer nlev_prof
 !        parameter (nlev_prof = 41)
-        integer nlev_toga, nt_toga
+        INTEGER nlev_toga, nt_toga
         parameter (nlev_toga=41, nt_toga=480)
-        integer year_ini_toga, day_ini_toga, mth_ini_toga
-        real day_ju_ini_toga   ! Julian day of toga coare first day
+        INTEGER year_ini_toga, day_ini_toga, mth_ini_toga
+        REAL day_ju_ini_toga   ! Julian day of toga coare first day
         parameter (year_ini_toga=1992) 
         parameter (mth_ini_toga=11)
         parameter (day_ini_toga=1)  !  1erNov1992
-        real dt_toga
+        REAL dt_toga
         parameter (dt_toga=6.*3600.)
 !!
-        integer year_print, month_print, day_print
+        INTEGER year_print, month_print, day_print
         real    sec_print
 !!
-        real ts_toga(nt_toga)
-        real plev_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
-        real t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
-        real u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
-        real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
-        real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
-
-        real ts_prof
-        real plev_prof(nlev_toga),w_prof(nlev_toga)
-        real t_prof(nlev_toga),q_prof(nlev_toga)
-        real u_prof(nlev_toga),v_prof(nlev_toga)
-        real ht_prof(nlev_toga),vt_prof(nlev_toga)
-        real hq_prof(nlev_toga),vq_prof(nlev_toga)
-
-        real w_mod(llm), t_mod(llm),q_mod(llm)
-        real u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm),ug_mod(llm),vg_mod(llm)
+        REAL ts_toga(nt_toga)
+        REAL plev_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
+        REAL t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
+        REAL u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
+        REAL ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
+        REAL hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
+
+        REAL ts_prof
+        REAL plev_prof(nlev_toga),w_prof(nlev_toga)
+        REAL t_prof(nlev_toga),q_prof(nlev_toga)
+        REAL u_prof(nlev_toga),v_prof(nlev_toga)
+        REAL ht_prof(nlev_toga),vt_prof(nlev_toga)
+        REAL hq_prof(nlev_toga),vq_prof(nlev_toga)
+
+        REAL w_mod(llm), t_mod(llm),q_mod(llm)
+        REAL u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm),ug_mod(llm),vg_mod(llm)
 	    real temp_nudg_mod(llm),qv_nudg_mod(llm),u_nudg_mod(llm),v_nudg_mod(llm)       
-        real hq_mod(llm),vq_mod(llm),qv_mod(llm),ql_mod(llm),qt_mod(llm)
-        real th_mod(llm)
+        REAL hq_mod(llm),vq_mod(llm),qv_mod(llm),ql_mod(llm),qt_mod(llm)
+        REAL th_mod(llm)
 
 ! EV comment these lines
@@ -43,41 +43,41 @@
 ! Declarations specifiques au cas RICO
         character*80 :: fich_rico
-        integer nlev_rico
+        INTEGER nlev_rico
 
         parameter (nlev_rico=81)
-        real ts_rico,ps_rico
-        real w_rico(llm)
-        real t_rico(llm),q_rico(llm)
-        real u_rico(llm),v_rico(llm)
-        real dth_rico(llm)
-        real dqh_rico(llm)
+        REAL ts_rico,ps_rico
+        REAL w_rico(llm)
+        REAL t_rico(llm),q_rico(llm)
+        REAL u_rico(llm),v_rico(llm)
+        REAL dth_rico(llm)
+        REAL dqh_rico(llm)
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! Declarations specifiques au cas TWPice
         character*80 :: fich_twpice
-        integer nlev_twpi, nt_twpi
+        INTEGER nlev_twpi, nt_twpi
         parameter (nlev_twpi=40, nt_twpi=215)
-        integer year_ini_twpi, day_ini_twpi, mth_ini_twpi
-        real heure_ini_twpi
-        real day_ju_ini_twpi   ! Julian day of twpice first day
+        INTEGER year_ini_twpi, day_ini_twpi, mth_ini_twpi
+        REAL heure_ini_twpi
+        REAL day_ju_ini_twpi   ! Julian day of twpice first day
         parameter (year_ini_twpi=2006) 
         parameter (mth_ini_twpi=1)
         parameter (day_ini_twpi=17)  ! 17 = 17Jan2006
         parameter (heure_ini_twpi=10800.) !3h en secondes
-        real dt_twpi
+        REAL dt_twpi
         parameter (dt_twpi=3.*3600.)
 
-        real ts_twpi(nt_twpi)
-        real plev_twpi(nlev_twpi,nt_twpi),w_twpi(nlev_twpi,nt_twpi)
-        real t_twpi(nlev_twpi,nt_twpi),q_twpi(nlev_twpi,nt_twpi)
-        real u_twpi(nlev_twpi,nt_twpi),v_twpi(nlev_twpi,nt_twpi)
-        real ht_twpi(nlev_twpi,nt_twpi),vt_twpi(nlev_twpi,nt_twpi)
-        real hq_twpi(nlev_twpi,nt_twpi),vq_twpi(nlev_twpi,nt_twpi)
-
-        real ts_proftwp
-        real plev_proftwp(nlev_twpi),w_proftwp(nlev_twpi)
-        real t_proftwp(nlev_twpi),q_proftwp(nlev_twpi)
-        real u_proftwp(nlev_twpi),v_proftwp(nlev_twpi)
-        real ht_proftwp(nlev_twpi),vt_proftwp(nlev_twpi)
-        real hq_proftwp(nlev_twpi),vq_proftwp(nlev_twpi)
+        REAL ts_twpi(nt_twpi)
+        REAL plev_twpi(nlev_twpi,nt_twpi),w_twpi(nlev_twpi,nt_twpi)
+        REAL t_twpi(nlev_twpi,nt_twpi),q_twpi(nlev_twpi,nt_twpi)
+        REAL u_twpi(nlev_twpi,nt_twpi),v_twpi(nlev_twpi,nt_twpi)
+        REAL ht_twpi(nlev_twpi,nt_twpi),vt_twpi(nlev_twpi,nt_twpi)
+        REAL hq_twpi(nlev_twpi,nt_twpi),vq_twpi(nlev_twpi,nt_twpi)
+
+        REAL ts_proftwp
+        REAL plev_proftwp(nlev_twpi),w_proftwp(nlev_twpi)
+        REAL t_proftwp(nlev_twpi),q_proftwp(nlev_twpi)
+        REAL u_proftwp(nlev_twpi),v_proftwp(nlev_twpi)
+        REAL ht_proftwp(nlev_twpi),vt_proftwp(nlev_twpi)
+        REAL hq_proftwp(nlev_twpi),vq_proftwp(nlev_twpi)
 
 
@@ -85,8 +85,8 @@
 !Declarations specifiques au cas FIRE
         character*80 :: fich_fire
-        integer nlev_fire, nt_fire
+        INTEGER nlev_fire, nt_fire
         parameter (nlev_fire=120, nt_fire=1)  
-        integer year_ini_fire, day_ini_fire, mth_ini_fire
-        real heure_ini_fire
+        INTEGER year_ini_fire, day_ini_fire, mth_ini_fire
+        REAL heure_ini_fire
         parameter (year_ini_fire=1987) 
         parameter (mth_ini_fire=7)
@@ -133,46 +133,46 @@
 !Declarations specifiques au cas DICE     (MPL 02072013)
         character*80 :: fich_dice
-        integer nlev_dice, nt_dice
+        INTEGER nlev_dice, nt_dice
         parameter (nlev_dice=70, nt_dice=145)  
-        integer year_ini_dice, day_ini_dice, mth_ini_dice
-        real heure_ini_dice
-        real day_ju_ini_dice   ! Julian day of dice first day
+        INTEGER year_ini_dice, day_ini_dice, mth_ini_dice
+        REAL heure_ini_dice
+        REAL day_ju_ini_dice   ! Julian day of dice first day
         parameter (year_ini_dice=1999) 
         parameter (mth_ini_dice=10)
         parameter (day_ini_dice=23)  ! 23 = 23 october 1999
         parameter (heure_ini_dice=68400.) !19UTC en secondes
-        real dt_dice
+        REAL dt_dice
         parameter (dt_dice=0.5*3600.) ! 1 forcage ttes les demi-heures
 
 !profils initiaux:
-        real plev_dice(nlev_dice)
+        REAL plev_dice(nlev_dice)
         
-        real zz_dice(nlev_dice)
-        real t_dice(nlev_dice),qv_dice(nlev_dice)
-        real u_dice(nlev_dice), v_dice(nlev_dice),o3_dice(nlev_dice)
-        real ht_dice(nlev_dice,nt_dice)
-        real hq_dice(nlev_dice,nt_dice), hu_dice(nlev_dice,nt_dice)
-        real hv_dice(nlev_dice,nt_dice)
-        real w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
-        real o3_mod(llm),hu_mod(llm),hv_mod(llm)
-        real t_dicei(nlev_dice),qv_dicei(nlev_dice)
-        real u_dicei(nlev_dice), v_dicei(nlev_dice),o3_dicei(nlev_dice)
-        real ht_dicei(nlev_dice)
-        real hq_dicei(nlev_dice), hu_dicei(nlev_dice)
-        real hv_dicei(nlev_dice)
-        real w_dicei(nlev_dice),omega_dicei(nlev_dice)
+        REAL zz_dice(nlev_dice)
+        REAL t_dice(nlev_dice),qv_dice(nlev_dice)
+        REAL u_dice(nlev_dice), v_dice(nlev_dice),o3_dice(nlev_dice)
+        REAL ht_dice(nlev_dice,nt_dice)
+        REAL hq_dice(nlev_dice,nt_dice), hu_dice(nlev_dice,nt_dice)
+        REAL hv_dice(nlev_dice,nt_dice)
+        REAL w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
+        REAL o3_mod(llm),hu_mod(llm),hv_mod(llm)
+        REAL t_dicei(nlev_dice),qv_dicei(nlev_dice)
+        REAL u_dicei(nlev_dice), v_dicei(nlev_dice),o3_dicei(nlev_dice)
+        REAL ht_dicei(nlev_dice)
+        REAL hq_dicei(nlev_dice), hu_dicei(nlev_dice)
+        REAL hv_dicei(nlev_dice)
+        REAL w_dicei(nlev_dice),omega_dicei(nlev_dice)
 
         
 !forcings
-        real shf_dice(nt_dice),lhf_dice(nt_dice)
-        real lwup_dice(nt_dice),swup_dice(nt_dice)
-        real tg_dice(nt_dice),ustar_dice(nt_dice),psurf_dice(nt_dice)
-        real ug_dice(nt_dice),vg_dice(nt_dice)
-
-        real shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof
-        real ustar_prof,psurf_prof,cdrag
-        real ht_profd(nlev_dice),hq_profd(nlev_dice),hu_profd(nlev_dice)
-        real hv_profd(nlev_dice),w_profd(nlev_dice)
-        real omega_profd(nlev_dice),ug_profd,vg_profd
+        REAL shf_dice(nt_dice),lhf_dice(nt_dice)
+        REAL lwup_dice(nt_dice),swup_dice(nt_dice)
+        REAL tg_dice(nt_dice),ustar_dice(nt_dice),psurf_dice(nt_dice)
+        REAL ug_dice(nt_dice),vg_dice(nt_dice)
+
+        REAL shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof
+        REAL ustar_prof,psurf_prof,cdrag
+        REAL ht_profd(nlev_dice),hq_profd(nlev_dice),hu_profd(nlev_dice)
+        REAL hv_profd(nlev_dice),w_profd(nlev_dice)
+        REAL omega_profd(nlev_dice),ug_profd,vg_profd
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -187,5 +187,5 @@
         real  Ts_gcssold
         real  dtime_frcg
-        logical :: Turb_fcg_gcssold
+        LOGICAL :: Turb_fcg_gcssold
 
         common /turb_forcing/                                                   &
@@ -196,24 +196,24 @@
 
 
-        integer nlev_armcu, nt_armcu
+        INTEGER nlev_armcu, nt_armcu
         parameter (nlev_armcu=40, nt_armcu=31)
-        integer year_ini_armcu, day_ini_armcu, mth_ini_armcu
+        INTEGER year_ini_armcu, day_ini_armcu, mth_ini_armcu
         real  heure_ini_armcu
-        real day_ju_ini_armcu                                ! Julian day of armcu case first day
+        REAL day_ju_ini_armcu                                ! Julian day of armcu case first day
         parameter (year_ini_armcu=1997) 
         parameter (mth_ini_armcu=6)
         parameter (day_ini_armcu=21)  ! 172 = 21 juin 1997
         parameter (heure_ini_armcu=41400)   ! 11:30 en secondes
-        real dt_armcu
+        REAL dt_armcu
         parameter (dt_armcu=1.*1800.)   ! forcages donnes ttes les demi-heures par ifa_armcu.txt
-        real sens_armcu(nt_armcu),flat_armcu(nt_armcu)
-        real adv_theta_armcu(nt_armcu),rad_theta_armcu(nt_armcu)
-        real adv_qt_armcu(nt_armcu)
-        real theta_mod(llm),rv_mod(llm),play_mod(llm)
+        REAL sens_armcu(nt_armcu),flat_armcu(nt_armcu)
+        REAL adv_theta_armcu(nt_armcu),rad_theta_armcu(nt_armcu)
+        REAL adv_qt_armcu(nt_armcu)
+        REAL theta_mod(llm),rv_mod(llm),play_mod(llm)
 ! profc comme "profil armcu"
         
 ! forcages interpoles dans le temps
-        real adv_theta_prof,rad_theta_prof,adv_qt_prof
-        real sens_prof,flat_prof,fact
+        REAL adv_theta_prof,rad_theta_prof,adv_qt_prof
+        REAL sens_prof,flat_prof,fact
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! declarations specifiques au cas Sandu
@@ -221,78 +221,78 @@
 !        integer nlev_prof
 !        parameter (nlev_prof = 41)
-        integer nlev_sandu, nt_sandu
+        INTEGER nlev_sandu, nt_sandu
         parameter (nlev_sandu=87, nt_sandu=13)
-        integer year_ini_sandu, day_ini_sandu, mth_ini_sandu
-        real day_ju_ini_sandu                                ! Julian day of sandu case first day
+        INTEGER year_ini_sandu, day_ini_sandu, mth_ini_sandu
+        REAL day_ju_ini_sandu                                ! Julian day of sandu case first day
         parameter (year_ini_sandu=2006)
         parameter (mth_ini_sandu=7)
         parameter (day_ini_sandu=15)  ! 196 = 15 juillet 2006
-        real dt_sandu, tau_sandu
+        REAL dt_sandu, tau_sandu
         logical  :: trouve_700=.TRUE.
         parameter (dt_sandu=6.*3600.)   ! forcages donnes ttes les 6 heures par ifa_sandu.txt
         parameter (tau_sandu=30000*3600.)  ! temps de relaxation u,v,thetal,qt vers profil init et au dessus 700hPa
 !!
-        real ts_sandu(nt_sandu)
+        REAL ts_sandu(nt_sandu)
 ! profs comme "profil sandu"
-        real plev_profs(nlev_sandu)
-        real t_profs(nlev_sandu),thl_profs(nlev_sandu)
-        real q_profs(nlev_sandu)
-        real u_profs(nlev_sandu),v_profs(nlev_sandu),w_profs(nlev_sandu)
-        real omega_profs(nlev_sandu),o3mmr_profs(nlev_sandu)
-
-        real, dimension(llm) :: relax_u,relax_v,relax_thl
-        real, dimension(llm,2) :: relax_q
-
-        real thl_mod(llm),omega_mod(llm),o3mmr_mod(llm),tke_mod(llm)
+        REAL plev_profs(nlev_sandu)
+        REAL t_profs(nlev_sandu),thl_profs(nlev_sandu)
+        REAL q_profs(nlev_sandu)
+        REAL u_profs(nlev_sandu),v_profs(nlev_sandu),w_profs(nlev_sandu)
+        REAL omega_profs(nlev_sandu),o3mmr_profs(nlev_sandu)
+
+        REAL, DIMENSION(llm) :: relax_u,relax_v,relax_thl
+        REAL, DIMENSION(llm,2) :: relax_q
+
+        REAL thl_mod(llm),omega_mod(llm),o3mmr_mod(llm),tke_mod(llm)
 !vertical advection computation
-        real d_t_z(llm),d_th_z(llm), d_q_z(llm)
-        real d_t_dyn_z(llm),d_th_dyn_z(llm), d_q_dyn_z(llm)
-        real d_u_z(llm),d_v_z(llm)
-        real d_u_dyn(llm),d_v_dyn(llm)
-        real d_u_dyn_z(llm),d_v_dyn_z(llm)
-        real d_u_adv(llm),d_v_adv(llm)
-        real zz(llm)
-        real zfact
+        REAL d_t_z(llm),d_th_z(llm), d_q_z(llm)
+        REAL d_t_dyn_z(llm),d_th_dyn_z(llm), d_q_dyn_z(llm)
+        REAL d_u_z(llm),d_v_z(llm)
+        REAL d_u_dyn(llm),d_v_dyn(llm)
+        REAL d_u_dyn_z(llm),d_v_dyn_z(llm)
+        REAL d_u_adv(llm),d_v_adv(llm)
+        REAL zz(llm)
+        REAL zfact
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! Declarations specifiques au cas Astex
         character*80 :: fich_astex
-        integer nlev_astex, nt_astex
+        INTEGER nlev_astex, nt_astex
         parameter (nlev_astex=34, nt_astex=49)
-        integer year_ini_astex, day_ini_astex, mth_ini_astex
-        real day_ju_ini_astex                                ! Julian day of astex case first day
+        INTEGER year_ini_astex, day_ini_astex, mth_ini_astex
+        REAL day_ju_ini_astex                                ! Julian day of astex case first day
         parameter (year_ini_astex=1992)
         parameter (mth_ini_astex=6)
         parameter (day_ini_astex=13)  ! 165 = 13 juin 1992
-        real dt_astex
+        REAL dt_astex
         parameter (dt_astex=3600.)    ! forcages donnes ttes les heures par ifa_astex.txt
-        real ts_astex(nt_astex),div_astex(nt_astex),ug_astex(nt_astex)
-        real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
-        real div_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
+        REAL ts_astex(nt_astex),div_astex(nt_astex),ug_astex(nt_astex)
+        REAL vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
+        REAL div_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
 ! profa comme "profil astex"
-        real plev_profa(nlev_astex)
-        real t_profa(nlev_astex),thl_profa(nlev_astex)
-        real qv_profa(nlev_astex),ql_profa(nlev_astex)
-        real qt_profa(nlev_astex),o3mmr_profa(nlev_astex)
-        real u_profa(nlev_astex),v_profa(nlev_astex),w_profa(nlev_astex)
-        real tke_profa(nlev_astex)
+        REAL plev_profa(nlev_astex)
+        REAL t_profa(nlev_astex),thl_profa(nlev_astex)
+        REAL qv_profa(nlev_astex),ql_profa(nlev_astex)
+        REAL qt_profa(nlev_astex),o3mmr_profa(nlev_astex)
+        REAL u_profa(nlev_astex),v_profa(nlev_astex),w_profa(nlev_astex)
+        REAL tke_profa(nlev_astex)
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 !Declarations specifiques au cas standard
 
-        real w_mod_cas(llm), t_mod_cas(llm),q_mod_cas(llm)
-        real theta_mod_cas(llm),thl_mod_cas(llm),thv_mod_cas(llm)
-        real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
-        real ug_mod_cas(llm),vg_mod_cas(llm)
-        real temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm),v_nudg_mod_cas(llm),u_nudg_mod_cas(llm)
-        real invtau_temp_nudg_mod_cas(llm),invtau_qv_nudg_mod_cas(llm),invtau_v_nudg_mod_cas(llm),invtau_u_nudg_mod_cas(llm)
-        real u_mod_cas(llm),v_mod_cas(llm)
-        real omega_mod_cas(llm),tke_mod_cas(llm+1)
-        real ht_mod_cas(llm),vt_mod_cas(llm),dt_mod_cas(llm),dtrad_mod_cas(llm)
-        real hth_mod_cas(llm),vth_mod_cas(llm),dth_mod_cas(llm)
-        real hq_mod_cas(llm),vq_mod_cas(llm),dq_mod_cas(llm)
-        real hu_mod_cas(llm),vu_mod_cas(llm),du_mod_cas(llm)
-        real hv_mod_cas(llm),vv_mod_cas(llm),dv_mod_cas(llm)
-        integer day_ini_cas
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
+        REAL w_mod_cas(llm), t_mod_cas(llm),q_mod_cas(llm)
+        REAL theta_mod_cas(llm),thl_mod_cas(llm),thv_mod_cas(llm)
+        REAL qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
+        REAL ug_mod_cas(llm),vg_mod_cas(llm)
+        REAL temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm),v_nudg_mod_cas(llm),u_nudg_mod_cas(llm)
+        REAL invtau_temp_nudg_mod_cas(llm),invtau_qv_nudg_mod_cas(llm),invtau_v_nudg_mod_cas(llm),invtau_u_nudg_mod_cas(llm)
+        REAL u_mod_cas(llm),v_mod_cas(llm)
+        REAL omega_mod_cas(llm),tke_mod_cas(llm+1)
+        REAL ht_mod_cas(llm),vt_mod_cas(llm),dt_mod_cas(llm),dtrad_mod_cas(llm)
+        REAL hth_mod_cas(llm),vth_mod_cas(llm),dth_mod_cas(llm)
+        REAL hq_mod_cas(llm),vq_mod_cas(llm),dq_mod_cas(llm)
+        REAL hu_mod_cas(llm),vu_mod_cas(llm),du_mod_cas(llm)
+        REAL hv_mod_cas(llm),vv_mod_cas(llm),dv_mod_cas(llm)
+        INTEGER day_ini_cas
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_interp_cases.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_interp_cases.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_interp_cases.h	(revision 5117)
@@ -32,5 +32,5 @@
 ! EV tg instead of ts_cur
              tg = ts_prof_cas
-             if ((tg .eq. 0.) .and. (tskin_prof_cas .ne. 0.)) THEN
+             IF ((tg .EQ. 0.) .AND. (tskin_prof_cas .NE. 0.)) THEN
                 tg=tskin_prof_cas
               endif
@@ -78,5 +78,5 @@
       d_u_dyn_z(:)=0.
       d_v_dyn_z(:)=0.
-      if (1==0) THEN
+      IF (1==0) THEN
          DO l=2,llm-1
           d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
@@ -132,5 +132,5 @@
 
 !geostrophic wind 
-      if (forc_geo.eq.1) THEN
+      IF (forc_geo.EQ.1) THEN
         do l=1,llm
         ug(l) = ug_mod_cas(l) 
@@ -168,5 +168,5 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
          
-        if (trad.eq.1) THEN
+        IF (trad.EQ.1) THEN
            tend_rayo=1
            dt_cooling(l) = dtrad_mod_cas(l)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_read_forc_cases.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_read_forc_cases.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_read_forc_cases.h	(revision 5117)
@@ -12,5 +12,5 @@
 
       PRINT*,'FORCING ,forcing_SCM',forcing_SCM
-      if (forcing_SCM) THEN
+      IF (forcing_SCM) THEN
          WRITE(*,*),'avant CALL read_SCM'
          CALL read_SCM_cas
@@ -76,8 +76,8 @@
 
       !initial surface temperature
-      if (tskin_prof_cas .NE. 0.) THEN
+      IF (tskin_prof_cas .NE. 0.) THEN
       ! we take the first value of the prescribed ts
           tsurf=tskin_prof_cas
-      else if (ts_prof_cas .NE. 0) THEN
+      ELSE IF (ts_prof_cas .NE. 0) THEN
       ! if an initial ts value is present, we take it
           tsurf=ts_prof_cas
@@ -86,5 +86,5 @@
       ! ts forcing during the run (if any)
       tg = ts_prof_cas
-      if ((tg .eq. 0.) .and. (tskin_prof_cas .NE. 0.)) THEN
+      IF ((tg .EQ. 0.) .AND. (tskin_prof_cas .NE. 0.)) THEN
           tg=tskin_prof_cas
       endif
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/compar1d.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/compar1d.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/compar1d.h	(revision 5117)
@@ -30,6 +30,6 @@
       REAL :: zpicinp
 
-      logical :: restart
-      logical :: ok_old_disvert
+      LOGICAL :: restart
+      LOGICAL :: ok_old_disvert
 
 ! Pour les forcages communs: ces entiers valent 0 ou 1
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/fcg_racmo.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/fcg_racmo.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/fcg_racmo.h	(revision 5117)
@@ -3,5 +3,5 @@
 
       real   :: a_guide 
-      logical :: ok_invertp 
+      LOGICAL :: ok_invertp
       INTEGER :: forc_trb
       character*31 :: fich_racmo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90	(revision 5117)
@@ -62,5 +62,5 @@
   SUBROUTINE conf_unicol
 
-    use IOIPSL
+    USE IOIPSL
     USE lmdz_print_control, ONLY: lunout
     !-----------------------------------------------------------------------
@@ -97,5 +97,5 @@
     lunout = 6
     !      CALL getin('lunout', lunout)
-    IF (lunout /= 5 .and. lunout /= 6) THEN
+    IF (lunout /= 5 .AND. lunout /= 6) THEN
       OPEN(lunout, FILE = 'lmdz.out')
     ENDIF
@@ -711,5 +711,5 @@
     USE lmdz_write_field_phy
     USE infotrac
-    use control_mod
+    USE control_mod
     USE comconst_mod, ONLY: im, jm, lllm
     USE logic_mod, ONLY: fxyhypb, ysinus
@@ -844,5 +844,5 @@
     USE iostart
     USE infotrac
-    use control_mod
+    USE control_mod
     USE comconst_mod, ONLY: cpp, daysec, dtvr, g, kappa, omeg, rad
     USE logic_mod, ONLY: fxyhypb, ysinus
@@ -1032,5 +1032,5 @@
 
     CHARACTER(LEN = *) modname
-    integer ierr
+    INTEGER ierr
     CHARACTER(LEN = *) message
 
@@ -1046,5 +1046,5 @@
     CALL getin_dump
 
-    if (ierr == 0) THEN
+    IF (ierr == 0) THEN
       WRITE(*, *) 'Everything is cool'
     else
@@ -1248,11 +1248,11 @@
     IMPLICIT NONE
     ! arguments
-    integer llm
-    real w(llm + 1), q(llm), plev(llm + 1), dt
+    INTEGER llm
+    REAL w(llm + 1), q(llm), plev(llm + 1), dt
 
     ! local
-    integer l
-    real zwq(llm + 1), zm(llm + 1), zw(llm + 1)
-    real qold
+    INTEGER l
+    REAL zwq(llm + 1), zm(llm + 1), zw(llm + 1)
+    REAL qold
 
     !---------------------------------------------------------------
@@ -1285,5 +1285,5 @@
     include "YOMCST.h"
     !        argument
-    integer llm
+    INTEGER llm
     real  omega(llm + 1), d_t_va(llm), d_q_va(llm, 3)
     real  d_u_va(llm), d_v_va(llm)
@@ -1292,6 +1292,6 @@
     real  play(llm)
     ! interne
-    integer l
-    real alpha, omgdown, omgup
+    INTEGER l
+    REAL alpha, omgdown, omgup
 
     do l = 1, llm
@@ -1357,5 +1357,5 @@
     include "YOMCST.h"
     !        argument
-    integer llm, nqtot
+    INTEGER llm, nqtot
     real  omega(llm + 1), d_t_va(llm), d_q_va(llm, nqtot)
     !        real  d_u_va(llm), d_v_va(llm)
@@ -1363,10 +1363,10 @@
     real  u(llm), v(llm)
     real  play(llm)
-    real cor(llm)
+    REAL cor(llm)
     !        real dph(llm),dudp(llm),dvdp(llm),dqdp(llm),dtdp(llm)
-    real dph(llm), dqdp(llm), dtdp(llm)
+    REAL dph(llm), dqdp(llm), dtdp(llm)
     ! interne
-    integer k
-    real omdn, omup
+    INTEGER k
+    REAL omdn, omup
 
     !        dudp=0.
@@ -1673,7 +1673,7 @@
     !-------------------------------------------------------------------------
 
-    integer nlevmax
+    INTEGER nlevmax
     parameter (nlevmax = 41)
-    integer nlev_cas, mxcalc
+    INTEGER nlev_cas, mxcalc
     !       real play(llm), plev_prof(nlevmax)
     !       real t_prof(nlevmax),q_prof(nlevmax)
@@ -1682,27 +1682,27 @@
     !       real hq_prof(nlevmax),vq_prof(nlevmax)
 
-    real play(llm), plev_prof_cas(nlev_cas)
-    real t_prof_cas(nlev_cas), th_prof_cas(nlev_cas), thv_prof_cas(nlev_cas), thl_prof_cas(nlev_cas)
-    real qv_prof_cas(nlev_cas), ql_prof_cas(nlev_cas), qi_prof_cas(nlev_cas)
-    real u_prof_cas(nlev_cas), v_prof_cas(nlev_cas)
-    real ug_prof_cas(nlev_cas), vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas), omega_prof_cas(nlev_cas)
-    real du_prof_cas(nlev_cas), hu_prof_cas(nlev_cas), vu_prof_cas(nlev_cas)
-    real dv_prof_cas(nlev_cas), hv_prof_cas(nlev_cas), vv_prof_cas(nlev_cas)
-    real dt_prof_cas(nlev_cas), ht_prof_cas(nlev_cas), vt_prof_cas(nlev_cas), dtrad_prof_cas(nlev_cas)
-    real dth_prof_cas(nlev_cas), hth_prof_cas(nlev_cas), vth_prof_cas(nlev_cas)
-    real dq_prof_cas(nlev_cas), hq_prof_cas(nlev_cas), vq_prof_cas(nlev_cas)
-
-    real t_mod_cas(llm), theta_mod_cas(llm), thv_mod_cas(llm), thl_mod_cas(llm)
-    real qv_mod_cas(llm), ql_mod_cas(llm), qi_mod_cas(llm)
-    real u_mod_cas(llm), v_mod_cas(llm)
-    real ug_mod_cas(llm), vg_mod_cas(llm), w_mod_cas(llm), omega_mod_cas(llm)
-    real du_mod_cas(llm), hu_mod_cas(llm), vu_mod_cas(llm)
-    real dv_mod_cas(llm), hv_mod_cas(llm), vv_mod_cas(llm)
-    real dt_mod_cas(llm), ht_mod_cas(llm), vt_mod_cas(llm), dtrad_mod_cas(llm)
-    real dth_mod_cas(llm), hth_mod_cas(llm), vth_mod_cas(llm)
-    real dq_mod_cas(llm), hq_mod_cas(llm), vq_mod_cas(llm)
-
-    integer l, k, k1, k2
-    real frac, frac1, frac2, fact
+    REAL play(llm), plev_prof_cas(nlev_cas)
+    REAL t_prof_cas(nlev_cas), th_prof_cas(nlev_cas), thv_prof_cas(nlev_cas), thl_prof_cas(nlev_cas)
+    REAL qv_prof_cas(nlev_cas), ql_prof_cas(nlev_cas), qi_prof_cas(nlev_cas)
+    REAL u_prof_cas(nlev_cas), v_prof_cas(nlev_cas)
+    REAL ug_prof_cas(nlev_cas), vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas), omega_prof_cas(nlev_cas)
+    REAL du_prof_cas(nlev_cas), hu_prof_cas(nlev_cas), vu_prof_cas(nlev_cas)
+    REAL dv_prof_cas(nlev_cas), hv_prof_cas(nlev_cas), vv_prof_cas(nlev_cas)
+    REAL dt_prof_cas(nlev_cas), ht_prof_cas(nlev_cas), vt_prof_cas(nlev_cas), dtrad_prof_cas(nlev_cas)
+    REAL dth_prof_cas(nlev_cas), hth_prof_cas(nlev_cas), vth_prof_cas(nlev_cas)
+    REAL dq_prof_cas(nlev_cas), hq_prof_cas(nlev_cas), vq_prof_cas(nlev_cas)
+
+    REAL t_mod_cas(llm), theta_mod_cas(llm), thv_mod_cas(llm), thl_mod_cas(llm)
+    REAL qv_mod_cas(llm), ql_mod_cas(llm), qi_mod_cas(llm)
+    REAL u_mod_cas(llm), v_mod_cas(llm)
+    REAL ug_mod_cas(llm), vg_mod_cas(llm), w_mod_cas(llm), omega_mod_cas(llm)
+    REAL du_mod_cas(llm), hu_mod_cas(llm), vu_mod_cas(llm)
+    REAL dv_mod_cas(llm), hv_mod_cas(llm), vv_mod_cas(llm)
+    REAL dt_mod_cas(llm), ht_mod_cas(llm), vt_mod_cas(llm), dtrad_mod_cas(llm)
+    REAL dth_mod_cas(llm), hth_mod_cas(llm), vth_mod_cas(llm)
+    REAL dq_mod_cas(llm), hq_mod_cas(llm), vq_mod_cas(llm)
+
+    INTEGER l, k, k1, k2
+    REAL frac, frac1, frac2, fact
 
     !       do l = 1, llm
@@ -1715,5 +1715,5 @@
     do l = 1, llm
 
-      if (play(l)>=plev_prof_cas(nlev_cas)) THEN
+      IF (play(l)>=plev_prof_cas(nlev_cas)) THEN
         mxcalc = l
         !        print *,'debut interp2, mxcalc=',mxcalc
@@ -1721,7 +1721,7 @@
         k2 = 0
 
-        if (play(l)<=plev_prof_cas(1)) THEN
+        IF (play(l)<=plev_prof_cas(1)) THEN
           do k = 1, nlev_cas - 1
-            if (play(l)<=plev_prof_cas(k).and. play(l)>plev_prof_cas(k + 1)) THEN
+            IF (play(l)<=plev_prof_cas(k).AND. play(l)>plev_prof_cas(k + 1)) THEN
               k1 = k
               k2 = k + 1
@@ -1729,5 +1729,5 @@
           enddo
 
-          if (k1==0 .or. k2==0) THEN
+          IF (k1==0 .OR. k2==0) THEN
             WRITE(*, *) 'PB! k1, k2 = ', k1, k2
             WRITE(*, *) 'l,play(l) = ', l, play(l) / 100
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90	(revision 5117)
@@ -27,5 +27,5 @@
     REAL hplaym(100) !pression en hPa milieux des couches Meso-NH
 
-    integer i, j, k, ll, in
+    INTEGER i, j, k, ll, in
 
     CHARACTER*80 file_forctl, file_fordat
@@ -45,5 +45,5 @@
     !       dt         :pas de temps du meso_NH (en secondes)
     !----------------------------------------------------------------------
-    integer pasmax, dt
+    INTEGER pasmax, dt
     save pasmax, dt
     !----------------------------------------------------------------------
@@ -60,23 +60,23 @@
     !           hv     : idem le long de y.
     !           Ts     : Temperature de surface (K)
-    !           imp_fcg: var. logical .eq. T si forcage en impulsion
-    !           ts_fcg: var. logical .eq. T si forcage en Ts present dans fichier
-    !           Tp_fcg: var. logical .eq. T si forcage donne en Temp potentielle
-    !           Turb_fcg: var. logical .eq. T si forcage turbulent present dans fichier
-    !----------------------------------------------------------------------
-    integer itap
-    real dtime
-    real ht(100)
-    real hq(100)
-    real hu(100)
-    real hv(100)
-    real hw(100)
-    real hthturb(100)
-    real hqturb(100)
-    real Ts, Ts_subr
-    logical imp_fcg
-    logical ts_fcg
-    logical Tp_fcg
-    logical Turb_fcg
+    !           imp_fcg: var. LOGICAL .EQ. T si forcage en impulsion
+    !           ts_fcg: var. LOGICAL .EQ. T si forcage en Ts present dans fichier
+    !           Tp_fcg: var. LOGICAL .EQ. T si forcage donne en Temp potentielle
+    !           Turb_fcg: var. LOGICAL .EQ. T si forcage turbulent present dans fichier
+    !----------------------------------------------------------------------
+    INTEGER itap
+    REAL dtime
+    REAL ht(100)
+    REAL hq(100)
+    REAL hu(100)
+    REAL hv(100)
+    REAL hw(100)
+    REAL hthturb(100)
+    REAL hqturb(100)
+    REAL Ts, Ts_subr
+    LOGICAL imp_fcg
+    LOGICAL ts_fcg
+    LOGICAL Tp_fcg
+    LOGICAL Turb_fcg
     !----------------------------------------------------------------------
     ! Variables internes de get_uvd (note : l interpolation temporelle
@@ -100,36 +100,36 @@
     !     tsbef     : surface temperature 'before time step'
     !----------------------------------------------------------------------
-    integer time0, pas, pasprev
+    INTEGER time0, pas, pasprev
     save time0, pas, pasprev
-    real time
-    real htaft(100), hqaft(100), hwaft(100), huaft(100), hvaft(100)
-    real hthturbaft(100), hqturbaft(100)
-    real Tsaft
+    REAL time
+    REAL htaft(100), hqaft(100), hwaft(100), huaft(100), hvaft(100)
+    REAL hthturbaft(100), hqturbaft(100)
+    REAL Tsaft
     save htaft, hqaft, hwaft, huaft, hvaft, hthturbaft, hqturbaft
-    real htbef(100), hqbef(100), hwbef(100), hubef(100), hvbef(100)
-    real hthturbbef(100), hqturbbef(100)
-    real Tsbef
+    REAL htbef(100), hqbef(100), hwbef(100), hubef(100), hvbef(100)
+    REAL hthturbbef(100), hqturbbef(100)
+    REAL Tsbef
     save htbef, hqbef, hwbef, hubef, hvbef, hthturbbef, hqturbbef
 
-    real timeaft, timebef
+    REAL timeaft, timebef
     save timeaft, timebef
-    integer temps
+    INTEGER temps
     character*4 string
     !----------------------------------------------------------------------
     ! variables arguments de la subroutine rdgrads
     !---------------------------------------------------------------------
-    integer icompt, icomp1 !compteurs de rdgrads
-    real z(100)         ! altitude (grille Meso)
-    real ht_mes(100)    !convergence horizontale de temperature
+    INTEGER icompt, icomp1 !compteurs de rdgrads
+    REAL z(100)         ! altitude (grille Meso)
+    REAL ht_mes(100)    !convergence horizontale de temperature
     !-(grille Meso)
-    real hq_mes(100)    !convergence horizontale d humidite
+    REAL hq_mes(100)    !convergence horizontale d humidite
     !(grille Meso)
-    real hw_mes(100)    !vitesse verticale moyenne
+    REAL hw_mes(100)    !vitesse verticale moyenne
     !(grille Meso)
-    real hu_mes(100), hv_mes(100)    !convergence horizontale d impulsion
+    REAL hu_mes(100), hv_mes(100)    !convergence horizontale d impulsion
     !(grille Meso)
-    real hthturb_mes(100) !tendance horizontale de T_pot, due aux
+    REAL hthturb_mes(100) !tendance horizontale de T_pot, due aux
     !flux turbulents
-    real hqturb_mes(100) !tendance horizontale d humidite, due aux
+    REAL hqturb_mes(100) !tendance horizontale d humidite, due aux
     !flux turbulents
 
@@ -143,5 +143,5 @@
     !---------------------------------------------------------------------
     character*80 aaa, atemps, spaces, apasmax
-    integer nch, imn, ipa
+    INTEGER nch, imn, ipa
     !---------------------------------------------------------------------
     !  procedures appelees
@@ -220,5 +220,5 @@
       !*** gcm . on obtient le nouveau champ after                    ***
       do k = 1, klev
-        if (JM(k) == 0) THEN
+        IF (JM(k) == 0) THEN
           htaft(k) = ht_mes(jm(k) + 1)
           hqaft(k) = hq_mes(jm(k) + 1)
@@ -232,5 +232,5 @@
             hqTurbaft(k) = hqTurb_mes(jm(k) + 1)
           endif ! Turb_fcg
-        else ! JM(k) .eq. 0
+        else ! JM(k) .EQ. 0
           htaft(k) = coef1(k) * ht_mes(jm(k)) + coef2(k) * ht_mes(jm(k) + 1)
           hqaft(k) = coef1(k) * hq_mes(jm(k)) + coef2(k) * hq_mes(jm(k) + 1)
@@ -246,5 +246,5 @@
                     & + coef2(k) * hqTurb_mes(jm(k) + 1)
           endif ! Turb_fcg
-        endif ! JM(k) .eq. 0
+        endif ! JM(k) .EQ. 0
       enddo
       tsaft = ts_subr
@@ -323,5 +323,5 @@
       read(97, 1000, end = 999) string
       1000 format (a4)
-      if (string == 'TDEF') go to 50
+      IF (string == 'TDEF') go to 50
     enddo
     50   backspace(97)
@@ -397,5 +397,5 @@
     !-----------------------------------------------------------------------
     do k = 1, klev
-      if (JM(k) == 0) THEN
+      IF (JM(k) == 0) THEN
         !FKC bug? ne faut il pas convertir tsol en tendance ????
         !RT bug taken care of by removing the stuff
@@ -411,5 +411,5 @@
           hqTurbaft(k) = hqTurb_mes(jm(k) + 1)
         endif ! Turb_fcg
-      else ! JM(k) .eq. 0
+      else ! JM(k) .EQ. 0
         htaft(k) = coef1(k) * ht_mes(jm(k)) + coef2(k) * ht_mes(jm(k) + 1)
         hqaft(k) = coef1(k) * hq_mes(jm(k)) + coef2(k) * hq_mes(jm(k) + 1)
@@ -425,5 +425,5 @@
                   & + coef2(k) * hqTurb_mes(jm(k) + 1)
         endif ! Turb_fcg
-      endif ! JM(k) .eq. 0
+      endif ! JM(k) .EQ. 0
     enddo
     tsaft = ts_subr
@@ -457,5 +457,5 @@
   SUBROUTINE advect_tvl(dtime, zt, zq, vu_f, vv_f, t_f, q_f                   &
           &, d_t_adv, d_q_adv)
-    use dimphy
+    USE dimphy
     IMPLICIT NONE
 
@@ -463,10 +463,10 @@
     !cccc      INCLUDE "dimphy.h"
 
-    integer k
-    real dtime, fact, du, dv, cx, cy, alx, aly
-    real zt(klev), zq(klev, 3)
-    real vu_f(klev), vv_f(klev), t_f(klev), q_f(klev, 3)
-
-    real d_t_adv(klev), d_q_adv(klev, 3)
+    INTEGER k
+    REAL dtime, fact, du, dv, cx, cy, alx, aly
+    REAL zt(klev), zq(klev, 3)
+    REAL vu_f(klev), vv_f(klev), t_f(klev), q_f(klev, 3)
+
+    REAL d_t_adv(klev), d_q_adv(klev, 3)
 
     ! Velocity of moving cell
@@ -509,7 +509,7 @@
     COMMON/com2_phys_gcss/playm, hplaym, nblvlm
 
-    integer k, klevgcm
-    real playgcm(klevgcm) ! pression en milieu de couche du gcm
-    real psolgcm
+    INTEGER k, klevgcm
+    REAL playgcm(klevgcm) ! pression en milieu de couche du gcm
+    REAL psolgcm
     character*80 file_forctl
 
@@ -584,5 +584,5 @@
     character*4 a
     character*80 aaa, anblvl, spaces
-    integer nch
+    INTEGER nch
 
     lu = 9
@@ -591,5 +591,5 @@
     do i = 1, 1000
       read(lu, 1000, end = 999) a
-      if (a == 'ZDEF') go to 100
+      IF (a == 'ZDEF') go to 100
     enddo
 
@@ -610,5 +610,5 @@
     read(lu, *) (playm(mlz), mlz = 1, nblvlm)
     !      Si la pression est en HPa, la multiplier par 100
-    if (playm(1) < 10000.) THEN
+    IF (playm(1) < 10000.) THEN
       do mlz = 1, nblvlm
         playm(mlz) = playm(mlz) * 100.
@@ -637,7 +637,7 @@
     IMPLICIT none
     INTEGER itape, icount, icomp, nl
-    real z(nl), ht(nl), hq(nl), hw(nl), hu(nl), hv(nl)
-    real hthtur(nl), hqtur(nl)
-    real ts
+    REAL z(nl), ht(nl), hq(nl), hw(nl), hu(nl), hv(nl)
+    REAL hthtur(nl), hqtur(nl)
+    REAL ts
 
     INTEGER k
@@ -729,12 +729,12 @@
     do k = 1, klev
       val = play(k)
-      if (val > playm(1)) THEN
+      IF (val > playm(1)) THEN
         mlz = 0
         JM(1) = mlz
         coef1(1) = (playm(mlz + 1) - val) / (playm(mlz + 1) - psol)
         coef2(1) = (val - psol) / (playm(mlz + 1) - psol)
-      else if (val > playm(nblvlm)) THEN
+      ELSE IF (val > playm(nblvlm)) THEN
         do mlz = 1, nblvlm
-          if (val <= playm(mlz).and. val > playm(mlz + 1))THEN
+          IF (val <= playm(mlz).AND. val > playm(mlz + 1))THEN
             JM(k) = mlz
             coef1(k) = (playm(mlz + 1) - val) / (playm(mlz + 1) - playm(mlz))
@@ -807,5 +807,5 @@
         IF(END==BEG - 2) END = LENGTH
         !*        PRINT *,'NTH,LENGTH,N,BEG,END=',NTH,LENGTH,N,BEG,END
-      end do
+      end DO
       NCH = END - BEG + 1
       IF(NCH>0) SST = STR(BEG:END)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_lmdz1d.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_lmdz1d.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_lmdz1d.F90	(revision 5117)
@@ -67,10 +67,10 @@
     !---------------------------------------------------------------------
 
-    integer, parameter :: ngrid = 1
+    INTEGER, parameter :: ngrid = 1
     REAL :: zcufi = 1.
     REAL :: zcvfi = 1.
 
     !-      REAL :: nat_surf
-    !-      logical :: ok_flux_surf
+    !-      LOGICAL :: ok_flux_surf
     !-      REAL :: fsens
     !-      REAL :: flat
@@ -107,8 +107,8 @@
 
     INTEGER :: kmax = llm
-    integer llm700, nq1, nq2
+    INTEGER llm700, nq1, nq2
     INTEGER, PARAMETER :: nlev_max = 1000, nqmx = 1000
-    real timestep, frac
-    real height(nlev_max), tttprof(nlev_max), qtprof(nlev_max)
+    REAL timestep, frac
+    REAL height(nlev_max), tttprof(nlev_max), qtprof(nlev_max)
     real  uprof(nlev_max), vprof(nlev_max), e12prof(nlev_max)
     real  ugprof(nlev_max), vgprof(nlev_max), wfls(nlev_max)
@@ -118,26 +118,26 @@
 
     !        INTEGER :: forcing_type
-    logical :: forcing_les = .FALSE.
-    logical :: forcing_armcu = .FALSE.
-    logical :: forcing_rico = .FALSE.
-    logical :: forcing_radconv = .FALSE.
-    logical :: forcing_toga = .FALSE.
-    logical :: forcing_twpice = .FALSE.
-    logical :: forcing_amma = .FALSE.
-    logical :: forcing_dice = .FALSE.
-    logical :: forcing_gabls4 = .FALSE.
-
-    logical :: forcing_GCM2SCM = .FALSE.
-    logical :: forcing_GCSSold = .FALSE.
-    logical :: forcing_sandu = .FALSE.
-    logical :: forcing_astex = .FALSE.
-    logical :: forcing_fire = .FALSE.
-    logical :: forcing_case = .FALSE.
-    logical :: forcing_case2 = .FALSE.
-    logical :: forcing_SCM = .FALSE.
+    LOGICAL :: forcing_les = .FALSE.
+    LOGICAL :: forcing_armcu = .FALSE.
+    LOGICAL :: forcing_rico = .FALSE.
+    LOGICAL :: forcing_radconv = .FALSE.
+    LOGICAL :: forcing_toga = .FALSE.
+    LOGICAL :: forcing_twpice = .FALSE.
+    LOGICAL :: forcing_amma = .FALSE.
+    LOGICAL :: forcing_dice = .FALSE.
+    LOGICAL :: forcing_gabls4 = .FALSE.
+
+    LOGICAL :: forcing_GCM2SCM = .FALSE.
+    LOGICAL :: forcing_GCSSold = .FALSE.
+    LOGICAL :: forcing_sandu = .FALSE.
+    LOGICAL :: forcing_astex = .FALSE.
+    LOGICAL :: forcing_fire = .FALSE.
+    LOGICAL :: forcing_case = .FALSE.
+    LOGICAL :: forcing_case2 = .FALSE.
+    LOGICAL :: forcing_SCM = .FALSE.
     INTEGER :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file
     !                                                            (cf read_tsurf1d.F)
 
-    real wwww
+    REAL wwww
     !vertical advection computation
     !       real d_t_z(llm), d_q_z(llm)
@@ -147,7 +147,7 @@
 
     !flag forcings
-    logical :: nudge_wind = .TRUE.
-    logical :: nudge_thermo = .FALSE.
-    logical :: cptadvw = .TRUE.
+    LOGICAL :: nudge_wind = .TRUE.
+    LOGICAL :: nudge_thermo = .FALSE.
+    LOGICAL :: cptadvw = .TRUE.
     !=====================================================================
     ! DECLARATIONS FOR EACH CASE
@@ -163,5 +163,5 @@
     INTEGER :: inudge_RHT = 1
     INTEGER :: inudge_UV = 2
-    logical :: nudge(nudge_max)
+    LOGICAL :: nudge(nudge_max)
     REAL :: t_targ(llm)
     REAL :: rh_targ(llm)
@@ -214,5 +214,5 @@
     !  Call to phyredem
     !---------------------------------------------------------------------
-    logical :: ok_writedem = .TRUE.
+    LOGICAL :: ok_writedem = .TRUE.
     REAL :: sollw_in = 0.
     REAL :: solsw_in = 0.
@@ -221,6 +221,6 @@
     !  Call to physiq
     !---------------------------------------------------------------------
-    logical :: firstcall = .TRUE.
-    logical :: lastcall = .FALSE.
+    LOGICAL :: firstcall = .TRUE.
+    LOGICAL :: lastcall = .FALSE.
     REAL :: phis(1) = 0.0
     REAL :: dpsrf(1)
@@ -229,14 +229,14 @@
     !  Initializations of boundary conditions
     !---------------------------------------------------------------------
-    real, allocatable :: phy_nat (:)  ! 0=ocean libre,1=land,2=glacier,3=banquise
-    real, allocatable :: phy_alb (:)  ! Albedo land only (old value condsurf_jyg=0.3)
-    real, allocatable :: phy_sst (:)  ! SST (will not be used; cf read_tsurf1d.F)
-    real, allocatable :: phy_bil (:)  ! Ne sert que pour les slab_ocean
-    real, allocatable :: phy_rug (:) ! Longueur rugosite utilisee sur land only
-    real, allocatable :: phy_ice (:) ! Fraction de glace
-    real, allocatable :: phy_fter(:) ! Fraction de terre
-    real, allocatable :: phy_foce(:) ! Fraction de ocean
-    real, allocatable :: phy_fsic(:) ! Fraction de glace
-    real, allocatable :: phy_flic(:) ! Fraction de glace
+    REAL, ALLOCATABLE :: phy_nat (:)  ! 0=ocean libre,1=land,2=glacier,3=banquise
+    REAL, ALLOCATABLE :: phy_alb (:)  ! Albedo land only (old value condsurf_jyg=0.3)
+    REAL, ALLOCATABLE :: phy_sst (:)  ! SST (will not be used; cf read_tsurf1d.F)
+    REAL, ALLOCATABLE :: phy_bil (:)  ! Ne sert que pour les slab_ocean
+    REAL, ALLOCATABLE :: phy_rug (:) ! Longueur rugosite utilisee sur land only
+    REAL, ALLOCATABLE :: phy_ice (:) ! Fraction de glace
+    REAL, ALLOCATABLE :: phy_fter(:) ! Fraction de terre
+    REAL, ALLOCATABLE :: phy_foce(:) ! Fraction de ocean
+    REAL, ALLOCATABLE :: phy_fsic(:) ! Fraction de glace
+    REAL, ALLOCATABLE :: phy_flic(:) ! Fraction de glace
 
     !---------------------------------------------------------------------
@@ -245,10 +245,10 @@
     INTEGER :: k, l, i, it = 1, mxcalc
     INTEGER :: nsrf
-    integer jcode
+    INTEGER jcode
     INTEGER read_climoz
 
     INTEGER :: it_end ! iteration number of the last call
     !Al1
-    integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
+    INTEGER ecrit_slab_oc !1=ecrit,-1=lit,0=no file
     data ecrit_slab_oc/-1/
 
@@ -355,5 +355,5 @@
     !             Radiation to be switched off
 
-    if (forcing_type <=0) THEN
+    IF (forcing_type <=0) THEN
       forcing_les = .TRUE.
     elseif (forcing_type ==1) THEN
@@ -446,8 +446,8 @@
 
     type_ts_forcing = 0
-    if (forcing_toga.or.forcing_sandu.or.forcing_astex .or. forcing_dice)                 &
+    IF (forcing_toga.OR.forcing_sandu.OR.forcing_astex .OR. forcing_dice)                 &
             type_ts_forcing = 1
 
-    ! Initialization of the logical switch for nudging
+    ! Initialization of the LOGICAL switch for nudging
     jcode = iflag_nudge
     do i = 1, nudge_max
@@ -484,14 +484,14 @@
 
     !      calend = 'earth_365d'
-    if (calend == 'earth_360d') THEN
+    IF (calend == 'earth_360d') THEN
       CALL ioconf_calendar('360_day')
       WRITE(*, *)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
-    else if (calend == 'earth_365d') THEN
+    ELSE IF (calend == 'earth_365d') THEN
       CALL ioconf_calendar('noleap')
       WRITE(*, *)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
-    else if (calend == 'earth_366d') THEN
+    ELSE IF (calend == 'earth_366d') THEN
       CALL ioconf_calendar('all_leap')
       WRITE(*, *)'CALENDRIER CHOISI: Terrestre bissextile'
-    else if (calend == 'gregorian') THEN
+    ELSE IF (calend == 'gregorian') THEN
       stop 'gregorian calend should not be used by normal user'
       CALL ioconf_calendar('gregorian') ! not to be used by normal users
@@ -509,5 +509,5 @@
     !      Le numero du jour est dans "day". L heure est traitee separement.
     !      La date complete est dans "daytime" (l'unite est le jour).
-    if (nday>0) THEN
+    IF (nday>0) THEN
       fnday = nday
     else
@@ -606,5 +606,5 @@
     CALL init_infotrac
 
-    if (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'
+    IF (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'
     allocate(q(llm, nqtot)) ; q(:, :) = 0.
     allocate(dq(llm, nqtot))
@@ -627,5 +627,5 @@
     CALL phys_state_var_init(read_climoz)
 
-    if (ngrid/=klon) THEN
+    IF (ngrid/=klon) THEN
       PRINT*, 'stop in inifis'
       PRINT*, 'Probleme de dimensions :'
@@ -655,5 +655,5 @@
     !! mpl et jyg le 22/08/2012 :
     !!  pour que les cas a flux de surface imposes marchent
-    IF(.NOT.ok_flux_surf.or.max(abs(wtsurf), abs(wqsurf))>0.) THEN
+    IF(.NOT.ok_flux_surf.OR.max(abs(wtsurf), abs(wqsurf))>0.) THEN
       fsens = -wtsurf * rcpd * rho(1)
       flat = -wqsurf * rlvtt * rho(1)
@@ -695,5 +695,5 @@
       do l = 1, llm
         WRITE(*, *) 'l,play(l),presnivs(l): ', l, play(l), presnivs(l)
-        if (trouve_700 .and. play(l)<=70000) THEN
+        IF (trouve_700 .AND. play(l)<=70000) THEN
           llm700 = l
           print *, 'llm700,play=', llm700, play(l) / 100.
@@ -812,20 +812,20 @@
         PRINT*, 'avant phyredem'
         pctsrf(1, :) = 0.
-        if (nat_surf==0.) THEN
+        IF (nat_surf==0.) THEN
         pctsrf(1, is_oce) = 1.
         pctsrf(1, is_ter) = 0.
         pctsrf(1, is_lic) = 0.
         pctsrf(1, is_sic) = 0.
-        else if (nat_surf == 1) THEN
+        ELSE IF (nat_surf == 1) THEN
         pctsrf(1, is_oce) = 0.
         pctsrf(1, is_ter) = 1.
         pctsrf(1, is_lic) = 0.
         pctsrf(1, is_sic) = 0.
-        else if (nat_surf == 2) THEN
+        ELSE IF (nat_surf == 2) THEN
         pctsrf(1, is_oce) = 0.
         pctsrf(1, is_ter) = 0.
         pctsrf(1, is_lic) = 1.
         pctsrf(1, is_sic) = 0.
-        else if (nat_surf == 3) THEN
+        ELSE IF (nat_surf == 3) THEN
         pctsrf(1, is_oce) = 0.
         pctsrf(1, is_ter) = 0.
@@ -856,5 +856,5 @@
                 pbl_tke(:, 2, :) = 1.e-2
                 PRINT *, ' pbl_tke dans lmdz1d '
-                if (prt_level >= 5) THEN
+                IF (prt_level >= 5) THEN
                 DO nsrf = 1, 4
                 PRINT *, 'pbl_tke(1,:,', nsrf, ') ', pbl_tke(1, :, nsrf)
@@ -936,5 +936,5 @@
                 CALL getin('iflag_physiq', iflag_physiq)
 
-                if (.not.restart) THEN
+                IF (.NOT.restart) THEN
                 iflag_pbl = 5
                 CALL phyredem ("startphy.nc")
@@ -1033,5 +1033,5 @@
                 DO while(it<=it_end)
 
-                if (prt_level>=1) THEN
+                IF (prt_level>=1) THEN
         PRINT*, 'XXXXXXXXXXXXXXXXXXX ITAP,day,time=', &
         it, day, time, it_end, day_step
@@ -1039,5 +1039,5 @@
         endif
         !Al1 demande de restartphy.nc
-        if (it==it_end) lastcall = .True.
+        IF (it==it_end) lastcall = .True.
 
         !---------------------------------------------------------------------
@@ -1125,5 +1125,5 @@
 
                 fcoriolis = 2. * sin(rpi * xlat / 180.) * romega
-        IF (forcing_radconv .or. forcing_fire) THEN
+        IF (forcing_radconv .OR. forcing_fire) THEN
         fcoriolis = 0.0
         dt_cooling = 0.0
@@ -1133,6 +1133,6 @@
                 !      PRINT*, 'calcul de fcoriolis ', fcoriolis
 
-                IF (forcing_toga .or. forcing_GCSSold .or. forcing_twpice            &
-                .or.forcing_amma .or. forcing_type==101) THEN
+                IF (forcing_toga .OR. forcing_GCSSold .OR. forcing_twpice            &
+                .OR.forcing_amma .OR. forcing_type==101) THEN
                 fcoriolis = 0.0 ; ug = 0. ; vg = 0.
                 END IF
@@ -1149,7 +1149,7 @@
         !on calcule dt_cooling
         do l = 1, llm
-        if (play(l)>=20000.) THEN
+        IF (play(l)>=20000.) THEN
         dt_cooling(l) = -1.5 / 86400.
-        elseif ((play(l)>=10000.).and.((play(l)<20000.))) THEN
+        elseif ((play(l)>=10000.).AND.((play(l)<20000.))) THEN
         dt_cooling(l) = -1.5 / 86400. * (play(l) - 10000.) / (10000.) - 1. / 86400. * (20000. - play(l)) / 10000. * (temp(l) - 200.)
                 else
@@ -1217,5 +1217,5 @@
         d_q_adv = 0.
         do l = 2, llm - 1
-        if (zlay(l)<=1100) THEN
+        IF (zlay(l)<=1100) THEN
         wwww = -0.00001 * zlay(l)
                 d_t_adv(l) = -wwww * (teta(l) - teta(l + 1)) / (zlay(l) - zlay(l + 1)) / (pzero / play(l))**rkappa
@@ -1242,5 +1242,5 @@
         ! pour les cas sandu et astex, on reclacule u,v,q,temp et teta dans 1D_nudge_sandu_astex.h
         ! au dessus de 700hpa, on relaxe vers les profils initiaux
-        if (forcing_sandu .OR. forcing_astex) THEN
+        IF (forcing_sandu .OR. forcing_astex) THEN
         INCLUDE "1D_nudge_sandu_astex.h"
         else
@@ -1258,5 +1258,5 @@
         + d_q_nudge(1:mxcalc, :))
 
-                if (prt_level>=3) THEN
+                IF (prt_level>=3) THEN
                 print *, &
                 'physiq-> temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) ', &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_scm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_scm.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_scm.F90	(revision 5117)
@@ -64,5 +64,5 @@
     !---------------------------------------------------------------------
 
-    integer, parameter :: ngrid = 1
+    INTEGER, parameter :: ngrid = 1
     REAL :: zcufi = 1.
     REAL :: zcvfi = 1.
@@ -80,8 +80,8 @@
 
     INTEGER :: kmax = llm
-    integer llm700, nq1, nq2
+    INTEGER llm700, nq1, nq2
     INTEGER, PARAMETER :: nlev_max = 1000, nqmx = 1000
-    real timestep, frac
-    real height(nlev_max), tttprof(nlev_max), qtprof(nlev_max)
+    REAL timestep, frac
+    REAL height(nlev_max), tttprof(nlev_max), qtprof(nlev_max)
     real  uprof(nlev_max), vprof(nlev_max), e12prof(nlev_max)
     real  ugprof(nlev_max), vgprof(nlev_max), wfls(nlev_max)
@@ -91,27 +91,27 @@
 
     !        INTEGER :: forcing_type
-    logical :: forcing_les = .FALSE.
-    logical :: forcing_armcu = .FALSE.
-    logical :: forcing_rico = .FALSE.
-    logical :: forcing_radconv = .FALSE.
-    logical :: forcing_toga = .FALSE.
-    logical :: forcing_twpice = .FALSE.
-    logical :: forcing_amma = .FALSE.
-    logical :: forcing_dice = .FALSE.
-    logical :: forcing_gabls4 = .FALSE.
-
-    logical :: forcing_GCM2SCM = .FALSE.
-    logical :: forcing_GCSSold = .FALSE.
-    logical :: forcing_sandu = .FALSE.
-    logical :: forcing_astex = .FALSE.
-    logical :: forcing_fire = .FALSE.
-    logical :: forcing_case = .FALSE.
-    logical :: forcing_case2 = .FALSE.
-    logical :: forcing_SCM = .FALSE.
+    LOGICAL :: forcing_les = .FALSE.
+    LOGICAL :: forcing_armcu = .FALSE.
+    LOGICAL :: forcing_rico = .FALSE.
+    LOGICAL :: forcing_radconv = .FALSE.
+    LOGICAL :: forcing_toga = .FALSE.
+    LOGICAL :: forcing_twpice = .FALSE.
+    LOGICAL :: forcing_amma = .FALSE.
+    LOGICAL :: forcing_dice = .FALSE.
+    LOGICAL :: forcing_gabls4 = .FALSE.
+
+    LOGICAL :: forcing_GCM2SCM = .FALSE.
+    LOGICAL :: forcing_GCSSold = .FALSE.
+    LOGICAL :: forcing_sandu = .FALSE.
+    LOGICAL :: forcing_astex = .FALSE.
+    LOGICAL :: forcing_fire = .FALSE.
+    LOGICAL :: forcing_case = .FALSE.
+    LOGICAL :: forcing_case2 = .FALSE.
+    LOGICAL :: forcing_SCM = .FALSE.
 
     !flag forcings
-    logical :: nudge_wind = .TRUE.
-    logical :: nudge_thermo = .FALSE.
-    logical :: cptadvw = .TRUE.
+    LOGICAL :: nudge_wind = .TRUE.
+    LOGICAL :: nudge_thermo = .FALSE.
+    LOGICAL :: cptadvw = .TRUE.
 
 
@@ -129,5 +129,5 @@
     INTEGER :: inudge_RHT = 1
     INTEGER :: inudge_UV = 2
-    logical :: nudge(nudge_max)
+    LOGICAL :: nudge(nudge_max)
     REAL :: t_targ(llm)
     REAL :: rh_targ(llm)
@@ -181,5 +181,5 @@
     !  Call to phyredem
     !---------------------------------------------------------------------
-    logical :: ok_writedem = .TRUE.
+    LOGICAL :: ok_writedem = .TRUE.
     REAL :: sollw_in = 0.
     REAL :: solsw_in = 0.
@@ -188,6 +188,6 @@
     !  Call to physiq
     !---------------------------------------------------------------------
-    logical :: firstcall = .TRUE.
-    logical :: lastcall = .FALSE.
+    LOGICAL :: firstcall = .TRUE.
+    LOGICAL :: lastcall = .FALSE.
     REAL :: phis(1) = 0.0
     REAL :: dpsrf(1)
@@ -196,14 +196,14 @@
     !  Initializations of boundary conditions
     !---------------------------------------------------------------------
-    real, allocatable :: phy_nat (:)  ! 0=ocean libre,1=land,2=glacier,3=banquise
-    real, allocatable :: phy_alb (:)  ! Albedo land only (old value condsurf_jyg=0.3)
-    real, allocatable :: phy_sst (:)  ! SST (will not be used; cf read_tsurf1d.F)
-    real, allocatable :: phy_bil (:)  ! Ne sert que pour les slab_ocean
-    real, allocatable :: phy_rug (:) ! Longueur rugosite utilisee sur land only
-    real, allocatable :: phy_ice (:) ! Fraction de glace
-    real, allocatable :: phy_fter(:) ! Fraction de terre
-    real, allocatable :: phy_foce(:) ! Fraction de ocean
-    real, allocatable :: phy_fsic(:) ! Fraction de glace
-    real, allocatable :: phy_flic(:) ! Fraction de glace
+    REAL, ALLOCATABLE :: phy_nat (:)  ! 0=ocean libre,1=land,2=glacier,3=banquise
+    REAL, ALLOCATABLE :: phy_alb (:)  ! Albedo land only (old value condsurf_jyg=0.3)
+    REAL, ALLOCATABLE :: phy_sst (:)  ! SST (will not be used; cf read_tsurf1d.F)
+    REAL, ALLOCATABLE :: phy_bil (:)  ! Ne sert que pour les slab_ocean
+    REAL, ALLOCATABLE :: phy_rug (:) ! Longueur rugosite utilisee sur land only
+    REAL, ALLOCATABLE :: phy_ice (:) ! Fraction de glace
+    REAL, ALLOCATABLE :: phy_fter(:) ! Fraction de terre
+    REAL, ALLOCATABLE :: phy_foce(:) ! Fraction de ocean
+    REAL, ALLOCATABLE :: phy_fsic(:) ! Fraction de glace
+    REAL, ALLOCATABLE :: phy_flic(:) ! Fraction de glace
 
     !---------------------------------------------------------------------
@@ -212,10 +212,10 @@
     INTEGER :: k, l, i, it = 1, mxcalc
     INTEGER :: nsrf
-    integer jcode
+    INTEGER jcode
     INTEGER read_climoz
 
     INTEGER :: it_end ! iteration number of the last call
     !Al1,plev,play,phi,phis,presnivs,
-    integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
+    INTEGER ecrit_slab_oc !1=ecrit,-1=lit,0=no file
     data ecrit_slab_oc/-1/
 
@@ -277,5 +277,5 @@
     PRINT*, 'NATURE DE LA SURFACE ', nat_surf
 
-    ! Initialization of the logical switch for nudging
+    ! Initialization of the LOGICAL switch for nudging
 
     jcode = iflag_nudge
@@ -315,14 +315,14 @@
 
     !      calend = 'earth_365d'
-    if (calend == 'earth_360d') THEN
+    IF (calend == 'earth_360d') THEN
       CALL ioconf_calendar('360_day')
       WRITE(*, *)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
-    else if (calend == 'earth_365d') THEN
+    ELSE IF (calend == 'earth_365d') THEN
       CALL ioconf_calendar('noleap')
       WRITE(*, *)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
-    else if (calend == 'earth_366d') THEN
+    ELSE IF (calend == 'earth_366d') THEN
       CALL ioconf_calendar('all_leap')
       WRITE(*, *)'CALENDRIER CHOISI: Terrestre bissextile'
-    else if (calend == 'gregorian') THEN
+    ELSE IF (calend == 'gregorian') THEN
       stop 'gregorian calend should not be used by normal user'
       CALL ioconf_calendar('gregorian') ! not to be used by normal users
@@ -341,5 +341,5 @@
     !      La date complete est dans "daytime" (l'unite est le jour).
 
-    if (nday>0) THEN
+    IF (nday>0) THEN
       fnday = nday
     else
@@ -383,5 +383,5 @@
     CALL init_infotrac
 
-    if (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'
+    IF (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'
     allocate(q(llm, nqtot)) ; q(:, :) = 0.
     allocate(dq(llm, nqtot))
@@ -404,5 +404,5 @@
     CALL phys_state_var_init(read_climoz)
 
-    if (ngrid/=klon) THEN
+    IF (ngrid/=klon) THEN
       PRINT*, 'stop in inifis'
       PRINT*, 'Probleme de dimensions :'
@@ -425,5 +425,5 @@
     !! mpl et jyg le 22/08/2012 :
     !!  pour que les cas a flux de surface imposes marchent
-    IF(.NOT.ok_flux_surf.or.max(abs(wtsurf), abs(wqsurf))>0.) THEN
+    IF(.NOT.ok_flux_surf.OR.max(abs(wtsurf), abs(wqsurf))>0.) THEN
       fsens = -wtsurf * rcpd * rho(1)
       flat = -wqsurf * rlvtt * rho(1)
@@ -461,5 +461,5 @@
       do l = 1, llm
         WRITE(*, *) 'l,play(l),presnivs(l): ', l, play(l), presnivs(l)
-        if (trouve_700 .and. play(l)<=70000) THEN
+        IF (trouve_700 .AND. play(l)<=70000) THEN
           llm700 = l
           print *, 'llm700,play=', llm700, play(l) / 100.
@@ -477,8 +477,8 @@
   PRINT*, 'A d_t_adv ', d_t_adv(1:20)*86400
 
-  if (forcing_GCM2SCM) THEN
+  IF (forcing_GCM2SCM) THEN
   write (*, *) 'forcing_GCM2SCM not yet implemented'
   stop 'in initialization'
-  endif ! forcing_GCM2SCM
+  ENDIF ! forcing_GCM2SCM
 
 
@@ -536,5 +536,5 @@
   ! On le met juste avant pour avoir acces a tous les champs
 
-  if (ok_writedem) THEN
+  IF (ok_writedem) THEN
   !--------------------------------------------------------------------------
   ! pbl_surface_init (called here) and pbl_surface_final (called by phyredem)
@@ -574,20 +574,20 @@
   PRINT*, 'avant phyredem'
   pctsrf(1, :) = 0.
-  if (nat_surf==0.) THEN
+  IF (nat_surf==0.) THEN
   pctsrf(1, is_oce) = 1.
   pctsrf(1, is_ter) = 0.
   pctsrf(1, is_lic) = 0.
   pctsrf(1, is_sic) = 0.
-  else if (nat_surf == 1) THEN
+  ELSE IF (nat_surf == 1) THEN
   pctsrf(1, is_oce) = 0.
   pctsrf(1, is_ter) = 1.
   pctsrf(1, is_lic) = 0.
   pctsrf(1, is_sic) = 0.
-  else if (nat_surf == 2) THEN
+  ELSE IF (nat_surf == 2) THEN
   pctsrf(1, is_oce) = 0.
   pctsrf(1, is_ter) = 0.
   pctsrf(1, is_lic) = 1.
   pctsrf(1, is_sic) = 0.
-  else if (nat_surf == 3) THEN
+  ELSE IF (nat_surf == 3) THEN
   pctsrf(1, is_oce) = 0.
   pctsrf(1, is_ter) = 0.
@@ -693,5 +693,5 @@
                 CALL getin('iflag_physiq', iflag_physiq)
 
-                if (.not.restart) THEN
+                IF (.NOT.restart) THEN
         iflag_pbl = 5
         CALL phyredem ("startphy.nc")
@@ -735,5 +735,5 @@
                 CALL phys_state_var_end
                 !Al1
-                if (restart) THEN
+                IF (restart) THEN
                 PRINT*, 'CALL to restart dyn 1d'
                 Call dyn1deta0("start1dyn.nc", plev, play, phi, phis,presnivs, &
@@ -782,10 +782,10 @@
                 do while(it<=it_end)
 
-                if (prt_level>=1) THEN
+                IF (prt_level>=1) THEN
         PRINT*, 'XXXXXXXXXXXXXXXXXXX ITAP,day,time=', &
         it, day, time, it_end, day_step
         PRINT*,'PAS DE TEMPS ', timestep
         endif
-        if (it==it_end) lastcall = .True.
+        IF (it==it_end) lastcall = .True.
 
         !---------------------------------------------------------------------
@@ -842,10 +842,10 @@
                 ! Listing output for debug prt_level>=1
                 !---------------------------------------------------------------------
-                if (prt_level>=1) THEN
+                IF (prt_level>=1) THEN
                 print *, ' avant physiq : -------- day time ', day, time
                         WRITE(*, *) 'firstcall,lastcall,phis', &
                 firstcall, lastcall, phis
                 end if
-                        if (prt_level>=5) THEN
+                        IF (prt_level>=5) THEN
                 WRITE(*, '(a10,2a4,4a13)') 'BEFOR1 IT=', 'it', 'l', &
                 'presniv', 'plev','play', 'phi'
@@ -871,5 +871,5 @@
                         ! Listing output for debug
                         !---------------------------------------------------------------------
-                        if (prt_level>=5) THEN
+                        IF (prt_level>=5) THEN
                         WRITE(*, '(a11,2a4,4a13)') 'AFTER1 IT=', 'it', 'l', &
                         'presniv', 'plev','play', 'phi'
@@ -1017,5 +1017,5 @@
         +d_q_nudge(1:mxcalc, :))
 
-                if (prt_level>=3) THEN
+                IF (prt_level>=3) THEN
                 print *, &
                 'physiq-> temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) ', &
@@ -1072,5 +1072,5 @@
                 !   Air temperature :
                 !---------------------------------------------------------------------
-                if (lastcall) THEN
+                IF (lastcall) THEN
                 PRINT*, 'Pas de temps final ', it
                 CALL ju2ymds(daytime, an, mois, jour, heure)
@@ -1089,5 +1089,5 @@
                 enddo
 
-                if (ecrit_slab_oc/=-1) close(97)
+                IF (ecrit_slab_oc/=-1) close(97)
 
         !Al1 Call to 1D equivalent of dynredem (an,mois,jour,heure ?)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_amma_read.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_amma_read.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_amma_read.F90	(revision 5117)
@@ -6,50 +6,50 @@
         character*80 :: fich_amma
 ! Option du cas AMMA ou on impose la discretisation verticale (Ap,Bp)
-        integer nlev_amma, nt_amma
-
-        integer year_ini_amma, day_ini_amma, mth_ini_amma
-        real heure_ini_amma
-        real day_ju_ini_amma   ! Julian day of amma first day
+        INTEGER nlev_amma, nt_amma
+
+        INTEGER year_ini_amma, day_ini_amma, mth_ini_amma
+        REAL heure_ini_amma
+        REAL day_ju_ini_amma   ! Julian day of amma first day
         parameter (year_ini_amma=2006)
         parameter (mth_ini_amma=7)
         parameter (day_ini_amma=10)  ! 10 = 10Juil2006
         parameter (heure_ini_amma=0.) !0h en secondes
-        real dt_amma
+        REAL dt_amma
         parameter (dt_amma=1800.)
 
 !profils initiaux:
-        real, allocatable::  plev_amma(:)
-
-        real, allocatable::  z_amma(:)
-        real, allocatable::  th_amma(:),q_amma(:)
-        real, allocatable::  u_amma(:)
-        real, allocatable::  v_amma(:)
-
-        real, allocatable::  th_ammai(:),q_ammai(:)
-        real, allocatable::  u_ammai(:)
-        real, allocatable::  v_ammai(:)
-        real, allocatable::  vitw_ammai(:)
-        real, allocatable::  ht_ammai(:)
-        real, allocatable::  hq_ammai(:)
-        real, allocatable::  vt_ammai(:)
-        real, allocatable::  vq_ammai(:)
+        REAL, ALLOCATABLE::  plev_amma(:)
+
+        REAL, ALLOCATABLE::  z_amma(:)
+        REAL, ALLOCATABLE::  th_amma(:),q_amma(:)
+        REAL, ALLOCATABLE::  u_amma(:)
+        REAL, ALLOCATABLE::  v_amma(:)
+
+        REAL, ALLOCATABLE::  th_ammai(:),q_ammai(:)
+        REAL, ALLOCATABLE::  u_ammai(:)
+        REAL, ALLOCATABLE::  v_ammai(:)
+        REAL, ALLOCATABLE::  vitw_ammai(:)
+        REAL, ALLOCATABLE::  ht_ammai(:)
+        REAL, ALLOCATABLE::  hq_ammai(:)
+        REAL, ALLOCATABLE::  vt_ammai(:)
+        REAL, ALLOCATABLE::  vq_ammai(:)
 
 !forcings
-        real, allocatable::  ht_amma(:,:)
-        real, allocatable::  hq_amma(:,:)
-        real, allocatable::  vitw_amma(:,:)
-        real, allocatable::  lat_amma(:),sens_amma(:)
+        REAL, ALLOCATABLE::  ht_amma(:,:)
+        REAL, ALLOCATABLE::  hq_amma(:,:)
+        REAL, ALLOCATABLE::  vitw_amma(:,:)
+        REAL, ALLOCATABLE::  lat_amma(:),sens_amma(:)
 
 !champs interpoles
-        real, allocatable::  vitw_profamma(:)
-        real, allocatable::  ht_profamma(:)
-        real, allocatable::  hq_profamma(:)
-        real lat_profamma,sens_profamma
-        real, allocatable::  vt_profamma(:)
-        real, allocatable::  vq_profamma(:)
-        real, allocatable::  th_profamma(:)
-        real, allocatable::  q_profamma(:)
-        real, allocatable::  u_profamma(:)
-        real, allocatable::  v_profamma(:)
+        REAL, ALLOCATABLE::  vitw_profamma(:)
+        REAL, ALLOCATABLE::  ht_profamma(:)
+        REAL, ALLOCATABLE::  hq_profamma(:)
+        REAL lat_profamma,sens_profamma
+        REAL, ALLOCATABLE::  vt_profamma(:)
+        REAL, ALLOCATABLE::  vq_profamma(:)
+        REAL, ALLOCATABLE::  th_profamma(:)
+        REAL, ALLOCATABLE::  q_profamma(:)
+        REAL, ALLOCATABLE::  u_profamma(:)
+        REAL, ALLOCATABLE::  v_profamma(:)
 
 
@@ -65,5 +65,5 @@
       ierr = nf90_open(fich_amma,nf90_nowrite,nid)
       PRINT*,'fich_amma,nf90_nowrite,nid ',fich_amma,nf90_nowrite,nid
-      if (ierr/=nf90_noerr) THEN
+      IF (ierr/=nf90_noerr) THEN
          WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
          WRITE(*,*) nf90_strerror(ierr)
@@ -178,20 +178,20 @@
       IMPLICIT NONE
 
-      integer ntime,nlevel
-
-      real zz(nlevel)
-      real temp(nlevel),pp(nlevel)
-      real qv(nlevel),u(nlevel)
-      real v(nlevel)
-      real dw(nlevel,ntime)
-      real dt(nlevel,ntime)
-      real dq(nlevel,ntime)
-      real flat(ntime),sens(ntime)
-
-
-      integer nid, ierr,rid
-      integer nbvar3d
+      INTEGER ntime,nlevel
+
+      REAL zz(nlevel)
+      REAL temp(nlevel),pp(nlevel)
+      REAL qv(nlevel),u(nlevel)
+      REAL v(nlevel)
+      REAL dw(nlevel,ntime)
+      REAL dt(nlevel,ntime)
+      REAL dq(nlevel,ntime)
+      REAL flat(ntime),sens(ntime)
+
+
+      INTEGER nid, ierr,rid
+      INTEGER nbvar3d
       parameter(nbvar3d=30)
-      integer var3didin(nbvar3d)
+      INTEGER var3didin(nbvar3d)
 
        ierr=nf90_inq_varid(nid,"zz",var3didin(1))
@@ -362,36 +362,36 @@
 
 ! inputs:
-        integer annee_ref
-        integer nt_amma,nlev_amma
-        integer year_ini_amma
-        real day, day1,day_ini_amma,dt_amma
-        real vitw_amma(nlev_amma,nt_amma)
-        real ht_amma(nlev_amma,nt_amma)
-        real hq_amma(nlev_amma,nt_amma)
-        real lat_amma(nt_amma)
-        real sens_amma(nt_amma)
+        INTEGER annee_ref
+        INTEGER nt_amma,nlev_amma
+        INTEGER year_ini_amma
+        REAL day, day1,day_ini_amma,dt_amma
+        REAL vitw_amma(nlev_amma,nt_amma)
+        REAL ht_amma(nlev_amma,nt_amma)
+        REAL hq_amma(nlev_amma,nt_amma)
+        REAL lat_amma(nt_amma)
+        REAL sens_amma(nt_amma)
 ! outputs:
-        real vitw_prof(nlev_amma)
-        real ht_prof(nlev_amma)
-        real hq_prof(nlev_amma)
-        real lat_prof,sens_prof
+        REAL vitw_prof(nlev_amma)
+        REAL ht_prof(nlev_amma)
+        REAL hq_prof(nlev_amma)
+        REAL lat_prof,sens_prof
 ! local:
-        integer it_amma1, it_amma2,k
-        real timeit,time_amma1,time_amma2,frac
-
-
-        if (forcing_type==6) THEN
+        INTEGER it_amma1, it_amma2,k
+        REAL timeit,time_amma1,time_amma2,frac
+
+
+        IF (forcing_type==6) THEN
 ! Check that initial day of the simulation consistent with AMMA case:
-       if (annee_ref/=2006) THEN
+       IF (annee_ref/=2006) THEN
         PRINT*,'Pour AMMA, annee_ref doit etre 2006'
         PRINT*,'Changer annee_ref dans run.def'
         stop
        endif
-       if (annee_ref==2006 .and. day1<day_ini_amma) THEN
+       IF (annee_ref==2006 .AND. day1<day_ini_amma) THEN
         PRINT*,'AMMA a débuté le 10 juillet 2006',day1,day_ini_amma
         PRINT*,'Changer dayref dans run.def'
         stop
        endif
-       if (annee_ref==2006 .and. day1>day_ini_amma+1) THEN
+       IF (annee_ref==2006 .AND. day1>day_ini_amma+1) THEN
         PRINT*,'AMMA a fini le 11 juillet'
         PRINT*,'Changer dayref ou nday dans run.def'
@@ -402,5 +402,5 @@
 ! Determine timestep relative to the 1st day of AMMA:
 !       timeit=(day-day1)*86400.
-!       if (annee_ref.eq.1992) THEN
+!       if (annee_ref.EQ.1992) THEN
 !        timeit=(day-day_ini_toga)*86400.
 !       else
@@ -424,5 +424,5 @@
        time_amma2=(it_amma2-1)*dt_amma
 
-       if (it_amma1 > nt_amma) THEN
+       IF (it_amma1 > nt_amma) THEN
         WRITE(*,*) 'PB-stop: day, it_amma1, it_amma2, timeit: '            &
           ,day,day_ini_amma,it_amma1,it_amma2,timeit/86400.
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read.F90	(revision 5117)
@@ -7,5 +7,5 @@
         character*80 :: fich_cas
 ! Discr?tisation
-        integer nlev_cas, nt_cas
+        INTEGER nlev_cas, nt_cas
 
 
@@ -31,54 +31,54 @@
 
 !profils environnementaux
-        real, allocatable::  plev_cas(:,:)
-
-        real, allocatable::  z_cas(:,:)
-        real, allocatable::  t_cas(:,:),q_cas(:,:),rh_cas(:,:)
-        real, allocatable::  th_cas(:,:),rv_cas(:,:)
-        real, allocatable::  u_cas(:,:)
-        real, allocatable::  v_cas(:,:)
+        REAL, ALLOCATABLE::  plev_cas(:,:)
+
+        REAL, ALLOCATABLE::  z_cas(:,:)
+        REAL, ALLOCATABLE::  t_cas(:,:),q_cas(:,:),rh_cas(:,:)
+        REAL, ALLOCATABLE::  th_cas(:,:),rv_cas(:,:)
+        REAL, ALLOCATABLE::  u_cas(:,:)
+        REAL, ALLOCATABLE::  v_cas(:,:)
 
 !forcing
-        real, allocatable::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
-        real, allocatable::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
-        real, allocatable::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
-        real, allocatable::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
-        real, allocatable::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
-        real, allocatable::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
-        real, allocatable::  vitw_cas(:,:)
-        real, allocatable::  ug_cas(:,:),vg_cas(:,:)
-        real, allocatable::  lat_cas(:),sens_cas(:),ts_cas(:),ustar_cas(:)
-        real, allocatable::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:)
+        REAL, ALLOCATABLE::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
+        REAL, ALLOCATABLE::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
+        REAL, ALLOCATABLE::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
+        REAL, ALLOCATABLE::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
+        REAL, ALLOCATABLE::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
+        REAL, ALLOCATABLE::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
+        REAL, ALLOCATABLE::  vitw_cas(:,:)
+        REAL, ALLOCATABLE::  ug_cas(:,:),vg_cas(:,:)
+        REAL, ALLOCATABLE::  lat_cas(:),sens_cas(:),ts_cas(:),ustar_cas(:)
+        REAL, ALLOCATABLE::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:)
 
 !champs interpoles
-        real, allocatable::  plev_prof_cas(:)
-        real, allocatable::  t_prof_cas(:)
-        real, allocatable::  q_prof_cas(:)
-        real, allocatable::  u_prof_cas(:)
-        real, allocatable::  v_prof_cas(:)
-
-        real, allocatable::  vitw_prof_cas(:)
-        real, allocatable::  ug_prof_cas(:)
-        real, allocatable::  vg_prof_cas(:)
-        real, allocatable::  ht_prof_cas(:)
-        real, allocatable::  hq_prof_cas(:)
-        real, allocatable::  vt_prof_cas(:)
-        real, allocatable::  vq_prof_cas(:)
-        real, allocatable::  dt_prof_cas(:)
-        real, allocatable::  dtrad_prof_cas(:)
-        real, allocatable::  dq_prof_cas(:)
-        real, allocatable::  hu_prof_cas(:)
-        real, allocatable::  hv_prof_cas(:)
-        real, allocatable::  vu_prof_cas(:)
-        real, allocatable::  vv_prof_cas(:)
-        real, allocatable::  du_prof_cas(:)
-        real, allocatable::  dv_prof_cas(:)
-        real, allocatable::  uw_prof_cas(:)
-        real, allocatable::  vw_prof_cas(:)
-        real, allocatable::  q1_prof_cas(:)
-        real, allocatable::  q2_prof_cas(:)
-
-
-        real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
+        REAL, ALLOCATABLE::  plev_prof_cas(:)
+        REAL, ALLOCATABLE::  t_prof_cas(:)
+        REAL, ALLOCATABLE::  q_prof_cas(:)
+        REAL, ALLOCATABLE::  u_prof_cas(:)
+        REAL, ALLOCATABLE::  v_prof_cas(:)
+
+        REAL, ALLOCATABLE::  vitw_prof_cas(:)
+        REAL, ALLOCATABLE::  ug_prof_cas(:)
+        REAL, ALLOCATABLE::  vg_prof_cas(:)
+        REAL, ALLOCATABLE::  ht_prof_cas(:)
+        REAL, ALLOCATABLE::  hq_prof_cas(:)
+        REAL, ALLOCATABLE::  vt_prof_cas(:)
+        REAL, ALLOCATABLE::  vq_prof_cas(:)
+        REAL, ALLOCATABLE::  dt_prof_cas(:)
+        REAL, ALLOCATABLE::  dtrad_prof_cas(:)
+        REAL, ALLOCATABLE::  dq_prof_cas(:)
+        REAL, ALLOCATABLE::  hu_prof_cas(:)
+        REAL, ALLOCATABLE::  hv_prof_cas(:)
+        REAL, ALLOCATABLE::  vu_prof_cas(:)
+        REAL, ALLOCATABLE::  vv_prof_cas(:)
+        REAL, ALLOCATABLE::  du_prof_cas(:)
+        REAL, ALLOCATABLE::  dv_prof_cas(:)
+        REAL, ALLOCATABLE::  uw_prof_cas(:)
+        REAL, ALLOCATABLE::  vw_prof_cas(:)
+        REAL, ALLOCATABLE::  q1_prof_cas(:)
+        REAL, ALLOCATABLE::  q2_prof_cas(:)
+
+
+        REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
 
 
@@ -95,5 +95,5 @@
       ierr = nf90_open(fich_cas,nf90_nowrite,nid)
       PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
-      if (ierr/=nf90_noerr) THEN
+      IF (ierr/=nf90_noerr) THEN
          WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
          WRITE(*,*) nf90_strerror(ierr)
@@ -261,30 +261,30 @@
 !program reading forcing of the case study
 
-      integer ntime,nlevel
-
-      real zz(nlevel,ntime)
-      real pp(nlevel,ntime)
-      real temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
-      real theta(nlevel,ntime),rv(nlevel,ntime)
-      real u(nlevel,ntime)
-      real v(nlevel,ntime)
-      real ug(nlevel,ntime)
-      real vg(nlevel,ntime)
-      real w(nlevel,ntime)
-      real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
-      real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
-      real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
-      real dtrad(nlevel,ntime)
-      real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
-      real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
-      real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
-      real flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
-      real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
-
-
-      integer nid, ierr,rid
-      integer nbvar3d
+      INTEGER ntime,nlevel
+
+      REAL zz(nlevel,ntime)
+      REAL pp(nlevel,ntime)
+      REAL temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
+      REAL theta(nlevel,ntime),rv(nlevel,ntime)
+      REAL u(nlevel,ntime)
+      REAL v(nlevel,ntime)
+      REAL ug(nlevel,ntime)
+      REAL vg(nlevel,ntime)
+      REAL w(nlevel,ntime)
+      REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
+      REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
+      REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
+      REAL dtrad(nlevel,ntime)
+      REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
+      REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
+      REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
+      REAL flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
+      REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
+
+
+      INTEGER nid, ierr,rid
+      INTEGER nbvar3d
       parameter(nbvar3d=39)
-      integer var3didin(nbvar3d)
+      INTEGER var3didin(nbvar3d)
 
        ierr=nf90_inq_varid(nid,"zz",var3didin(1))
@@ -834,39 +834,39 @@
 
 ! inputs:
-        integer annee_ref
-        integer nt_cas,nlev_cas
-        real day, day1,day_cas
-        real ts_cas(nt_cas)
-        real plev_cas(nlev_cas,nt_cas)
-        real t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
-        real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
-        real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
-        real vitw_cas(nlev_cas,nt_cas)
-        real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
-        real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
-        real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
-        real dtrad_cas(nlev_cas,nt_cas)
-        real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
-        real lat_cas(nt_cas)
-        real sens_cas(nt_cas)
-        real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
-        real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
+        INTEGER annee_ref
+        INTEGER nt_cas,nlev_cas
+        REAL day, day1,day_cas
+        REAL ts_cas(nt_cas)
+        REAL plev_cas(nlev_cas,nt_cas)
+        REAL t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
+        REAL u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
+        REAL ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
+        REAL vitw_cas(nlev_cas,nt_cas)
+        REAL du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
+        REAL dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
+        REAL dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
+        REAL dtrad_cas(nlev_cas,nt_cas)
+        REAL dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
+        REAL lat_cas(nt_cas)
+        REAL sens_cas(nt_cas)
+        REAL ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
+        REAL q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
 
 ! outputs:
-        real plev_prof_cas(nlev_cas)
-        real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
-        real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
-        real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
-        real vitw_prof_cas(nlev_cas)
-        real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
-        real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
-        real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
-        real dtrad_prof_cas(nlev_cas)
-        real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
-        real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
-        real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
+        REAL plev_prof_cas(nlev_cas)
+        REAL t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
+        REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
+        REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
+        REAL vitw_prof_cas(nlev_cas)
+        REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
+        REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
+        REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
+        REAL dtrad_prof_cas(nlev_cas)
+        REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
+        REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
+        REAL uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
 ! local:
-        integer it_cas1, it_cas2,k
-        real timeit,time_cas1,time_cas2,frac
+        INTEGER it_cas1, it_cas2,k
+        REAL timeit,time_cas1,time_cas2,frac
 
 
@@ -877,17 +877,17 @@
 ! sont censes etre corrects.
 ! A supprimer a terme (MPL 20150623)
-!     if ((forcing_type.eq.10).and.(1.eq.0)) THEN
+!     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
 ! Check that initial day of the simulation consistent with AMMA case:
-!      if (annee_ref.ne.2006) THEN
+!      if (annee_ref.NE.2006) THEN
 !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
 !       PRINT*,'Changer annee_ref dans run.def'
 !       stop
 !      endif
-!      if (annee_ref.eq.2006 .and. day1.lt.day_cas) THEN
+!      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
 !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
 !       PRINT*,'Changer dayref dans run.def'
 !       stop
 !      endif
-!      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) THEN
+!      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
 !       PRINT*,'AMMA a fini le 11 juillet'
 !       PRINT*,'Changer dayref ou nday dans run.def'
@@ -898,5 +898,5 @@
 ! Determine timestep relative to the 1st day:
 !       timeit=(day-day1)*86400.
-!       if (annee_ref.eq.1992) THEN
+!       if (annee_ref.EQ.1992) THEN
 !        timeit=(day-day_cas)*86400.
 !       else
@@ -929,5 +929,5 @@
       print *,'time_cas2=',time_cas2
 
-       if (it_cas1 > nt_cas) THEN
+       IF (it_cas1 > nt_cas) THEN
         WRITE(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
           ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read2.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read2.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read2.F90	(revision 5117)
@@ -9,69 +9,69 @@
   character*80 :: fich_cas
   ! Discr?tisation 
-  integer nlev_cas, nt_cas
+  INTEGER nlev_cas, nt_cas
 
 
   !profils environnementaux
-  real, allocatable::  plev_cas(:,:),plevh_cas(:)
-  real, allocatable::  ap_cas(:),bp_cas(:)
-
-  real, allocatable::  z_cas(:,:),zh_cas(:)
-  real, allocatable::  t_cas(:,:),q_cas(:,:),qv_cas(:,:),ql_cas(:,:),qi_cas(:,:),rh_cas(:,:)
-  real, allocatable::  th_cas(:,:),thv_cas(:,:),thl_cas(:,:),rv_cas(:,:)
-  real, allocatable::  u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:)
+  REAL, ALLOCATABLE::  plev_cas(:,:),plevh_cas(:)
+  REAL, ALLOCATABLE::  ap_cas(:),bp_cas(:)
+
+  REAL, ALLOCATABLE::  z_cas(:,:),zh_cas(:)
+  REAL, ALLOCATABLE::  t_cas(:,:),q_cas(:,:),qv_cas(:,:),ql_cas(:,:),qi_cas(:,:),rh_cas(:,:)
+  REAL, ALLOCATABLE::  th_cas(:,:),thv_cas(:,:),thl_cas(:,:),rv_cas(:,:)
+  REAL, ALLOCATABLE::  u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:)
 
   !forcing
-  real, allocatable::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
-  real, allocatable::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
-  real, allocatable::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
-  real, allocatable::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
-  real, allocatable::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
-  real, allocatable::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
-  real, allocatable::  ug_cas(:,:),vg_cas(:,:)
-  real, allocatable::  lat_cas(:),sens_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:)
-  real, allocatable::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tke_cas(:)
+  REAL, ALLOCATABLE::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
+  REAL, ALLOCATABLE::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
+  REAL, ALLOCATABLE::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
+  REAL, ALLOCATABLE::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
+  REAL, ALLOCATABLE::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
+  REAL, ALLOCATABLE::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
+  REAL, ALLOCATABLE::  ug_cas(:,:),vg_cas(:,:)
+  REAL, ALLOCATABLE::  lat_cas(:),sens_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:)
+  REAL, ALLOCATABLE::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tke_cas(:)
 
   !champs interpoles
-  real, allocatable::  plev_prof_cas(:)
-  real, allocatable::  t_prof_cas(:)
-  real, allocatable::  theta_prof_cas(:)
-  real, allocatable::  thl_prof_cas(:)
-  real, allocatable::  thv_prof_cas(:)
-  real, allocatable::  q_prof_cas(:)
-  real, allocatable::  qv_prof_cas(:)
-  real, allocatable::  ql_prof_cas(:)
-  real, allocatable::  qi_prof_cas(:)
-  real, allocatable::  rh_prof_cas(:)
-  real, allocatable::  rv_prof_cas(:)
-  real, allocatable::  u_prof_cas(:)
-  real, allocatable::  v_prof_cas(:)        
-  real, allocatable::  vitw_prof_cas(:)
-  real, allocatable::  omega_prof_cas(:)
-  real, allocatable::  ug_prof_cas(:)
-  real, allocatable::  vg_prof_cas(:)
-  real, allocatable::  ht_prof_cas(:)
-  real, allocatable::  hth_prof_cas(:)
-  real, allocatable::  hq_prof_cas(:)
-  real, allocatable::  vt_prof_cas(:)
-  real, allocatable::  vth_prof_cas(:)
-  real, allocatable::  vq_prof_cas(:)
-  real, allocatable::  dt_prof_cas(:)
-  real, allocatable::  dth_prof_cas(:)
-  real, allocatable::  dtrad_prof_cas(:)
-  real, allocatable::  dq_prof_cas(:)
-  real, allocatable::  hu_prof_cas(:)
-  real, allocatable::  hv_prof_cas(:)
-  real, allocatable::  vu_prof_cas(:)
-  real, allocatable::  vv_prof_cas(:)
-  real, allocatable::  du_prof_cas(:)
-  real, allocatable::  dv_prof_cas(:)
-  real, allocatable::  uw_prof_cas(:)
-  real, allocatable::  vw_prof_cas(:)
-  real, allocatable::  q1_prof_cas(:)
-  real, allocatable::  q2_prof_cas(:)
-
-
-  real lat_prof_cas,sens_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas,tke_prof_cas
-  real o3_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas
+  REAL, ALLOCATABLE::  plev_prof_cas(:)
+  REAL, ALLOCATABLE::  t_prof_cas(:)
+  REAL, ALLOCATABLE::  theta_prof_cas(:)
+  REAL, ALLOCATABLE::  thl_prof_cas(:)
+  REAL, ALLOCATABLE::  thv_prof_cas(:)
+  REAL, ALLOCATABLE::  q_prof_cas(:)
+  REAL, ALLOCATABLE::  qv_prof_cas(:)
+  REAL, ALLOCATABLE::  ql_prof_cas(:)
+  REAL, ALLOCATABLE::  qi_prof_cas(:)
+  REAL, ALLOCATABLE::  rh_prof_cas(:)
+  REAL, ALLOCATABLE::  rv_prof_cas(:)
+  REAL, ALLOCATABLE::  u_prof_cas(:)
+  REAL, ALLOCATABLE::  v_prof_cas(:)
+  REAL, ALLOCATABLE::  vitw_prof_cas(:)
+  REAL, ALLOCATABLE::  omega_prof_cas(:)
+  REAL, ALLOCATABLE::  ug_prof_cas(:)
+  REAL, ALLOCATABLE::  vg_prof_cas(:)
+  REAL, ALLOCATABLE::  ht_prof_cas(:)
+  REAL, ALLOCATABLE::  hth_prof_cas(:)
+  REAL, ALLOCATABLE::  hq_prof_cas(:)
+  REAL, ALLOCATABLE::  vt_prof_cas(:)
+  REAL, ALLOCATABLE::  vth_prof_cas(:)
+  REAL, ALLOCATABLE::  vq_prof_cas(:)
+  REAL, ALLOCATABLE::  dt_prof_cas(:)
+  REAL, ALLOCATABLE::  dth_prof_cas(:)
+  REAL, ALLOCATABLE::  dtrad_prof_cas(:)
+  REAL, ALLOCATABLE::  dq_prof_cas(:)
+  REAL, ALLOCATABLE::  hu_prof_cas(:)
+  REAL, ALLOCATABLE::  hv_prof_cas(:)
+  REAL, ALLOCATABLE::  vu_prof_cas(:)
+  REAL, ALLOCATABLE::  vv_prof_cas(:)
+  REAL, ALLOCATABLE::  du_prof_cas(:)
+  REAL, ALLOCATABLE::  dv_prof_cas(:)
+  REAL, ALLOCATABLE::  uw_prof_cas(:)
+  REAL, ALLOCATABLE::  vw_prof_cas(:)
+  REAL, ALLOCATABLE::  q1_prof_cas(:)
+  REAL, ALLOCATABLE::  q2_prof_cas(:)
+
+
+  REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas,tke_prof_cas
+  REAL o3_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas
 
 
@@ -89,5 +89,5 @@
     ierr = nf90_open(fich_cas,nf90_nowrite,nid)
     PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
-    if (ierr/=nf90_noerr) THEN
+    IF (ierr/=nf90_noerr) THEN
        WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
        WRITE(*,*) nf90_strerror(ierr)
@@ -198,5 +198,5 @@
     ierr = nf90_open(fich_cas,nf90_nowrite,nid)
     PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
-    if (ierr/=nf90_noerr) THEN
+    IF (ierr/=nf90_noerr) THEN
        WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
        WRITE(*,*) nf90_strerror(ierr)
@@ -326,5 +326,5 @@
     ierr = nf90_open(fich_cas,nf90_nowrite,nid)
     PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
-    if (ierr/=nf90_noerr) THEN
+    IF (ierr/=nf90_noerr) THEN
        WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
        WRITE(*,*) nf90_strerror(ierr)
@@ -537,30 +537,30 @@
   IMPLICIT NONE
 
-  integer ntime,nlevel
-
-  real zz(nlevel,ntime)
-  real pp(nlevel,ntime)
-  real temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
-  real theta(nlevel,ntime),rv(nlevel,ntime)
-  real u(nlevel,ntime)
-  real v(nlevel,ntime)
-  real ug(nlevel,ntime)
-  real vg(nlevel,ntime)
-  real w(nlevel,ntime)
-  real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
-  real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
-  real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
-  real dtrad(nlevel,ntime)
-  real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
-  real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
-  real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
-  real flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
-  real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime),resul(nlevel,ntime),resul1(ntime)
-
-
-  integer nid, ierr, ierr1,ierr2,rid,i
-  integer nbvar3d
+  INTEGER ntime,nlevel
+
+  REAL zz(nlevel,ntime)
+  REAL pp(nlevel,ntime)
+  REAL temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
+  REAL theta(nlevel,ntime),rv(nlevel,ntime)
+  REAL u(nlevel,ntime)
+  REAL v(nlevel,ntime)
+  REAL ug(nlevel,ntime)
+  REAL vg(nlevel,ntime)
+  REAL w(nlevel,ntime)
+  REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
+  REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
+  REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
+  REAL dtrad(nlevel,ntime)
+  REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
+  REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
+  REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
+  REAL flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
+  REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime),resul(nlevel,ntime),resul1(ntime)
+
+
+  INTEGER nid, ierr, ierr1,ierr2,rid,i
+  INTEGER nbvar3d
   parameter(nbvar3d=39)
-  integer var3didin(nbvar3d)
+  INTEGER var3didin(nbvar3d)
   character*5 name_var(1:nbvar3d)
   data name_var/'zz','pp','temp','qv','rh','theta','rv','u','v','ug','vg','w','advu','hu','vu',&
@@ -652,32 +652,32 @@
   IMPLICIT NONE
 
-  integer ntime,nlevel
-
-  real ap(nlevel+1),bp(nlevel+1)
-  real zz(nlevel,ntime),zzh(nlevel+1)
-  real pp(nlevel,ntime),pph(nlevel+1)
-  real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
-  real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
-  real u(nlevel,ntime),v(nlevel,ntime)
-  real ug(nlevel,ntime),vg(nlevel,ntime)
-  real vitw(nlevel,ntime),omega(nlevel,ntime)
-  real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
-  real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
-  real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
-  real dtrad(nlevel,ntime)
-  real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
-  real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
-  real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
-  real flat(ntime),sens(ntime),ustar(ntime)
-  real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
-  real ts(ntime),ps(ntime),tke(ntime)
-  real orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
-  real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
-
-
-  integer nid, ierr,ierr1,ierr2,rid,i
-  integer nbvar3d
+  INTEGER ntime,nlevel
+
+  REAL ap(nlevel+1),bp(nlevel+1)
+  REAL zz(nlevel,ntime),zzh(nlevel+1)
+  REAL pp(nlevel,ntime),pph(nlevel+1)
+  REAL temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
+  REAL theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
+  REAL u(nlevel,ntime),v(nlevel,ntime)
+  REAL ug(nlevel,ntime),vg(nlevel,ntime)
+  REAL vitw(nlevel,ntime),omega(nlevel,ntime)
+  REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
+  REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
+  REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
+  REAL dtrad(nlevel,ntime)
+  REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
+  REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
+  REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
+  REAL flat(ntime),sens(ntime),ustar(ntime)
+  REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
+  REAL ts(ntime),ps(ntime),tke(ntime)
+  REAL orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
+  REAL apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
+
+
+  INTEGER nid, ierr,ierr1,ierr2,rid,i
+  INTEGER nbvar3d
   parameter(nbvar3d=62)
-  integer var3didin(nbvar3d),missing_var(nbvar3d)
+  INTEGER var3didin(nbvar3d),missing_var(nbvar3d)
   character*12 name_var(1:nbvar3d)
   data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
@@ -709,5 +709,5 @@
            endif
            !-----------------------------------------------------------------------
-        else IF(i>4.and.i<=45) then   ! Lecture des variables en (time,nlevel,lat,lon)
+        else IF(i>4.AND.i<=45) then   ! Lecture des variables en (time,nlevel,lat,lon)
            ierr = nf90_get_var(nid,var3didin(i),resul, count = [1, 1, nlevel, ntime])
            print *,'read2_cas(resul), on a lu ',i,name_var(i)
@@ -717,5 +717,5 @@
            endif
            !-----------------------------------------------------------------------
-        else if (i>45.and.i<=51) then   ! Lecture des variables en (time,lat,lon)
+        ELSE IF (i>45.AND.i<=51) then   ! Lecture des variables en (time,lat,lon)
            ierr = nf90_get_var(nid,var3didin(i),resul2, count = [1, 1, ntime])
            print *,'read2_cas(resul2), on a lu ',i,name_var(i)
@@ -821,35 +821,35 @@
   IMPLICIT NONE
 
-  integer ntime,nlevel,k,t
-
-  real ap(nlevel+1),bp(nlevel+1)
-  real zz(nlevel,ntime),zzh(nlevel+1)
-  real pp(nlevel,ntime),pph(nlevel+1)
+  INTEGER ntime,nlevel,k,t
+
+  REAL ap(nlevel+1),bp(nlevel+1)
+  REAL zz(nlevel,ntime),zzh(nlevel+1)
+  REAL pp(nlevel,ntime),pph(nlevel+1)
   !profils initiaux
-  real temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
-  real pp0(nlevel)    
-  real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
-  real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
-  real u(nlevel,ntime),v(nlevel,ntime),tke(nlevel,ntime)
-  real ug(nlevel,ntime),vg(nlevel,ntime)
-  real vitw(nlevel,ntime),omega(nlevel,ntime)
-  real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
-  real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
-  real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
-  real dtrad(nlevel,ntime)
-  real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
-  real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
-  real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
-  real flat(ntime),sens(ntime),ustar(ntime)
-  real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
-  real ts(ntime),ps(ntime)
-  real orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
-  real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
-
-
-  integer nid, ierr,ierr1,ierr2,rid,i
-  integer nbvar3d
+  REAL temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
+  REAL pp0(nlevel)
+  REAL temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
+  REAL theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
+  REAL u(nlevel,ntime),v(nlevel,ntime),tke(nlevel,ntime)
+  REAL ug(nlevel,ntime),vg(nlevel,ntime)
+  REAL vitw(nlevel,ntime),omega(nlevel,ntime)
+  REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
+  REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
+  REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
+  REAL dtrad(nlevel,ntime)
+  REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
+  REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
+  REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
+  REAL flat(ntime),sens(ntime),ustar(ntime)
+  REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
+  REAL ts(ntime),ps(ntime)
+  REAL orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
+  REAL apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
+
+
+  INTEGER nid, ierr,ierr1,ierr2,rid,i
+  INTEGER nbvar3d
   parameter(nbvar3d=70)
-  integer var3didin(nbvar3d),missing_var(nbvar3d)
+  INTEGER var3didin(nbvar3d),missing_var(nbvar3d)
   character*13 name_var(1:nbvar3d)
   data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
@@ -884,5 +884,5 @@
            endif
            !-----------------------------------------------------------------------
-        else IF(i>4.and.i<=12) then   ! Lecture des variables en (time,nlevel,lat,lon)
+        else IF(i>4.AND.i<=12) then   ! Lecture des variables en (time,nlevel,lat,lon)
            ierr = nf90_get_var(nid,var3didin(i),resul1)
            print *,'read2_cas(resul1), on a lu ',i,name_var(i)
@@ -893,5 +893,5 @@
            PRINT*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1)
            !-----------------------------------------------------------------------
-        else IF(i>12.and.i<=54) then   ! Lecture des variables en (time,nlevel,lat,lon)
+        else IF(i>12.AND.i<=54) then   ! Lecture des variables en (time,nlevel,lat,lon)
            ierr = nf90_get_var(nid,var3didin(i),resul)
            print *,'read2_cas(resul), on a lu ',i,name_var(i)
@@ -902,5 +902,5 @@
            PRINT*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul)
            !-----------------------------------------------------------------------
-        else if (i>54.and.i<=65) then   ! Lecture des variables en (time,lat,lon)
+        ELSE IF (i>54.AND.i<=65) then   ! Lecture des variables en (time,lat,lon)
            ierr = nf90_get_var(nid,var3didin(i),resul2)
            print *,'read2_cas(resul2), on a lu ',i,name_var(i)
@@ -1053,39 +1053,39 @@
 
   ! inputs:
-  integer annee_ref
-  integer nt_cas,nlev_cas
-  real day, day1,day_cas
-  real ts_cas(nt_cas),ps_cas(nt_cas)
-  real plev_cas(nlev_cas,nt_cas)
-  real t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
-  real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
-  real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
-  real vitw_cas(nlev_cas,nt_cas)
-  real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
-  real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
-  real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
-  real dtrad_cas(nlev_cas,nt_cas)
-  real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
-  real lat_cas(nt_cas)
-  real sens_cas(nt_cas)
-  real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
-  real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
+  INTEGER annee_ref
+  INTEGER nt_cas,nlev_cas
+  REAL day, day1,day_cas
+  REAL ts_cas(nt_cas),ps_cas(nt_cas)
+  REAL plev_cas(nlev_cas,nt_cas)
+  REAL t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
+  REAL u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
+  REAL ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
+  REAL vitw_cas(nlev_cas,nt_cas)
+  REAL du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
+  REAL dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
+  REAL dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
+  REAL dtrad_cas(nlev_cas,nt_cas)
+  REAL dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
+  REAL lat_cas(nt_cas)
+  REAL sens_cas(nt_cas)
+  REAL ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
+  REAL q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
 
   ! outputs:
-  real plev_prof_cas(nlev_cas)
-  real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
-  real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
-  real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
-  real vitw_prof_cas(nlev_cas)
-  real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
-  real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
-  real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
-  real dtrad_prof_cas(nlev_cas)
-  real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
-  real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
-  real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
+  REAL plev_prof_cas(nlev_cas)
+  REAL t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
+  REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
+  REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
+  REAL vitw_prof_cas(nlev_cas)
+  REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
+  REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
+  REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
+  REAL dtrad_prof_cas(nlev_cas)
+  REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
+  REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
+  REAL uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
   ! local:
-  integer it_cas1, it_cas2,k
-  real timeit,time_cas1,time_cas2,frac
+  INTEGER it_cas1, it_cas2,k
+  REAL timeit,time_cas1,time_cas2,frac
 
 
@@ -1096,17 +1096,17 @@
   ! sont censes etre corrects.
   ! A supprimer a terme (MPL 20150623)
-  !     if ((forcing_type.eq.10).and.(1.eq.0)) THEN
+  !     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
   ! Check that initial day of the simulation consistent with AMMA case:
-  !      if (annee_ref.ne.2006) THEN
+  !      if (annee_ref.NE.2006) THEN
   !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
   !       PRINT*,'Changer annee_ref dans run.def'
   !       stop
   !      endif
-  !      if (annee_ref.eq.2006 .and. day1.lt.day_cas) THEN
+  !      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
   !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
   !       PRINT*,'Changer dayref dans run.def'
   !       stop
   !      endif
-  !      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) THEN
+  !      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
   !       PRINT*,'AMMA a fini le 11 juillet'
   !       PRINT*,'Changer dayref ou nday dans run.def'
@@ -1117,5 +1117,5 @@
   ! Determine timestep relative to the 1st day:
   !       timeit=(day-day1)*86400.
-  !       if (annee_ref.eq.1992) THEN
+  !       if (annee_ref.EQ.1992) THEN
   !        timeit=(day-day_cas)*86400.
   !       else
@@ -1145,9 +1145,9 @@
   !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
 
-  if (it_cas1 > nt_cas) THEN
+  IF (it_cas1 > nt_cas) THEN
      WRITE(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
           ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
      stop
-  endif
+  ENDIF
 
   ! time interpolation:
@@ -1262,42 +1262,42 @@
 
   ! inputs:
-  integer annee_ref
-  integer nt_cas,nlev_cas
-  real day, day1,day_cas
-  real ts_cas(nt_cas),ps_cas(nt_cas)
-  real plev_cas(nlev_cas,nt_cas)
-  real t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas)
-  real qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
-  real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
-  real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
-  real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas)
-  real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
-  real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
-  real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
-  real dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
-  real dtrad_cas(nlev_cas,nt_cas)
-  real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
-  real lat_cas(nt_cas),sens_cas(nt_cas),tke_cas(nt_cas)
-  real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
-  real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
+  INTEGER annee_ref
+  INTEGER nt_cas,nlev_cas
+  REAL day, day1,day_cas
+  REAL ts_cas(nt_cas),ps_cas(nt_cas)
+  REAL plev_cas(nlev_cas,nt_cas)
+  REAL t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas)
+  REAL qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
+  REAL u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
+  REAL ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
+  REAL vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas)
+  REAL du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
+  REAL dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
+  REAL dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
+  REAL dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
+  REAL dtrad_cas(nlev_cas,nt_cas)
+  REAL dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
+  REAL lat_cas(nt_cas),sens_cas(nt_cas),tke_cas(nt_cas)
+  REAL ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
+  REAL q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
 
   ! outputs:
-  real plev_prof_cas(nlev_cas)
-  real t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
-  real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
-  real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
-  real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
-  real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas)
-  real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
-  real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
-  real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
-  real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
-  real dtrad_prof_cas(nlev_cas)
-  real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
-  real lat_prof_cas,sens_prof_cas,tke_prof_cas,ts_prof_cas,ustar_prof_cas
-  real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
+  REAL plev_prof_cas(nlev_cas)
+  REAL t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
+  REAL qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
+  REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
+  REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
+  REAL vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas)
+  REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
+  REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
+  REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
+  REAL dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
+  REAL dtrad_prof_cas(nlev_cas)
+  REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
+  REAL lat_prof_cas,sens_prof_cas,tke_prof_cas,ts_prof_cas,ustar_prof_cas
+  REAL uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
   ! local:
-  integer it_cas1, it_cas2,k
-  real timeit,time_cas1,time_cas2,frac
+  INTEGER it_cas1, it_cas2,k
+  REAL timeit,time_cas1,time_cas2,frac
 
 
@@ -1311,17 +1311,17 @@
   ! sont censes etre corrects.
   ! A supprimer a terme (MPL 20150623)
-  !     if ((forcing_type.eq.10).and.(1.eq.0)) THEN
+  !     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
   ! Check that initial day of the simulation consistent with AMMA case:
-  !      if (annee_ref.ne.2006) THEN
+  !      if (annee_ref.NE.2006) THEN
   !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
   !       PRINT*,'Changer annee_ref dans run.def'
   !       stop
   !      endif
-  !      if (annee_ref.eq.2006 .and. day1.lt.day_cas) THEN
+  !      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
   !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
   !       PRINT*,'Changer dayref dans run.def'
   !       stop
   !      endif
-  !      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) THEN
+  !      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
   !       PRINT*,'AMMA a fini le 11 juillet'
   !       PRINT*,'Changer dayref ou nday dans run.def'
@@ -1332,5 +1332,5 @@
   ! Determine timestep relative to the 1st day:
   !       timeit=(day-day1)*86400.
-  !       if (annee_ref.eq.1992) THEN
+  !       if (annee_ref.EQ.1992) THEN
   !        timeit=(day-day_cas)*86400.
   !       else
@@ -1361,9 +1361,9 @@
   !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
 
-  if (it_cas1 > nt_cas) THEN
+  IF (it_cas1 > nt_cas) THEN
      WRITE(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
           ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
      stop
-  endif
+  ENDIF
 
   ! time interpolation:
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90	(revision 5117)
@@ -10,75 +10,75 @@
   character*80 :: fich_cas
   ! Discr?tisation 
-  integer nlev_cas, nt_cas
+  INTEGER nlev_cas, nt_cas
 
 
   !profils environnementaux
-  real, allocatable::  plev_cas(:,:),plevh_cas(:)
-  real, allocatable::  ap_cas(:),bp_cas(:)
-
-  real, allocatable::  z_cas(:,:),zh_cas(:)
-  real, allocatable::  t_cas(:,:),q_cas(:,:),qv_cas(:,:),ql_cas(:,:),qi_cas(:,:),rh_cas(:,:)
-  real, allocatable::  th_cas(:,:),thv_cas(:,:),thl_cas(:,:),rv_cas(:,:)
-  real, allocatable::  u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:),tke_cas(:,:)
+  REAL, ALLOCATABLE::  plev_cas(:,:),plevh_cas(:)
+  REAL, ALLOCATABLE::  ap_cas(:),bp_cas(:)
+
+  REAL, ALLOCATABLE::  z_cas(:,:),zh_cas(:)
+  REAL, ALLOCATABLE::  t_cas(:,:),q_cas(:,:),qv_cas(:,:),ql_cas(:,:),qi_cas(:,:),rh_cas(:,:)
+  REAL, ALLOCATABLE::  th_cas(:,:),thv_cas(:,:),thl_cas(:,:),rv_cas(:,:)
+  REAL, ALLOCATABLE::  u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:),tke_cas(:,:)
 
   !forcing
-  real, allocatable::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
-  real, allocatable::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
-  real, allocatable::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
-  real, allocatable::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
-  real, allocatable::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
-  real, allocatable::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
-  real, allocatable::  ug_cas(:,:),vg_cas(:,:)
-  real, allocatable::  temp_nudg_cas(:,:),qv_nudg_cas(:,:),u_nudg_cas(:,:),v_nudg_cas(:,:)
-  real, allocatable::  invtau_temp_nudg_cas(:,:),invtau_qv_nudg_cas(:,:),invtau_u_nudg_cas(:,:),invtau_v_nudg_cas(:,:)
-  real, allocatable::  lat_cas(:),sens_cas(:),tskin_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:)
-  real, allocatable::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tkes_cas(:)
+  REAL, ALLOCATABLE::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
+  REAL, ALLOCATABLE::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
+  REAL, ALLOCATABLE::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
+  REAL, ALLOCATABLE::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
+  REAL, ALLOCATABLE::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
+  REAL, ALLOCATABLE::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
+  REAL, ALLOCATABLE::  ug_cas(:,:),vg_cas(:,:)
+  REAL, ALLOCATABLE::  temp_nudg_cas(:,:),qv_nudg_cas(:,:),u_nudg_cas(:,:),v_nudg_cas(:,:)
+  REAL, ALLOCATABLE::  invtau_temp_nudg_cas(:,:),invtau_qv_nudg_cas(:,:),invtau_u_nudg_cas(:,:),invtau_v_nudg_cas(:,:)
+  REAL, ALLOCATABLE::  lat_cas(:),sens_cas(:),tskin_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:)
+  REAL, ALLOCATABLE::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tkes_cas(:)
 
   !champs interpoles
-  real, allocatable::  plev_prof_cas(:)
-  real, allocatable::  t_prof_cas(:)
-  real, allocatable::  theta_prof_cas(:)
-  real, allocatable::  thl_prof_cas(:)
-  real, allocatable::  thv_prof_cas(:)
-  real, allocatable::  q_prof_cas(:)
-  real, allocatable::  qv_prof_cas(:)
-  real, allocatable::  ql_prof_cas(:)
-  real, allocatable::  qi_prof_cas(:)
-  real, allocatable::  rh_prof_cas(:)
-  real, allocatable::  rv_prof_cas(:)
-  real, allocatable::  u_prof_cas(:)
-  real, allocatable::  v_prof_cas(:)        
-  real, allocatable::  vitw_prof_cas(:)
-  real, allocatable::  omega_prof_cas(:)
-  real, allocatable::  tke_prof_cas(:)
-  real, allocatable::  ug_prof_cas(:)
-  real, allocatable::  vg_prof_cas(:)
-  real, allocatable::  temp_nudg_prof_cas(:),qv_nudg_prof_cas(:),u_nudg_prof_cas(:),v_nudg_prof_cas(:)
-  real, allocatable::  invtau_temp_nudg_prof_cas(:),invtau_qv_nudg_prof_cas(:),invtau_u_nudg_prof_cas(:),invtau_v_nudg_prof_cas(:)
-
-  real, allocatable::  ht_prof_cas(:)
-  real, allocatable::  hth_prof_cas(:)
-  real, allocatable::  hq_prof_cas(:)
-  real, allocatable::  vt_prof_cas(:)
-  real, allocatable::  vth_prof_cas(:)
-  real, allocatable::  vq_prof_cas(:)
-  real, allocatable::  dt_prof_cas(:)
-  real, allocatable::  dth_prof_cas(:)
-  real, allocatable::  dtrad_prof_cas(:)
-  real, allocatable::  dq_prof_cas(:)
-  real, allocatable::  hu_prof_cas(:)
-  real, allocatable::  hv_prof_cas(:)
-  real, allocatable::  vu_prof_cas(:)
-  real, allocatable::  vv_prof_cas(:)
-  real, allocatable::  du_prof_cas(:)
-  real, allocatable::  dv_prof_cas(:)
-  real, allocatable::  uw_prof_cas(:)
-  real, allocatable::  vw_prof_cas(:)
-  real, allocatable::  q1_prof_cas(:)
-  real, allocatable::  q2_prof_cas(:)
-
-
-  real o3_cas,lat_prof_cas,sens_prof_cas,ts_prof_cas,tskin_prof_cas,ps_prof_cas,ustar_prof_cas,tkes_prof_cas
-  real orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas
+  REAL, ALLOCATABLE::  plev_prof_cas(:)
+  REAL, ALLOCATABLE::  t_prof_cas(:)
+  REAL, ALLOCATABLE::  theta_prof_cas(:)
+  REAL, ALLOCATABLE::  thl_prof_cas(:)
+  REAL, ALLOCATABLE::  thv_prof_cas(:)
+  REAL, ALLOCATABLE::  q_prof_cas(:)
+  REAL, ALLOCATABLE::  qv_prof_cas(:)
+  REAL, ALLOCATABLE::  ql_prof_cas(:)
+  REAL, ALLOCATABLE::  qi_prof_cas(:)
+  REAL, ALLOCATABLE::  rh_prof_cas(:)
+  REAL, ALLOCATABLE::  rv_prof_cas(:)
+  REAL, ALLOCATABLE::  u_prof_cas(:)
+  REAL, ALLOCATABLE::  v_prof_cas(:)
+  REAL, ALLOCATABLE::  vitw_prof_cas(:)
+  REAL, ALLOCATABLE::  omega_prof_cas(:)
+  REAL, ALLOCATABLE::  tke_prof_cas(:)
+  REAL, ALLOCATABLE::  ug_prof_cas(:)
+  REAL, ALLOCATABLE::  vg_prof_cas(:)
+  REAL, ALLOCATABLE::  temp_nudg_prof_cas(:),qv_nudg_prof_cas(:),u_nudg_prof_cas(:),v_nudg_prof_cas(:)
+  REAL, ALLOCATABLE::  invtau_temp_nudg_prof_cas(:),invtau_qv_nudg_prof_cas(:),invtau_u_nudg_prof_cas(:),invtau_v_nudg_prof_cas(:)
+
+  REAL, ALLOCATABLE::  ht_prof_cas(:)
+  REAL, ALLOCATABLE::  hth_prof_cas(:)
+  REAL, ALLOCATABLE::  hq_prof_cas(:)
+  REAL, ALLOCATABLE::  vt_prof_cas(:)
+  REAL, ALLOCATABLE::  vth_prof_cas(:)
+  REAL, ALLOCATABLE::  vq_prof_cas(:)
+  REAL, ALLOCATABLE::  dt_prof_cas(:)
+  REAL, ALLOCATABLE::  dth_prof_cas(:)
+  REAL, ALLOCATABLE::  dtrad_prof_cas(:)
+  REAL, ALLOCATABLE::  dq_prof_cas(:)
+  REAL, ALLOCATABLE::  hu_prof_cas(:)
+  REAL, ALLOCATABLE::  hv_prof_cas(:)
+  REAL, ALLOCATABLE::  vu_prof_cas(:)
+  REAL, ALLOCATABLE::  vv_prof_cas(:)
+  REAL, ALLOCATABLE::  du_prof_cas(:)
+  REAL, ALLOCATABLE::  dv_prof_cas(:)
+  REAL, ALLOCATABLE::  uw_prof_cas(:)
+  REAL, ALLOCATABLE::  vw_prof_cas(:)
+  REAL, ALLOCATABLE::  q1_prof_cas(:)
+  REAL, ALLOCATABLE::  q2_prof_cas(:)
+
+
+  REAL o3_cas,lat_prof_cas,sens_prof_cas,ts_prof_cas,tskin_prof_cas,ps_prof_cas,ustar_prof_cas,tkes_prof_cas
+  REAL orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas
 
 
@@ -101,5 +101,5 @@
     ierr = nf90_open(fich_cas,nf90_nowrite,nid)
     PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
-    if (ierr/=nf90_noerr) THEN
+    IF (ierr/=nf90_noerr) THEN
        WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
        WRITE(*,*) nf90_strerror(ierr)
@@ -332,37 +332,37 @@
     INCLUDE "compar1d.h"
 
-    integer ntime,nlevel,k,t
-
-    real ap(nlevel+1),bp(nlevel+1)
-    real zz(nlevel,ntime),zzh(nlevel+1)
-    real pp(nlevel,ntime),pph(nlevel+1)
+    INTEGER ntime,nlevel,k,t
+
+    REAL ap(nlevel+1),bp(nlevel+1)
+    REAL zz(nlevel,ntime),zzh(nlevel+1)
+    REAL pp(nlevel,ntime),pph(nlevel+1)
     !profils initiaux
-    real temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
-    real pp0(nlevel)    
-    real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
-    real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
-    real u(nlevel,ntime),v(nlevel,ntime),tkes(ntime)
-    real temp_nudg(nlevel,ntime),qv_nudg(nlevel,ntime),u_nudg(nlevel,ntime),v_nudg(nlevel,ntime)
-    real invtau_temp_nudg(nlevel,ntime),invtau_qv_nudg(nlevel,ntime),invtau_u_nudg(nlevel,ntime),invtau_v_nudg(nlevel,ntime)
-    real ug(nlevel,ntime),vg(nlevel,ntime)
-    real vitw(nlevel,ntime),omega(nlevel,ntime),tke(nlevel,ntime)
-    real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
-    real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
-    real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
-    real dtrad(nlevel,ntime)
-    real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
-    real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
-    real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
-    real flat(ntime),sens(ntime),ustar(ntime)
-    real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
-    real ts(ntime),tskin(ntime),ps(ntime)
-    real orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
-    real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
-
-
-    integer nid, ierr,ierr1,ierr2,rid,i,int_test
-    integer nbvar3d
+    REAL temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
+    REAL pp0(nlevel)
+    REAL temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
+    REAL theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
+    REAL u(nlevel,ntime),v(nlevel,ntime),tkes(ntime)
+    REAL temp_nudg(nlevel,ntime),qv_nudg(nlevel,ntime),u_nudg(nlevel,ntime),v_nudg(nlevel,ntime)
+    REAL invtau_temp_nudg(nlevel,ntime),invtau_qv_nudg(nlevel,ntime),invtau_u_nudg(nlevel,ntime),invtau_v_nudg(nlevel,ntime)
+    REAL ug(nlevel,ntime),vg(nlevel,ntime)
+    REAL vitw(nlevel,ntime),omega(nlevel,ntime),tke(nlevel,ntime)
+    REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
+    REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
+    REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
+    REAL dtrad(nlevel,ntime)
+    REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
+    REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
+    REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
+    REAL flat(ntime),sens(ntime),ustar(ntime)
+    REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
+    REAL ts(ntime),tskin(ntime),ps(ntime)
+    REAL orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
+    REAL apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
+
+
+    INTEGER nid, ierr,ierr1,ierr2,rid,i,int_test
+    INTEGER nbvar3d
     parameter(nbvar3d=78)
-    integer var3didin(nbvar3d),missing_var(nbvar3d)
+    INTEGER var3didin(nbvar3d),missing_var(nbvar3d)
     character*13 name_var(1:nbvar3d)
 
@@ -440,10 +440,10 @@
           ! Activating keys depending on the presence of specific variables in cas.nc
           !-----------------------------------------------------------------------
-          if ( 1 == 1 ) THEN
+          IF ( 1 == 1 ) THEN
              ! A MODIFIER: il faudrait dire nudging_temp mais faut le declarer dans compar1d.h etc...        
-             !           if ( name_var(i) == 'temp_nudging' .and. nint(nudging_t)==0) stop 'Nudging inconsistency temp'
-             if ( name_var(i) == 'qv_nud' .and. nint(nudging_qv)==0) stop 'Nudging inconsistency qv'
-             if ( name_var(i) == 'ua_nud' .and. nint(nudging_u)==0) stop 'Nudging inconsistency u'
-             if ( name_var(i) == 'va_nud' .and. nint(nudging_v)==0) stop 'Nudging inconsistency v'
+             !           if ( name_var(i) == 'temp_nudging' .AND. nint(nudging_t)==0) stop 'Nudging inconsistency temp'
+             IF ( name_var(i) == 'qv_nud' .AND. nint(nudging_qv)==0) stop 'Nudging inconsistency qv'
+             IF ( name_var(i) == 'ua_nud' .AND. nint(nudging_u)==0) stop 'Nudging inconsistency u'
+             IF ( name_var(i) == 'va_nud' .AND. nint(nudging_v)==0) stop 'Nudging inconsistency v'
           ELSE
              PRINT*,'GUIDAGE : CONSISTENCY CHECK DEACTIVATED FOR TESTS of SANDU/REF'
@@ -464,5 +464,5 @@
              !  Reading 1D (N) vertical varialbes    (nlevel,lat,lon)   
              !-----------------------------------------------------------------------
-          else IF(i>4.and.i<=12) THEN
+          else IF(i>4.AND.i<=12) THEN
              ierr = nf90_get_var(nid,var3didin(i),resul1)
              print *,'read_SCM(resul1), on a lu ',i,name_var(i)
@@ -477,5 +477,5 @@
              !  TBD : seems to be the same as above.
              !-----------------------------------------------------------------------
-          else IF(i>12.and.i<=61) THEN
+          else IF(i>12.AND.i<=61) THEN
              ierr = nf90_get_var(nid,var3didin(i),resul)
              print *,'read_SCM(resul), on a lu ',i,name_var(i)
@@ -489,5 +489,5 @@
              !  Reading 1D time variables (time,lat,lon)
              !-----------------------------------------------------------------------
-          else if (i>62.and.i<=75) THEN
+          ELSE IF (i>62.AND.i<=75) THEN
              ierr = nf90_get_var(nid,var3didin(i),resul2)
              print *,'read_SCM(resul2), on a lu ',i,name_var(i)
@@ -673,55 +673,55 @@
 
     ! inputs:
-    integer annee_ref
-    integer nt_cas,nlev_cas
-    real day, day1,day_cas
-    real ts_cas(nt_cas),tskin_cas(nt_cas),ps_cas(nt_cas)
-    real plev_cas(nlev_cas,nt_cas)
-    real t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas)
-    real thv_cas(nlev_cas,nt_cas), thl_cas(nlev_cas,nt_cas)
-    real qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
-    real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
-    real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
-    real temp_nudg_cas(nlev_cas,nt_cas),qv_nudg_cas(nlev_cas,nt_cas)
-    real u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas)
-
-    real invtau_temp_nudg_cas(nlev_cas,nt_cas),invtau_qv_nudg_cas(nlev_cas,nt_cas)
-    real invtau_u_nudg_cas(nlev_cas,nt_cas),invtau_v_nudg_cas(nlev_cas,nt_cas)
-
-    real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas),tke_cas(nlev_cas,nt_cas)
-    real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
-    real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
-    real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
-    real dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
-    real dtrad_cas(nlev_cas,nt_cas)
-    real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
-    real lat_cas(nt_cas),sens_cas(nt_cas),tkes_cas(nt_cas)
-    real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
-    real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
+    INTEGER annee_ref
+    INTEGER nt_cas,nlev_cas
+    REAL day, day1,day_cas
+    REAL ts_cas(nt_cas),tskin_cas(nt_cas),ps_cas(nt_cas)
+    REAL plev_cas(nlev_cas,nt_cas)
+    REAL t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas)
+    REAL thv_cas(nlev_cas,nt_cas), thl_cas(nlev_cas,nt_cas)
+    REAL qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
+    REAL u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
+    REAL ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
+    REAL temp_nudg_cas(nlev_cas,nt_cas),qv_nudg_cas(nlev_cas,nt_cas)
+    REAL u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas)
+
+    REAL invtau_temp_nudg_cas(nlev_cas,nt_cas),invtau_qv_nudg_cas(nlev_cas,nt_cas)
+    REAL invtau_u_nudg_cas(nlev_cas,nt_cas),invtau_v_nudg_cas(nlev_cas,nt_cas)
+
+    REAL vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas),tke_cas(nlev_cas,nt_cas)
+    REAL du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
+    REAL dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
+    REAL dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
+    REAL dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
+    REAL dtrad_cas(nlev_cas,nt_cas)
+    REAL dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
+    REAL lat_cas(nt_cas),sens_cas(nt_cas),tkes_cas(nt_cas)
+    REAL ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
+    REAL q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
 
     ! outputs:
-    real plev_prof_cas(nlev_cas)
-    real t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
-    real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
-    real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
-    real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
-    real temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)
-    real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
-
-    real invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas)
-    real invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas)
-
-    real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas)
-    real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
-    real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
-    real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
-    real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
-    real dtrad_prof_cas(nlev_cas)
-    real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
-    real lat_prof_cas,sens_prof_cas,tkes_prof_cas,ts_prof_cas,tskin_prof_cas,ps_prof_cas,ustar_prof_cas
-    real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
+    REAL plev_prof_cas(nlev_cas)
+    REAL t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
+    REAL qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
+    REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
+    REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
+    REAL temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)
+    REAL u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
+
+    REAL invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas)
+    REAL invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas)
+
+    REAL vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas)
+    REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
+    REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
+    REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
+    REAL dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
+    REAL dtrad_prof_cas(nlev_cas)
+    REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
+    REAL lat_prof_cas,sens_prof_cas,tkes_prof_cas,ts_prof_cas,tskin_prof_cas,ps_prof_cas,ustar_prof_cas
+    REAL uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
     ! local:
-    integer it_cas1, it_cas2,k
-    real timeit,time_cas1,time_cas2,frac
+    INTEGER it_cas1, it_cas2,k
+    REAL timeit,time_cas1,time_cas2,frac
 
 
@@ -735,17 +735,17 @@
     ! sont censes etre corrects.
     ! A supprimer a terme (MPL 20150623)
-    !     if ((forcing_type.eq.10).and.(1.eq.0)) THEN
+    !     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
     ! Check that initial day of the simulation consistent with AMMA case:
-    !      if (annee_ref.ne.2006) THEN
+    !      if (annee_ref.NE.2006) THEN
     !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
     !       PRINT*,'Changer annee_ref dans run.def'
     !       stop
     !      endif
-    !      if (annee_ref.eq.2006 .and. day1.lt.day_cas) THEN
+    !      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
     !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
     !       PRINT*,'Changer dayref dans run.def'
     !       stop
     !      endif
-    !      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) THEN
+    !      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
     !       PRINT*,'AMMA a fini le 11 juillet'
     !       PRINT*,'Changer dayref ou nday dans run.def'
@@ -756,5 +756,5 @@
     ! Determine timestep relative to the 1st day:
     !       timeit=(day-day1)*86400.
-    !       if (annee_ref.eq.1992) THEN
+    !       if (annee_ref.EQ.1992) THEN
     !        timeit=(day-day_cas)*86400.
     !       else
@@ -785,5 +785,5 @@
     !     print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
 
-    if (it_cas1 > nt_cas) THEN
+    IF (it_cas1 > nt_cas) THEN
        WRITE(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
             ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
@@ -939,7 +939,7 @@
     !-------------------------------------------------------------------------
 
-    integer nlevmax
+    INTEGER nlevmax
     parameter (nlevmax=41)
-    integer nlev_cas,mxcalc
+    INTEGER nlev_cas,mxcalc
     !       real play(llm), plev_prof(nlevmax) 
     !       real t_prof(nlevmax),q_prof(nlevmax)
@@ -948,36 +948,36 @@
     !       real hq_prof(nlevmax),vq_prof(nlevmax)
 
-    real play(llm), plev(llm+1), plev_prof_cas(nlev_cas) 
-    real t_prof_cas(nlev_cas),th_prof_cas(nlev_cas),thv_prof_cas(nlev_cas),thl_prof_cas(nlev_cas)
-    real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
-    real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
-    real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas)
-    real temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)
-    real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
-    real invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas)
-    real invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas)
-
-    real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
-    real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
-    real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas)
-    real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
-    real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
-
-    real t_mod_cas(llm),theta_mod_cas(llm),thv_mod_cas(llm),thl_mod_cas(llm)
-    real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
-    real u_mod_cas(llm),v_mod_cas(llm)
-    real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm),omega_mod_cas(llm),tke_mod_cas(llm+1)
-    real temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm)
-    real u_nudg_mod_cas(llm),v_nudg_mod_cas(llm)
-    real invtau_temp_nudg_mod_cas(llm),invtau_qv_nudg_mod_cas(llm)
-    real invtau_u_nudg_mod_cas(llm),invtau_v_nudg_mod_cas(llm)
-    real du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm)
-    real dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm)
-    real dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm)
-    real dth_mod_cas(llm),hth_mod_cas(llm),vth_mod_cas(llm)
-    real dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm)
-
-    integer l,k,k1,k2
-    real frac,frac1,frac2,fact
+    REAL play(llm), plev(llm+1), plev_prof_cas(nlev_cas)
+    REAL t_prof_cas(nlev_cas),th_prof_cas(nlev_cas),thv_prof_cas(nlev_cas),thl_prof_cas(nlev_cas)
+    REAL qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
+    REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
+    REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas)
+    REAL temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)
+    REAL u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
+    REAL invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas)
+    REAL invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas)
+
+    REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
+    REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
+    REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas)
+    REAL dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
+    REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
+
+    REAL t_mod_cas(llm),theta_mod_cas(llm),thv_mod_cas(llm),thl_mod_cas(llm)
+    REAL qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
+    REAL u_mod_cas(llm),v_mod_cas(llm)
+    REAL ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm),omega_mod_cas(llm),tke_mod_cas(llm+1)
+    REAL temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm)
+    REAL u_nudg_mod_cas(llm),v_nudg_mod_cas(llm)
+    REAL invtau_temp_nudg_mod_cas(llm),invtau_qv_nudg_mod_cas(llm)
+    REAL invtau_u_nudg_mod_cas(llm),invtau_v_nudg_mod_cas(llm)
+    REAL du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm)
+    REAL dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm)
+    REAL dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm)
+    REAL dth_mod_cas(llm),hth_mod_cas(llm),vth_mod_cas(llm)
+    REAL dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm)
+
+    INTEGER l,k,k1,k2
+    REAL frac,frac1,frac2,fact
 
 
@@ -987,5 +987,5 @@
     do l = 1, llm
 
-       if (play(l)>=plev_prof_cas(nlev_cas)) THEN
+       IF (play(l)>=plev_prof_cas(nlev_cas)) THEN
           mxcalc=l
           !        print *,'debut interp2, mxcalc=',mxcalc
@@ -993,7 +993,7 @@
           k2=0
 
-          if (play(l)<=plev_prof_cas(1)) THEN
+          IF (play(l)<=plev_prof_cas(1)) THEN
              do k = 1, nlev_cas-1
-                if (play(l)<=plev_prof_cas(k).and. play(l)>plev_prof_cas(k+1)) THEN
+                IF (play(l)<=plev_prof_cas(k).AND. play(l)>plev_prof_cas(k+1)) THEN
                    k1=k
                    k2=k+1
@@ -1001,5 +1001,5 @@
              enddo
 
-             if (k1==0 .or. k2==0) THEN
+             IF (k1==0 .OR. k2==0) THEN
                 WRITE(*,*) 'PB! k1, k2 = ',k1,k2
                 WRITE(*,*) 'l,play(l) = ',l,play(l)/100
@@ -1161,12 +1161,12 @@
     do l = 1, llm+1
 
-       if (plev(l)>=plev_prof_cas(nlev_cas)) THEN
+       IF (plev(l)>=plev_prof_cas(nlev_cas)) THEN
           mxcalc=l
           k1=0
           k2=0
 
-          if (plev(l)<=plev_prof_cas(1)) THEN
+          IF (plev(l)<=plev_prof_cas(1)) THEN
              do k = 1, nlev_cas-1
-                if (plev(l)<=plev_prof_cas(k).and. plev(l)>plev_prof_cas(k+1)) THEN
+                IF (plev(l)<=plev_prof_cas(k).AND. plev(l)>plev_prof_cas(k+1)) THEN
                    k1=k
                    k2=k+1
@@ -1174,5 +1174,5 @@
              enddo
 
-             if (k1==0 .or. k2==0) THEN
+             IF (k1==0 .OR. k2==0) THEN
                 WRITE(*,*) 'PB! k1, k2 = ',k1,k2
                 WRITE(*,*) 'l,plev(l) = ',l,plev(l)/100
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h	(revision 5117)
@@ -9,19 +9,19 @@
 !-------------------------------------------------------------------------
 
-      integer nlev_toga,nt_toga
-      real ts_toga(nt_toga),plev_toga(nlev_toga,nt_toga)
-      real t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
-      real u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
-      real w_toga(nlev_toga,nt_toga)
-      real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
-      real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
+      INTEGER nlev_toga,nt_toga
+      REAL ts_toga(nt_toga),plev_toga(nlev_toga,nt_toga)
+      REAL t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
+      REAL u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
+      REAL w_toga(nlev_toga,nt_toga)
+      REAL ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
+      REAL hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
       character*80 fich_toga
 
-      integer k,ip
-      real bid
-
-      integer iy,im,id,ih
+      INTEGER k,ip
+      REAL bid
+
+      INTEGER iy,im,id,ih
       
-       real plev_min
+       REAL plev_min
 
        plev_min = 55.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
@@ -46,5 +46,5 @@
          w_toga(k,ip)=w_toga(k,ip)*100./3600. ! Pa/s
 ! no water vapour tendency above 55 hPa
-         if (plev_toga(k,ip) .lt. plev_min) THEN
+         IF (plev_toga(k,ip) .lt. plev_min) THEN
           q_toga(k,ip) = 0.
           hq_toga(k,ip) = 0.
@@ -71,12 +71,12 @@
 !-------------------------------------------------------------------------
 
-      integer nlev_sandu,nt_sandu
-      real ts_sandu(nt_sandu)
+      INTEGER nlev_sandu,nt_sandu
+      REAL ts_sandu(nt_sandu)
       character*80 fich_sandu
 
-      integer ip
-      integer iy,im,id,ih
-
-      real plev_min
+      INTEGER ip
+      INTEGER iy,im,id,ih
+
+      REAL plev_min
 
       PRINT*,'nlev_sandu',nlev_sandu
@@ -108,13 +108,13 @@
 !-------------------------------------------------------------------------
 
-      integer nlev_astex,nt_astex
-      real div_astex(nt_astex),ts_astex(nt_astex),ug_astex(nt_astex)
-      real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
+      INTEGER nlev_astex,nt_astex
+      REAL div_astex(nt_astex),ts_astex(nt_astex),ug_astex(nt_astex)
+      REAL vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
       character*80 fich_astex
 
-      integer ip
-      integer iy,im,id,ih
-
-       real plev_min
+      INTEGER ip
+      INTEGER iy,im,id,ih
+
+       REAL plev_min
 
       PRINT*,'nlev_astex',nlev_astex
@@ -146,5 +146,5 @@
 !program reading forcings of the TWP-ICE experiment
 
-        use netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
+        USE netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
             nf90_inq_dimid,nf90_inquire_dimension
 
@@ -152,6 +152,6 @@
       IMPLICIT NONE
 
-      integer ntime,nlevel
-      integer l,k
+      INTEGER ntime,nlevel
+      INTEGER l,k
       character*80 :: fich_twpice
       real*8 time(ntime)
@@ -172,11 +172,11 @@
       real*8 T_srf(ntime)
 
-      integer nid, ierr
-      integer nbvar3d
+      INTEGER nid, ierr
+      INTEGER nbvar3d
       parameter(nbvar3d=20)
-      integer var3didin(nbvar3d)
+      INTEGER var3didin(nbvar3d)
 
       ierr = nf90_open(fich_twpice,nf90_nowrite,nid)
-      if (ierr.NE.nf90_noerr) THEN
+      IF (ierr.NE.nf90_noerr) THEN
          WRITE(*,*) 'ERROR: Pb opening forcings cdf file '
          WRITE(*,*) nf90_strerror(ierr)
@@ -492,16 +492,16 @@
          subroutine catchaxis(nid,ttm,llm,time,lev,ierr)
 
-         use netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
+         USE netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
             nf90_inq_dimid,nf90_inquire_dimension
 
          IMPLICIT NONE
-         integer nid,ttm,llm
+         INTEGER nid,ttm,llm
          real*8 time(ttm)
          real*8 lev(llm)
-         integer ierr
-
-         integer timevar,levvar
-         integer timelen,levlen
-         integer timedimin,levdimin
+         INTEGER ierr
+
+         INTEGER timevar,levvar
+         INTEGER timelen,levlen
+         INTEGER timedimin,levdimin
 
 ! Control & lecture on dimensions
@@ -509,5 +509,5 @@
          ierr=nf90_inq_dimid(nid,"time",timedimin)
          ierr=nf90_inq_varid(nid,"time",timevar)
-         if (ierr.NE.nf90_noerr) THEN
+         IF (ierr.NE.nf90_noerr) THEN
             WRITE(*,*) 'ERROR: Field <time> is missing'
             stop ""  
@@ -517,5 +517,5 @@
          ierr=nf90_inq_dimid(nid,"lev",levdimin)
          ierr=nf90_inq_varid(nid,"lev",levvar)
-         if (ierr.NE.nf90_noerr) THEN
+         IF (ierr.NE.nf90_noerr) THEN
              WRITE(*,*) 'ERROR: Field <lev> is lacking'
              stop "" 
@@ -523,5 +523,5 @@
          ierr=nf90_inquire_dimension(nid,levdimin,len=levlen)
 
-         if((timelen/=ttm).or.(levlen/=llm)) THEN
+         IF((timelen/=ttm).OR.(levlen/=llm)) THEN
             WRITE(*,*) 'ERROR: Not the good lenght for axis'
             WRITE(*,*) 'longitude: ',timelen,ttm+1
@@ -551,7 +551,7 @@
 !-------------------------------------------------------------------------
 
-       integer nlevmax
+       INTEGER nlevmax
        parameter (nlevmax=41)
-       integer nlev_sandu,mxcalc
+       INTEGER nlev_sandu,mxcalc
 !       real play(llm), plev_prof(nlevmax)
 !       real t_prof(nlevmax),q_prof(nlevmax)
@@ -560,26 +560,26 @@
 !       real hq_prof(nlevmax),vq_prof(nlevmax)
 
-       real play(llm), plev_prof(nlev_sandu)
-       real t_prof(nlev_sandu),thl_prof(nlev_sandu),q_prof(nlev_sandu)
-       real u_prof(nlev_sandu),v_prof(nlev_sandu), w_prof(nlev_sandu)
-       real omega_prof(nlev_sandu),o3mmr_prof(nlev_sandu)
-
-       real t_mod(llm),thl_mod(llm),q_mod(llm)
-       real u_mod(llm),v_mod(llm), w_mod(llm)
-       real omega_mod(llm),o3mmr_mod(llm)
-
-       integer l,k,k1,k2
-       real frac,frac1,frac2,fact
+       REAL play(llm), plev_prof(nlev_sandu)
+       REAL t_prof(nlev_sandu),thl_prof(nlev_sandu),q_prof(nlev_sandu)
+       REAL u_prof(nlev_sandu),v_prof(nlev_sandu), w_prof(nlev_sandu)
+       REAL omega_prof(nlev_sandu),o3mmr_prof(nlev_sandu)
+
+       REAL t_mod(llm),thl_mod(llm),q_mod(llm)
+       REAL u_mod(llm),v_mod(llm), w_mod(llm)
+       REAL omega_mod(llm),o3mmr_mod(llm)
+
+       INTEGER l,k,k1,k2
+       REAL frac,frac1,frac2,fact
 
        do l = 1, llm
 
-        if (play(l).ge.plev_prof(nlev_sandu)) THEN
+        IF (play(l).ge.plev_prof(nlev_sandu)) THEN
         mxcalc=l
          k1=0
          k2=0
 
-         if (play(l).le.plev_prof(1)) THEN
+         IF (play(l).le.plev_prof(1)) THEN
          do k = 1, nlev_sandu-1
-          if (play(l).le.plev_prof(k).and. play(l).gt.plev_prof(k+1)) THEN
+          IF (play(l).le.plev_prof(k).AND. play(l).gt.plev_prof(k+1)) THEN
             k1=k
             k2=k+1
@@ -587,5 +587,5 @@
          enddo
 
-         if (k1.eq.0 .or. k2.eq.0) THEN
+         IF (k1.EQ.0 .OR. k2.EQ.0) THEN
           WRITE(*,*) 'PB! k1, k2 = ',k1,k2
           WRITE(*,*) 'l,play(l) = ',l,play(l)/100
@@ -663,7 +663,7 @@
 !-------------------------------------------------------------------------
 
-       integer nlevmax
+       INTEGER nlevmax
        parameter (nlevmax=41)
-       integer nlev_astex,mxcalc
+       INTEGER nlev_astex,mxcalc
 !       real play(llm), plev_prof(nlevmax)
 !       real t_prof(nlevmax),qv_prof(nlevmax)
@@ -672,27 +672,27 @@
 !       real hq_prof(nlevmax),vq_prof(nlevmax)
 
-       real play(llm), plev_prof(nlev_astex)
-       real t_prof(nlev_astex),thl_prof(nlev_astex),qv_prof(nlev_astex)
-       real u_prof(nlev_astex),v_prof(nlev_astex), w_prof(nlev_astex)
-       real o3mmr_prof(nlev_astex),ql_prof(nlev_astex)
-       real qt_prof(nlev_astex),tke_prof(nlev_astex)
-
-       real t_mod(llm),thl_mod(llm),qv_mod(llm)
-       real u_mod(llm),v_mod(llm), w_mod(llm),tke_mod(llm)
-       real o3mmr_mod(llm),ql_mod(llm),qt_mod(llm)
-
-       integer l,k,k1,k2
-       real frac,frac1,frac2,fact
+       REAL play(llm), plev_prof(nlev_astex)
+       REAL t_prof(nlev_astex),thl_prof(nlev_astex),qv_prof(nlev_astex)
+       REAL u_prof(nlev_astex),v_prof(nlev_astex), w_prof(nlev_astex)
+       REAL o3mmr_prof(nlev_astex),ql_prof(nlev_astex)
+       REAL qt_prof(nlev_astex),tke_prof(nlev_astex)
+
+       REAL t_mod(llm),thl_mod(llm),qv_mod(llm)
+       REAL u_mod(llm),v_mod(llm), w_mod(llm),tke_mod(llm)
+       REAL o3mmr_mod(llm),ql_mod(llm),qt_mod(llm)
+
+       INTEGER l,k,k1,k2
+       REAL frac,frac1,frac2,fact
 
        do l = 1, llm
 
-        if (play(l).ge.plev_prof(nlev_astex)) THEN
+        IF (play(l).ge.plev_prof(nlev_astex)) THEN
         mxcalc=l
          k1=0
          k2=0
 
-         if (play(l).le.plev_prof(1)) THEN
+         IF (play(l).le.plev_prof(1)) THEN
          do k = 1, nlev_astex-1
-          if (play(l).le.plev_prof(k).and. play(l).gt.plev_prof(k+1)) THEN
+          IF (play(l).le.plev_prof(k).AND. play(l).gt.plev_prof(k+1)) THEN
             k1=k
             k2=k+1
@@ -700,5 +700,5 @@
          enddo
 
-         if (k1.eq.0 .or. k2.eq.0) THEN
+         IF (k1.EQ.0 .OR. k2.EQ.0) THEN
           WRITE(*,*) 'PB! k1, k2 = ',k1,k2
           WRITE(*,*) 'l,play(l) = ',l,play(l)/100
@@ -780,21 +780,21 @@
 
 
-      integer nlev_rico
-      real ts_rico,ps_rico
-      real t_rico(llm),q_rico(llm)
-      real u_rico(llm),v_rico(llm)
-      real w_rico(llm)
-      real dth_dyn(llm)
-      real dqh_dyn(llm)
+      INTEGER nlev_rico
+      REAL ts_rico,ps_rico
+      REAL t_rico(llm),q_rico(llm)
+      REAL u_rico(llm),v_rico(llm)
+      REAL w_rico(llm)
+      REAL dth_dyn(llm)
+      REAL dqh_dyn(llm)
       
 
-      real play(llm),zlay(llm)
+      REAL play(llm),zlay(llm)
      
 
-      real prico(nlev_rico),zrico(nlev_rico)
+      REAL prico(nlev_rico),zrico(nlev_rico)
 
       character*80 fich_rico
 
-      integer k,l
+      INTEGER k,l
 
       
@@ -827,12 +827,12 @@
         PRINT*,k,zlay(k)
         ! U
-        IF(0 < zlay(k) .and. zlay(k) < 4000) THEN
+        IF(0 < zlay(k) .AND. zlay(k) < 4000) THEN
           u_rico(k)=-9.9 + (-1.9 + 9.9)*zlay(k)/4000
-        elseif(4000 < zlay(k) .and. zlay(k) < 12000) THEN
+        elseif(4000 < zlay(k) .AND. zlay(k) < 12000) THEN
        u_rico(k)=  -1.9 + (30.0 + 1.9) /                                   &
      &          (12000 - 4000) * (zlay(k) - 4000)
-        elseif(12000 < zlay(k) .and. zlay(k) < 13000) THEN
+        elseif(12000 < zlay(k) .AND. zlay(k) < 13000) THEN
           u_rico(k)=30.0
-        elseif(13000 < zlay(k) .and. zlay(k) < 20000) THEN
+        elseif(13000 < zlay(k) .AND. zlay(k) < 20000) THEN
           u_rico(k)=30.0 - (30.0) /                                        &
      & (20000 - 13000) * (zlay(k) - 13000)
@@ -842,13 +842,13 @@
 
 !Q_v
-        IF(0 < zlay(k) .and. zlay(k) < 740) THEN
+        IF(0 < zlay(k) .AND. zlay(k) < 740) THEN
           q_rico(k)=16.0 + (13.8 - 16.0) / (740) * zlay(k)
-        elseif(740 < zlay(k) .and. zlay(k) < 3260) THEN
+        elseif(740 < zlay(k) .AND. zlay(k) < 3260) THEN
           q_rico(k)=13.8 + (2.4 - 13.8) /                                   &
      &          (3260 - 740) * (zlay(k) - 740)
-        elseif(3260 < zlay(k) .and. zlay(k) < 4000) THEN
+        elseif(3260 < zlay(k) .AND. zlay(k) < 4000) THEN
           q_rico(k)=2.4 + (1.8 - 2.4) /                                    &
      &               (4000 - 3260) * (zlay(k) - 3260)
-        elseif(4000 < zlay(k) .and. zlay(k) < 9000) THEN
+        elseif(4000 < zlay(k) .AND. zlay(k) < 9000) THEN
           q_rico(k)=1.8 + (0 - 1.8) /                                      &
      &             (9000 - 4000) * (zlay(k) - 4000)
@@ -858,19 +858,19 @@
 
 !T
-        IF(0 < zlay(k) .and. zlay(k) < 740) THEN
+        IF(0 < zlay(k) .AND. zlay(k) < 740) THEN
           t_rico(k)=299.2 + (292.0 - 299.2) / (740) * zlay(k)
-        elseif(740 < zlay(k) .and. zlay(k) < 4000) THEN
+        elseif(740 < zlay(k) .AND. zlay(k) < 4000) THEN
           t_rico(k)=292.0 + (278.0 - 292.0) /                              &                       
      &       (4000 - 740) * (zlay(k) - 740)
-        elseif(4000 < zlay(k) .and. zlay(k) < 15000) THEN
+        elseif(4000 < zlay(k) .AND. zlay(k) < 15000) THEN
           t_rico(k)=278.0 + (203.0 - 278.0) /                              &
      &       (15000 - 4000) * (zlay(k) - 4000)
-        elseif(15000 < zlay(k) .and. zlay(k) < 17500) THEN
+        elseif(15000 < zlay(k) .AND. zlay(k) < 17500) THEN
           t_rico(k)=203.0 + (194.0 - 203.0) /                              & 
      &       (17500 - 15000)* (zlay(k) - 15000)
-        elseif(17500 < zlay(k) .and. zlay(k) < 20000) THEN
+        elseif(17500 < zlay(k) .AND. zlay(k) < 20000) THEN
           t_rico(k)=194.0 + (206.0 - 194.0) /                              &
      &       (20000 - 17500)* (zlay(k) - 17500)
-        elseif(20000 < zlay(k) .and. zlay(k) < 60000) THEN
+        elseif(20000 < zlay(k) .AND. zlay(k) < 60000) THEN
           t_rico(k)=206.0 + (270.0 - 206.0) /                              & 
      &        (60000 - 20000)* (zlay(k) - 20000)
@@ -878,9 +878,9 @@
 
 ! W
-        IF(0 < zlay(k) .and. zlay(k) < 2260 ) THEN
+        IF(0 < zlay(k) .AND. zlay(k) < 2260 ) THEN
           w_rico(k)=- (0.005/2260) * zlay(k)
-        elseif(2260 < zlay(k) .and. zlay(k) < 4000 ) THEN
+        elseif(2260 < zlay(k) .AND. zlay(k) < 4000 ) THEN
           w_rico(k)=- 0.005
-        elseif(4000 < zlay(k) .and. zlay(k) < 5000 ) THEN
+        elseif(4000 < zlay(k) .AND. zlay(k) < 5000 ) THEN
        w_rico(k)=- 0.005 + (0.005/ (5000 - 4000)) * (zlay(k) - 4000)
         else
@@ -889,8 +889,8 @@
 
 ! dThrz+dTsw0+dTlw0
-        IF(0 < zlay(k) .and. zlay(k) < 4000) THEN
+        IF(0 < zlay(k) .AND. zlay(k) < 4000) THEN
           dth_dyn(k)=- 2.51 / 86400 + (-2.18 + 2.51 )/                     &
      &               (86400*4000) * zlay(k)
-        elseif(4000 < zlay(k) .and. zlay(k) < 5000) THEN
+        elseif(4000 < zlay(k) .AND. zlay(k) < 5000) THEN
           dth_dyn(k)=- 2.18 / 86400 + ( 2.18 ) /                           &
      &           (86400*(5000 - 4000)) * (zlay(k) - 4000)
@@ -899,10 +899,10 @@
         endif
 ! dQhrz
-        IF(0 < zlay(k) .and. zlay(k) < 3000) THEN
+        IF(0 < zlay(k) .AND. zlay(k) < 3000) THEN
           dqh_dyn(k)=-1.0 / 86400 + (0.345 + 1.0)/                         &
      &                    (86400*3000) * (zlay(k))
-        elseif(3000 < zlay(k) .and. zlay(k) < 4000) THEN
+        elseif(3000 < zlay(k) .AND. zlay(k) < 4000) THEN
           dqh_dyn(k)=0.345 / 86400
-        elseif(4000 < zlay(k) .and. zlay(k) < 5000) THEN
+        elseif(4000 < zlay(k) .AND. zlay(k) < 5000) THEN
           dqh_dyn(k)=0.345 / 86400 +                                       &
      &   (-0.345)/(86400 * (5000 - 4000)) * (zlay(k)-4000)
@@ -913,5 +913,5 @@
 !?        IF(play(k)>6e4) THEN
 !?          ratqs0(1,k)=ratqsbas*(plev(1)-play(k))/(plev(1)-6e4)
-!?        elseif((play(k)>3e4).and.(play(k)<6e4)) THEN
+!?        elseif((play(k)>3e4).AND.(play(k)<6e4)) THEN
 !?          ratqs0(1,k)=ratqsbas+(ratqshaut-ratqsbas)&
 !?                          *(6e4-play(k))/(6e4-3e4)
@@ -946,21 +946,21 @@
 !---------------------------------------------------------------------------------------
 ! inputs:
-        integer annee_ref
-        integer nt_sandu,nlev_sandu
-        integer year_ini_sandu
-        real day, day1,day_ini_sandu,dt_sandu
-        real ts_sandu(nt_sandu)
+        INTEGER annee_ref
+        INTEGER nt_sandu,nlev_sandu
+        INTEGER year_ini_sandu
+        REAL day, day1,day_ini_sandu,dt_sandu
+        REAL ts_sandu(nt_sandu)
 ! outputs:
-        real ts_prof
+        REAL ts_prof
 ! local:
-        integer it_sandu1, it_sandu2
-        real timeit,time_sandu1,time_sandu2,frac
+        INTEGER it_sandu1, it_sandu2
+        REAL timeit,time_sandu1,time_sandu2,frac
 ! Check that initial day of the simulation consistent with SANDU period:
-       if (annee_ref.ne.2006 ) THEN
+       IF (annee_ref.NE.2006 ) THEN
         PRINT*,'Pour SANDUREF, annee_ref doit etre 2006 '
         PRINT*,'Changer annee_ref dans run.def'
         stop
        endif
-!      if (annee_ref.eq.2006 .and. day1.lt.day_ini_sandu) THEN
+!      if (annee_ref.EQ.2006 .AND. day1.lt.day_ini_sandu) THEN
 !       PRINT*,'SANDUREF debute le 15 Juillet 2006 (jour julien=196)'
 !       PRINT*,'Changer dayref dans run.def'
@@ -970,5 +970,5 @@
 ! Determine timestep relative to the 1st day of TOGA-COARE:
 !       timeit=(day-day1)*86400.
-!       if (annee_ref.eq.1992) THEN
+!       if (annee_ref.EQ.1992) THEN
 !        timeit=(day-day_ini_sandu)*86400.
 !       else
@@ -986,5 +986,5 @@
      &          it_sandu1,it_sandu2,time_sandu1,time_sandu2
 
-       if (it_sandu1 .ge. nt_sandu) THEN
+       IF (it_sandu1 .ge. nt_sandu) THEN
         WRITE(*,*) 'PB-stop: day, it_sandu1, it_sandu2, timeit: '          &
      &        ,day,it_sandu1,it_sandu2,timeit/86400.
@@ -1016,12 +1016,12 @@
 !-------------------------------------------------------------------------
 
-      integer nlev_armcu,nt_armcu
-      real sens(nt_armcu),flat(nt_armcu)
-      real adv_theta(nt_armcu),rad_theta(nt_armcu),adv_qt(nt_armcu)
+      INTEGER nlev_armcu,nt_armcu
+      REAL sens(nt_armcu),flat(nt_armcu)
+      REAL adv_theta(nt_armcu),rad_theta(nt_armcu),adv_qt(nt_armcu)
       character*80 fich_armcu
 
-      integer ip
-
-      integer iy,im,id,ih,in
+      INTEGER ip
+
+      INTEGER iy,im,id,ih,in
 
       PRINT*,'nlev_armcu',nlev_armcu
@@ -1059,7 +1059,7 @@
 !-------------------------------------------------------------------------
  
-       integer nlevmax
+       INTEGER nlevmax
        parameter (nlevmax=41)
-       integer nlev_toga,mxcalc
+       INTEGER nlev_toga,mxcalc
 !       real play(llm), plev_prof(nlevmax) 
 !       real t_prof(nlevmax),q_prof(nlevmax)
@@ -1068,28 +1068,28 @@
 !       real hq_prof(nlevmax),vq_prof(nlevmax)
  
-       real play(llm), plev_prof(nlev_toga) 
-       real t_prof(nlev_toga),q_prof(nlev_toga)
-       real u_prof(nlev_toga),v_prof(nlev_toga), w_prof(nlev_toga)
-       real ht_prof(nlev_toga),vt_prof(nlev_toga)
-       real hq_prof(nlev_toga),vq_prof(nlev_toga)
- 
-       real t_mod(llm),q_mod(llm)
-       real u_mod(llm),v_mod(llm), w_mod(llm)
-       real ht_mod(llm),vt_mod(llm)
-       real hq_mod(llm),vq_mod(llm)
- 
-       integer l,k,k1,k2
-       real frac,frac1,frac2,fact
+       REAL play(llm), plev_prof(nlev_toga)
+       REAL t_prof(nlev_toga),q_prof(nlev_toga)
+       REAL u_prof(nlev_toga),v_prof(nlev_toga), w_prof(nlev_toga)
+       REAL ht_prof(nlev_toga),vt_prof(nlev_toga)
+       REAL hq_prof(nlev_toga),vq_prof(nlev_toga)
+ 
+       REAL t_mod(llm),q_mod(llm)
+       REAL u_mod(llm),v_mod(llm), w_mod(llm)
+       REAL ht_mod(llm),vt_mod(llm)
+       REAL hq_mod(llm),vq_mod(llm)
+ 
+       INTEGER l,k,k1,k2
+       REAL frac,frac1,frac2,fact
  
        do l = 1, llm
 
-        if (play(l).ge.plev_prof(nlev_toga)) THEN
+        IF (play(l).ge.plev_prof(nlev_toga)) THEN
         mxcalc=l
          k1=0
          k2=0
 
-         if (play(l).le.plev_prof(1)) THEN
+         IF (play(l).le.plev_prof(1)) THEN
          do k = 1, nlev_toga-1
-          if (play(l).le.plev_prof(k).and. play(l).gt.plev_prof(k+1)) THEN
+          IF (play(l).le.plev_prof(k).AND. play(l).gt.plev_prof(k+1)) THEN
             k1=k
             k2=k+1
@@ -1097,5 +1097,5 @@
          enddo
 
-         if (k1.eq.0 .or. k2.eq.0) THEN
+         IF (k1.EQ.0 .OR. k2.EQ.0) THEN
           WRITE(*,*) 'PB! k1, k2 = ',k1,k2
           WRITE(*,*) 'l,play(l) = ',l,play(l)/100
@@ -1179,7 +1179,7 @@
 !-------------------------------------------------------------------------
  
-       integer nlevmax
+       INTEGER nlevmax
        parameter (nlevmax=41)
-       integer nlev_cas,mxcalc
+       INTEGER nlev_cas,mxcalc
 !       real play(llm), plev_prof(nlevmax) 
 !       real t_prof(nlevmax),q_prof(nlevmax)
@@ -1188,34 +1188,34 @@
 !       real hq_prof(nlevmax),vq_prof(nlevmax)
  
-       real play(llm), plev_prof_cas(nlev_cas) 
-       real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
-       real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
-       real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas)
-       real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
-       real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
-       real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas)
-       real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
- 
-       real t_mod_cas(llm),q_mod_cas(llm)
-       real u_mod_cas(llm),v_mod_cas(llm)
-       real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm)
-       real du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm)
-       real dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm)
-       real dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm)
-       real dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm)
- 
-       integer l,k,k1,k2
-       real frac,frac1,frac2,fact
+       REAL play(llm), plev_prof_cas(nlev_cas)
+       REAL t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
+       REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
+       REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas)
+       REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
+       REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
+       REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas)
+       REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
+ 
+       REAL t_mod_cas(llm),q_mod_cas(llm)
+       REAL u_mod_cas(llm),v_mod_cas(llm)
+       REAL ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm)
+       REAL du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm)
+       REAL dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm)
+       REAL dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm)
+       REAL dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm)
+ 
+       INTEGER l,k,k1,k2
+       REAL frac,frac1,frac2,fact
  
        do l = 1, llm
 
-        if (play(l).ge.plev_prof_cas(nlev_cas)) THEN
+        IF (play(l).ge.plev_prof_cas(nlev_cas)) THEN
         mxcalc=l
          k1=0
          k2=0
 
-         if (play(l).le.plev_prof_cas(1)) THEN
+         IF (play(l).le.plev_prof_cas(1)) THEN
          do k = 1, nlev_cas-1
-          if (play(l).le.plev_prof_cas(k).and. play(l).gt.plev_prof_cas(k+1)) THEN
+          IF (play(l).le.plev_prof_cas(k).AND. play(l).gt.plev_prof_cas(k+1)) THEN
             k1=k
             k2=k+1
@@ -1223,5 +1223,5 @@
          enddo
 
-         if (k1.eq.0 .or. k2.eq.0) THEN
+         IF (k1.EQ.0 .OR. k2.EQ.0) THEN
           WRITE(*,*) 'PB! k1, k2 = ',k1,k2
           WRITE(*,*) 'l,play(l) = ',l,play(l)/100
@@ -1336,34 +1336,34 @@
 !-------------------------------------------------------------------------
  
-       integer nlevmax
+       INTEGER nlevmax
        parameter (nlevmax=41)
-       integer nlev_dice,mxcalc,nt_dice
- 
-       real play(llm), plev_prof(nlev_dice) 
-       real th_prof(nlev_dice),qv_prof(nlev_dice)
-       real u_prof(nlev_dice),v_prof(nlev_dice) 
-       real o3_prof(nlev_dice)
-       real ht_prof(nlev_dice),hq_prof(nlev_dice)
-       real hu_prof(nlev_dice),hv_prof(nlev_dice)
-       real w_prof(nlev_dice),omega_prof(nlev_dice)
- 
-       real th_mod(llm),qv_mod(llm)
-       real u_mod(llm),v_mod(llm), o3_mod(llm)
-       real ht_mod(llm),hq_mod(llm)
-       real hu_mod(llm),hv_mod(llm),w_mod(llm),omega_mod(llm)
- 
-       integer l,k,k1,k2,kp
-       real aa,frac,frac1,frac2,fact
+       INTEGER nlev_dice,mxcalc,nt_dice
+ 
+       REAL play(llm), plev_prof(nlev_dice)
+       REAL th_prof(nlev_dice),qv_prof(nlev_dice)
+       REAL u_prof(nlev_dice),v_prof(nlev_dice)
+       REAL o3_prof(nlev_dice)
+       REAL ht_prof(nlev_dice),hq_prof(nlev_dice)
+       REAL hu_prof(nlev_dice),hv_prof(nlev_dice)
+       REAL w_prof(nlev_dice),omega_prof(nlev_dice)
+ 
+       REAL th_mod(llm),qv_mod(llm)
+       REAL u_mod(llm),v_mod(llm), o3_mod(llm)
+       REAL ht_mod(llm),hq_mod(llm)
+       REAL hu_mod(llm),hv_mod(llm),w_mod(llm),omega_mod(llm)
+ 
+       INTEGER l,k,k1,k2,kp
+       REAL aa,frac,frac1,frac2,fact
  
        do l = 1, llm
 
-        if (play(l).ge.plev_prof(nlev_dice)) THEN
+        IF (play(l).ge.plev_prof(nlev_dice)) THEN
         mxcalc=l
          k1=0
          k2=0
 
-         if (play(l).le.plev_prof(1)) THEN
+         IF (play(l).le.plev_prof(1)) THEN
          do k = 1, nlev_dice-1
-          if (play(l).le.plev_prof(k) .and. play(l).gt.plev_prof(k+1)) THEN
+          IF (play(l).le.plev_prof(k) .AND. play(l).gt.plev_prof(k+1)) THEN
             k1=k
             k2=k+1
@@ -1371,5 +1371,5 @@
          enddo
 
-         if (k1.eq.0 .or. k2.eq.0) THEN
+         IF (k1.EQ.0 .OR. k2.EQ.0) THEN
           WRITE(*,*) 'PB! k1, k2 = ',k1,k2
           WRITE(*,*) 'l,play(l) = ',l,play(l)/100
@@ -1460,23 +1460,23 @@
 
 ! inputs:
-        integer annee_ref
-        integer nt_astex,nlev_astex
-        integer year_ini_astex
-        real day, day1,day_ini_astex,dt_astex
-        real div_astex(nt_astex),ts_astex(nt_astex),ug_astex(nt_astex)
-        real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
+        INTEGER annee_ref
+        INTEGER nt_astex,nlev_astex
+        INTEGER year_ini_astex
+        REAL day, day1,day_ini_astex,dt_astex
+        REAL div_astex(nt_astex),ts_astex(nt_astex),ug_astex(nt_astex)
+        REAL vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
 ! outputs:
-        real div_prof,ts_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
+        REAL div_prof,ts_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
 ! local:
-        integer it_astex1, it_astex2
-        real timeit,time_astex1,time_astex2,frac
+        INTEGER it_astex1, it_astex2
+        REAL timeit,time_astex1,time_astex2,frac
 
 ! Check that initial day of the simulation consistent with ASTEX period:
-       if (annee_ref.ne.1992 ) THEN
+       IF (annee_ref.NE.1992 ) THEN
         PRINT*,'Pour Astex, annee_ref doit etre 1992 '
         PRINT*,'Changer annee_ref dans run.def'
         stop
        endif
-       if (annee_ref.eq.1992 .and. day1.lt.day_ini_astex) THEN
+       IF (annee_ref.EQ.1992 .AND. day1.lt.day_ini_astex) THEN
         PRINT*,'Astex debute le 13 Juin 1992 (jour julien=165)'
         PRINT*,'Changer dayref dans run.def'
@@ -1486,5 +1486,5 @@
 ! Determine timestep relative to the 1st day of TOGA-COARE:
 !       timeit=(day-day1)*86400.
-!       if (annee_ref.eq.1992) THEN
+!       if (annee_ref.EQ.1992) THEN
 !        timeit=(day-day_ini_astex)*86400.
 !       else
@@ -1502,5 +1502,5 @@
      &          it_astex1,it_astex2,time_astex1,time_astex2
 
-       if (it_astex1 .ge. nt_astex) THEN
+       IF (it_astex1 .ge. nt_astex) THEN
         WRITE(*,*) 'PB-stop: day, it_astex1, it_astex2, timeit: '          &
      &        ,day,it_astex1,it_astex2,timeit/86400.
@@ -1554,39 +1554,39 @@
 
 ! inputs:
-        integer annee_ref
-        integer nt_toga,nlev_toga
-        integer year_ini_toga
-        real day, day1,day_ini_toga,dt_toga
-        real ts_toga(nt_toga)
-        real plev_toga(nlev_toga,nt_toga),t_toga(nlev_toga,nt_toga)
-        real q_toga(nlev_toga,nt_toga),u_toga(nlev_toga,nt_toga)
-        real v_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
-        real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
-        real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
+        INTEGER annee_ref
+        INTEGER nt_toga,nlev_toga
+        INTEGER year_ini_toga
+        REAL day, day1,day_ini_toga,dt_toga
+        REAL ts_toga(nt_toga)
+        REAL plev_toga(nlev_toga,nt_toga),t_toga(nlev_toga,nt_toga)
+        REAL q_toga(nlev_toga,nt_toga),u_toga(nlev_toga,nt_toga)
+        REAL v_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
+        REAL ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
+        REAL hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
 ! outputs:
-        real ts_prof
-        real plev_prof(nlev_toga),t_prof(nlev_toga)
-        real q_prof(nlev_toga),u_prof(nlev_toga)
-        real v_prof(nlev_toga),w_prof(nlev_toga)
-        real ht_prof(nlev_toga),vt_prof(nlev_toga)
-        real hq_prof(nlev_toga),vq_prof(nlev_toga)
+        REAL ts_prof
+        REAL plev_prof(nlev_toga),t_prof(nlev_toga)
+        REAL q_prof(nlev_toga),u_prof(nlev_toga)
+        REAL v_prof(nlev_toga),w_prof(nlev_toga)
+        REAL ht_prof(nlev_toga),vt_prof(nlev_toga)
+        REAL hq_prof(nlev_toga),vq_prof(nlev_toga)
 ! local:
-        integer it_toga1, it_toga2,k
-        real timeit,time_toga1,time_toga2,frac
-
-
-        if (forcing_type.eq.2) THEN
+        INTEGER it_toga1, it_toga2,k
+        REAL timeit,time_toga1,time_toga2,frac
+
+
+        IF (forcing_type.EQ.2) THEN
 ! Check that initial day of the simulation consistent with TOGA-COARE period:
-       if (annee_ref.ne.1992 .and. annee_ref.ne.1993) THEN
+       IF (annee_ref.NE.1992 .AND. annee_ref.NE.1993) THEN
         PRINT*,'Pour TOGA-COARE, annee_ref doit etre 1992 ou 1993'
         PRINT*,'Changer annee_ref dans run.def'
         stop
        endif
-       if (annee_ref.eq.1992 .and. day1.lt.day_ini_toga) THEN
+       IF (annee_ref.EQ.1992 .AND. day1.lt.day_ini_toga) THEN
         PRINT*,'TOGA-COARE a debute le 1er Nov 1992 (jour julien=306)'
         PRINT*,'Changer dayref dans run.def'
         stop
        endif
-       if (annee_ref.eq.1993 .and. day1.gt.day_ini_toga+119) THEN
+       IF (annee_ref.EQ.1993 .AND. day1.gt.day_ini_toga+119) THEN
         PRINT*,'TOGA-COARE a fini le 28 Feb 1993 (jour julien=59)'
         PRINT*,'Changer dayref ou nday dans run.def'
@@ -1594,17 +1594,17 @@
        endif
 
-       else if (forcing_type.eq.4) THEN
+       ELSE IF (forcing_type.EQ.4) THEN
 ! Check that initial day of the simulation consistent with TWP-ICE period:
-       if (annee_ref.ne.2006) THEN
+       IF (annee_ref.NE.2006) THEN
         PRINT*,'Pour TWP-ICE, annee_ref doit etre 2006'
         PRINT*,'Changer annee_ref dans run.def'
         stop
        endif
-       if (annee_ref.eq.2006 .and. day1.lt.day_ini_toga) THEN
+       IF (annee_ref.EQ.2006 .AND. day1.lt.day_ini_toga) THEN
         PRINT*,'TWP-ICE a debute le 17 Jan 2006 (jour julien=17)'
         PRINT*,'Changer dayref dans run.def'
         stop
        endif
-       if (annee_ref.eq.2006 .and. day1.gt.day_ini_toga+26) THEN
+       IF (annee_ref.EQ.2006 .AND. day1.gt.day_ini_toga+26) THEN
         PRINT*,'TWP-ICE a fini le 12 Feb 2006 (jour julien=43)'
         PRINT*,'Changer dayref ou nday dans run.def'
@@ -1616,5 +1616,5 @@
 ! Determine timestep relative to the 1st day of TOGA-COARE:
 !       timeit=(day-day1)*86400.
-!       if (annee_ref.eq.1992) THEN
+!       if (annee_ref.EQ.1992) THEN
 !        timeit=(day-day_ini_toga)*86400.
 !       else
@@ -1629,5 +1629,5 @@
        time_toga2=(it_toga2-1)*dt_toga
 
-       if (it_toga1 .ge. nt_toga) THEN
+       IF (it_toga1 .ge. nt_toga) THEN
         WRITE(*,*) 'PB-stop: day, it_toga1, it_toga2, timeit: '            &
      &        ,day,it_toga1,it_toga2,timeit/86400.
@@ -1695,41 +1695,41 @@
 
 ! inputs:
-        integer annee_ref
-        integer nt_dice,nlev_dice
-        integer year_ini_dice
-        real day, day1,day_ini_dice,dt_dice
-        real shf_dice(nt_dice),lhf_dice(nt_dice),lwup_dice(nt_dice)
-        real swup_dice(nt_dice),tg_dice(nt_dice),ustar_dice(nt_dice)
-        real psurf_dice(nt_dice),ug_dice(nt_dice),vg_dice(nt_dice)
-        real ht_dice(nlev_dice,nt_dice),hq_dice(nlev_dice,nt_dice)
-        real hu_dice(nlev_dice,nt_dice),hv_dice(nlev_dice,nt_dice)
-        real w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
+        INTEGER annee_ref
+        INTEGER nt_dice,nlev_dice
+        INTEGER year_ini_dice
+        REAL day, day1,day_ini_dice,dt_dice
+        REAL shf_dice(nt_dice),lhf_dice(nt_dice),lwup_dice(nt_dice)
+        REAL swup_dice(nt_dice),tg_dice(nt_dice),ustar_dice(nt_dice)
+        REAL psurf_dice(nt_dice),ug_dice(nt_dice),vg_dice(nt_dice)
+        REAL ht_dice(nlev_dice,nt_dice),hq_dice(nlev_dice,nt_dice)
+        REAL hu_dice(nlev_dice,nt_dice),hv_dice(nlev_dice,nt_dice)
+        REAL w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
 ! outputs:
-        real tg_prof,shf_prof,lhf_prof,lwup_prof,swup_prof
-        real ustar_prof,psurf_prof,ug_prof,vg_prof
-        real ht_prof(nlev_dice),hq_prof(nlev_dice)
-        real hu_prof(nlev_dice),hv_prof(nlev_dice)
-        real w_prof(nlev_dice),omega_prof(nlev_dice)
+        REAL tg_prof,shf_prof,lhf_prof,lwup_prof,swup_prof
+        REAL ustar_prof,psurf_prof,ug_prof,vg_prof
+        REAL ht_prof(nlev_dice),hq_prof(nlev_dice)
+        REAL hu_prof(nlev_dice),hv_prof(nlev_dice)
+        REAL w_prof(nlev_dice),omega_prof(nlev_dice)
 ! local:
-        integer it_dice1, it_dice2,k
-        real timeit,time_dice1,time_dice2,frac
-
-
-        if (forcing_type.eq.7) THEN
+        INTEGER it_dice1, it_dice2,k
+        REAL timeit,time_dice1,time_dice2,frac
+
+
+        IF (forcing_type.EQ.7) THEN
 ! Check that initial day of the simulation consistent with Dice period:
        print *,'annee_ref=',annee_ref
        print *,'day1=',day1
        print *,'day_ini_dice=',day_ini_dice
-       if (annee_ref.ne.1999) THEN
+       IF (annee_ref.NE.1999) THEN
         PRINT*,'Pour Dice, annee_ref doit etre 1999'
         PRINT*,'Changer annee_ref dans run.def'
         stop
        endif
-       if (annee_ref.eq.1999 .and. day1.gt.day_ini_dice) THEN
+       IF (annee_ref.EQ.1999 .AND. day1.gt.day_ini_dice) THEN
         PRINT*,'Dice a debute le 23 Oct 1999 (jour julien=296)'
         PRINT*,'Changer dayref dans run.def',day1,day_ini_dice
         stop
        endif
-       if (annee_ref.eq.1999 .and. day1.gt.day_ini_dice+2) THEN
+       IF (annee_ref.EQ.1999 .AND. day1.gt.day_ini_dice+2) THEN
         PRINT*,'Dice a fini le 25 Oct 1999 (jour julien=298)'
         PRINT*,'Changer dayref ou nday dans run.def',day1,day_ini_dice
@@ -1741,5 +1741,5 @@
 ! Determine timestep relative to the 1st day of TOGA-COARE:
 !       timeit=(day-day1)*86400.
-!       if (annee_ref.eq.1992) THEN
+!       if (annee_ref.EQ.1992) THEN
 !        timeit=(day-day_ini_dice)*86400.
 !       else
@@ -1754,5 +1754,5 @@
        time_dice2=(it_dice2-1)*dt_dice
 
-       if (it_dice1 .ge. nt_dice) THEN
+       IF (it_dice1 .ge. nt_dice) THEN
         WRITE(*,*) 'PB-stop: day, it_dice1, it_dice2, timeit: ',day,it_dice1,it_dice2,timeit/86400.
         stop
@@ -1808,36 +1808,36 @@
 
 ! inputs:
-        integer annee_ref
-        integer nt_gabls4,nlev_gabls4
-        integer year_ini_gabls4
-        real day, day1,day_ini_gabls4,dt_gabls4
-        real ug_gabls4(nlev_gabls4,nt_gabls4),vg_gabls4(nlev_gabls4,nt_gabls4)
-        real ht_gabls4(nlev_gabls4,nt_gabls4),hq_gabls4(nlev_gabls4,nt_gabls4)
-        real tg_gabls4(nt_gabls4), tg_prof
+        INTEGER annee_ref
+        INTEGER nt_gabls4,nlev_gabls4
+        INTEGER year_ini_gabls4
+        REAL day, day1,day_ini_gabls4,dt_gabls4
+        REAL ug_gabls4(nlev_gabls4,nt_gabls4),vg_gabls4(nlev_gabls4,nt_gabls4)
+        REAL ht_gabls4(nlev_gabls4,nt_gabls4),hq_gabls4(nlev_gabls4,nt_gabls4)
+        REAL tg_gabls4(nt_gabls4), tg_prof
 ! outputs:
-        real ug_prof(nlev_gabls4),vg_prof(nlev_gabls4)
-        real ht_prof(nlev_gabls4),hq_prof(nlev_gabls4)
+        REAL ug_prof(nlev_gabls4),vg_prof(nlev_gabls4)
+        REAL ht_prof(nlev_gabls4),hq_prof(nlev_gabls4)
 ! local:
-        integer it_gabls41, it_gabls42,k
-        real timeit,time_gabls41,time_gabls42,frac
+        INTEGER it_gabls41, it_gabls42,k
+        REAL timeit,time_gabls41,time_gabls42,frac
 
 
 
 ! Check that initial day of the simulation consistent with gabls4 period:
-       if (forcing_type.eq.8 ) THEN
+       IF (forcing_type.EQ.8 ) THEN
        print *,'annee_ref=',annee_ref
        print *,'day1=',day1
        print *,'day_ini_gabls4=',day_ini_gabls4
-       if (annee_ref.ne.2009) THEN
+       IF (annee_ref.NE.2009) THEN
         PRINT*,'Pour gabls4, annee_ref doit etre 2009'
         PRINT*,'Changer annee_ref dans run.def'
         stop
        endif
-       if (annee_ref.eq.2009 .and. day1.gt.day_ini_gabls4) THEN
+       IF (annee_ref.EQ.2009 .AND. day1.gt.day_ini_gabls4) THEN
         PRINT*,'gabls4 a debute le 11 dec 2009 (jour julien=345)'
         PRINT*,'Changer dayref dans run.def',day1,day_ini_gabls4
         stop
        endif
-       if (annee_ref.eq.2009 .and. day1.gt.day_ini_gabls4+2) THEN
+       IF (annee_ref.EQ.2009 .AND. day1.gt.day_ini_gabls4+2) THEN
         PRINT*,'gabls4 a fini le 12 dec 2009 (jour julien=346)'
         PRINT*,'Changer dayref ou nday dans run.def',day1,day_ini_gabls4
@@ -1856,5 +1856,5 @@
        time_gabls42=(it_gabls42-1)*dt_gabls4
 
-       if (it_gabls41 .ge. nt_gabls4) THEN
+       IF (it_gabls41 .ge. nt_gabls4) THEN
         WRITE(*,*) 'PB-stop: day, it_gabls41, it_gabls42, timeit: ',day,it_gabls41,it_gabls42,timeit/86400.
         stop
@@ -1896,18 +1896,18 @@
 
 ! inputs:
-        integer annee_ref
-        integer nt_armcu,nlev_armcu
-        integer year_ini_armcu
-        real day, day1,day_ini_armcu,dt_armcu
-        real fs_armcu(nt_armcu),fl_armcu(nt_armcu),at_armcu(nt_armcu)
-        real rt_armcu(nt_armcu),aqt_armcu(nt_armcu)
+        INTEGER annee_ref
+        INTEGER nt_armcu,nlev_armcu
+        INTEGER year_ini_armcu
+        REAL day, day1,day_ini_armcu,dt_armcu
+        REAL fs_armcu(nt_armcu),fl_armcu(nt_armcu),at_armcu(nt_armcu)
+        REAL rt_armcu(nt_armcu),aqt_armcu(nt_armcu)
 ! outputs:
-        real fs_prof,fl_prof,at_prof,rt_prof,aqt_prof
+        REAL fs_prof,fl_prof,at_prof,rt_prof,aqt_prof
 ! local:
-        integer it_armcu1, it_armcu2,k
-        real timeit,time_armcu1,time_armcu2,frac
+        INTEGER it_armcu1, it_armcu2,k
+        REAL timeit,time_armcu1,time_armcu2,frac
 
 ! Check that initial day of the simulation consistent with ARMCU period:
-       if (annee_ref.ne.1997 ) THEN
+       IF (annee_ref.NE.1997 ) THEN
         PRINT*,'Pour ARMCU, annee_ref doit etre 1997 '
         PRINT*,'Changer annee_ref dans run.def'
@@ -1926,5 +1926,5 @@
      &          it_armcu1,it_armcu2,time_armcu1,time_armcu2
 
-       if (it_armcu1 .ge. nt_armcu) THEN
+       IF (it_armcu1 .ge. nt_armcu) THEN
         WRITE(*,*) 'PB-stop: day, it_armcu1, it_armcu2, timeit: '          &
      &        ,day,it_armcu1,it_armcu2,timeit/86400.
@@ -1963,8 +1963,8 @@
       IMPLICIT NONE
 
-        integer nlev_max,kmax,kmax2,ntrac
-        logical :: llesread = .TRUE.
-
-        real height(nlev_max),thlprof(nlev_max),qtprof(nlev_max),          &
+        INTEGER nlev_max,kmax,kmax2,ntrac
+        LOGICAL :: llesread = .TRUE.
+
+        REAL height(nlev_max),thlprof(nlev_max),qtprof(nlev_max),          &
      &       uprof(nlev_max),vprof(nlev_max),e12prof(nlev_max),            &
      &       ugprof(nlev_max),vgprof(nlev_max),wfls(nlev_max),             &
@@ -1972,13 +1972,13 @@
      &           thlpcar(nlev_max),tracer(nlev_max,ntrac)
 
-        real height1(nlev_max)
-
-        integer, parameter :: ilesfile=1
+        REAL height1(nlev_max)
+
+        INTEGER, parameter :: ilesfile=1
         INTEGER :: ierr,k,itrac,nt1,nt2
 
-        IF(.not.(llesread)) return
+        IF(.NOT.(llesread)) return
 
        open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
-        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
+        IF (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
         read (ilesfile,*) kmax
         do k=1,kmax
@@ -1989,7 +1989,7 @@
 
        open(ilesfile,file='lscale.inp.001',status='old',iostat=ierr)
-        if (ierr /= 0) stop 'ERROR:Lscale.inp does not exist'
+        IF (ierr /= 0) stop 'ERROR:Lscale.inp does not exist'
         read (ilesfile,*) kmax2
-        if (kmax .ne. kmax2) THEN
+        IF (kmax .NE. kmax2) THEN
           print *, 'fichiers prof.inp et lscale.inp incompatibles :'
           print *, 'nbre de niveaux : ',kmax,' et ',kmax2
@@ -2001,5 +2001,5 @@
         END DO
         do k=1,kmax
-          if (height(k) .ne. height1(k)) THEN
+          IF (height(k) .NE. height1(k)) THEN
             print *, 'fichiers prof.inp et lscale.inp incompatibles :'
             print *, 'les niveaux different : ',k,height1(k), height(k)
@@ -2010,12 +2010,12 @@
 
        open(ilesfile,file='trac.inp.001',status='old',iostat=ierr)
-        if (ierr /= 0) THEN
+        IF (ierr /= 0) THEN
             PRINT*,'WARNING : trac.inp does not exist'
         else
         read (ilesfile,*) kmax2,nt1,nt2
-        if (nt2>ntrac) THEN
+        IF (nt2>ntrac) THEN
           stop 'Augmenter le nombre de traceurs dans traceur.def'
         endif
-        if (kmax .ne. kmax2) THEN
+        IF (kmax .NE. kmax2) THEN
           print *, 'fichiers prof.inp et lscale.inp incompatibles :'
           print *, 'nbre de niveaux : ',kmax,' et ',kmax2
@@ -2036,19 +2036,19 @@
       IMPLICIT NONE
 
-        integer nlev_max,kmax
-        logical :: llesread = .TRUE.
-
-        real height(nlev_max),pprof(nlev_max),tprof(nlev_max)
-        real thlprof(nlev_max)
-        real qprof(nlev_max),uprof(nlev_max),vprof(nlev_max)
-        real wprof(nlev_max),omega(nlev_max),o3mmr(nlev_max)
-
-        integer, parameter :: ilesfile=1
+        INTEGER nlev_max,kmax
+        LOGICAL :: llesread = .TRUE.
+
+        REAL height(nlev_max),pprof(nlev_max),tprof(nlev_max)
+        REAL thlprof(nlev_max)
+        REAL qprof(nlev_max),uprof(nlev_max),vprof(nlev_max)
+        REAL wprof(nlev_max),omega(nlev_max),o3mmr(nlev_max)
+
+        INTEGER, parameter :: ilesfile=1
         INTEGER :: k,ierr
 
-        IF(.not.(llesread)) return
+        IF(.NOT.(llesread)) return
 
        open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
-        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
+        IF (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
         read (ilesfile,*) kmax
         do k=1,kmax
@@ -2068,19 +2068,19 @@
       IMPLICIT NONE
 
-        integer nlev_max,kmax
-        logical :: llesread = .TRUE.
-
-        real height(nlev_max),pprof(nlev_max),tprof(nlev_max),             &
+        INTEGER nlev_max,kmax
+        LOGICAL :: llesread = .TRUE.
+
+        REAL height(nlev_max),pprof(nlev_max),tprof(nlev_max),             &
      &  thlprof(nlev_max),qlprof(nlev_max),qtprof(nlev_max),               &
      &  qvprof(nlev_max),uprof(nlev_max),vprof(nlev_max),                  &
      &  wprof(nlev_max),tkeprof(nlev_max),o3mmr(nlev_max)
 
-        integer, parameter :: ilesfile=1
+        INTEGER, parameter :: ilesfile=1
         INTEGER :: ierr,k
 
-        IF(.not.(llesread)) return
+        IF(.NOT.(llesread)) return
 
        open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
-        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
+        IF (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
         read (ilesfile,*) kmax
         do k=1,kmax
@@ -2102,17 +2102,17 @@
       IMPLICIT NONE
 
-        integer nlev_max,kmax
-        logical :: llesread = .TRUE.
-
-        real height(nlev_max),pprof(nlev_max),tprof(nlev_max)
-        real thetaprof(nlev_max),rvprof(nlev_max)
-        real qvprof(nlev_max),uprof(nlev_max),vprof(nlev_max)
-        real aprof(nlev_max+1),bprof(nlev_max+1)
-
-        integer, parameter :: ilesfile=1
-        integer, parameter :: ifile=2
+        INTEGER nlev_max,kmax
+        LOGICAL :: llesread = .TRUE.
+
+        REAL height(nlev_max),pprof(nlev_max),tprof(nlev_max)
+        REAL thetaprof(nlev_max),rvprof(nlev_max)
+        REAL qvprof(nlev_max),uprof(nlev_max),vprof(nlev_max)
+        REAL aprof(nlev_max+1),bprof(nlev_max+1)
+
+        INTEGER, parameter :: ilesfile=1
+        INTEGER, parameter :: ifile=2
         INTEGER :: ierr,jtot,k
 
-        IF(.not.(llesread)) return
+        IF(.NOT.(llesread)) return
 
 ! Read profiles at full levels
@@ -2124,5 +2124,5 @@
        print *,'On ouvre prof.inp.40'
        ENDIF
-        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
+        IF (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
         read (ilesfile,*) kmax
         do k=1,kmax
@@ -2136,9 +2136,9 @@
        open (ifile,file='proh.inp.19',status='old',iostat=ierr)
        print *,'On ouvre proh.inp.19'
-       if (ierr /= 0) stop 'ERROR:Proh.inp.19 does not exist'
+       IF (ierr /= 0) stop 'ERROR:Proh.inp.19 does not exist'
        ELSE
        open (ifile,file='proh.inp.40',status='old',iostat=ierr)
        print *,'On ouvre proh.inp.40'
-       if (ierr /= 0) stop 'ERROR:Proh.inp.40 does not exist'
+       IF (ierr /= 0) stop 'ERROR:Proh.inp.40 does not exist'
        ENDIF
         read (ifile,*) kmax
@@ -2159,9 +2159,9 @@
 
 
-      use netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
+      USE netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
             nf90_inq_dimid,nf90_inquire_dimension
       IMPLICIT NONE
 
-      integer ntime,nlevel
+      INTEGER ntime,nlevel
       character*80 :: fich_fire
       real*8 zz(nlevel)
@@ -2174,11 +2174,11 @@
       real*8 dqtdt(nlevel,ntime),thl_rad(nlevel,ntime)
 
-      integer nid, ierr
-      integer nbvar3d
+      INTEGER nid, ierr
+      INTEGER nbvar3d
       parameter(nbvar3d=30)
-      integer var3didin(nbvar3d)
+      INTEGER var3didin(nbvar3d)
 
       ierr = nf90_open(fich_fire,nf90_nowrite,nid)
-      if (ierr.NE.nf90_noerr) THEN
+      IF (ierr.NE.nf90_noerr) THEN
          WRITE(*,*) 'ERROR: Pb opening forcings nc file '
          WRITE(*,*) nf90_strerror(ierr)
@@ -2369,5 +2369,5 @@
 !program reading initial profils and forcings of the Dice case study
 
-      use netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
+      USE netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
             nf90_inq_dimid,nf90_inquire_dimension
 
@@ -2376,6 +2376,6 @@
       INCLUDE "YOMCST.h"
 
-      integer ntime,nlevel
-      integer l,k
+      INTEGER ntime,nlevel
+      INTEGER l,k
       character*80 :: fich_dice
       real*8 time(ntime)
@@ -2390,12 +2390,12 @@
       real*8 pzero
 
-      integer nid, ierr
-      integer nbvar3d
+      INTEGER nid, ierr
+      INTEGER nbvar3d
       parameter(nbvar3d=30)
-      integer var3didin(nbvar3d)
+      INTEGER var3didin(nbvar3d)
 
       pzero=100000.
       ierr = nf90_open(fich_dice,nf90_nowrite,nid)
-      if (ierr.NE.nf90_noerr) THEN
+      IF (ierr.NE.nf90_noerr) THEN
          WRITE(*,*) 'ERROR: Pb opening forcings nc file '
          WRITE(*,*) nf90_strerror(ierr)
@@ -2703,11 +2703,11 @@
 !program reading initial profils and forcings of the Gabls4 case study
 
-      use netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
+      USE netcdf, ONLY: nf90_open,nf90_nowrite,nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_get_var,&
             nf90_inq_dimid,nf90_inquire_dimension
 
       IMPLICIT NONE
 
-      integer ntime,nlevel,nsol
-      integer l,k
+      INTEGER ntime,nlevel,nsol
+      INTEGER l,k
       character*80 :: fich_gabls4
       real*8 time(ntime)
@@ -2727,11 +2727,11 @@
       real*8 depth_sn(nsol),tsnow(nsol),snow_dens(nsol)
       real*8 tg(ntime)
-      integer nid, ierr
-      integer nbvar3d
+      INTEGER nid, ierr
+      INTEGER nbvar3d
       parameter(nbvar3d=30)
-      integer var3didin(nbvar3d)
+      INTEGER var3didin(nbvar3d)
 
       ierr = nf90_open(fich_gabls4,nf90_nowrite,nid)
-      if (ierr.NE.nf90_noerr) THEN
+      IF (ierr.NE.nf90_noerr) THEN
          WRITE(*,*) 'ERROR: Pb opening forcings nc file '
          WRITE(*,*) nf90_strerror(ierr)
@@ -2949,16 +2949,16 @@
       INCLUDE "YOMCST.h"
 
-      real albsfc(ncm_1), albsfc_w(ncm_1)
-      real cf(nlev_circ), icefra(nlev_circ), deice(nlev_circ), &
+      REAL albsfc(ncm_1), albsfc_w(ncm_1)
+      REAL cf(nlev_circ), icefra(nlev_circ), deice(nlev_circ), &
            reliq(nlev_circ), reice(nlev_circ), lwp(nlev_circ), iwp(nlev_circ)
-      real t(nlev_circ+1), z(nlev_circ+1), dz(nlev_circ), p(nlev_circ+1)
-      real aer_beta(nlev_circ), waer(nlev_circ), gaer(nlev_circ)
-      real pm(nlev_circ), tm(nlev_circ), h2o(nlev_circ), o3(nlev_circ)
-      real co2(nlev_circ), n2o(nlev_circ), co(nlev_circ), ch4(nlev_circ), &
+      REAL t(nlev_circ+1), z(nlev_circ+1), dz(nlev_circ), p(nlev_circ+1)
+      REAL aer_beta(nlev_circ), waer(nlev_circ), gaer(nlev_circ)
+      REAL pm(nlev_circ), tm(nlev_circ), h2o(nlev_circ), o3(nlev_circ)
+      REAL co2(nlev_circ), n2o(nlev_circ), co(nlev_circ), ch4(nlev_circ), &
            o2(nlev_circ), ccl4(nlev_circ), f11(nlev_circ), f12(nlev_circ)
 !     za= zenital angle
 !     sza= cosinus angle zenital
-      real wavn(ncm_1), ssf(ncm_1),za,sza
-      integer nlev
+      REAL wavn(ncm_1), ssf(ncm_1),za,sza
+      INTEGER nlev
 
 
@@ -3053,7 +3053,7 @@
       INCLUDE "YOMCST.h"
 
-      real t(nlev_rtmip), pt(nlev_rtmip),pb(nlev_rtmip),h2o(nlev_rtmip), o3(nlev_rtmip)
-      real temp(nlev_rtmip), play(nlev_rtmip),ovap(nlev_rtmip), oz(nlev_rtmip),plev(nlev_rtmip+1)
-      integer nlev
+      REAL t(nlev_rtmip), pt(nlev_rtmip),pb(nlev_rtmip),h2o(nlev_rtmip), o3(nlev_rtmip)
+      REAL temp(nlev_rtmip), play(nlev_rtmip),ovap(nlev_rtmip), oz(nlev_rtmip),plev(nlev_rtmip+1)
+      INTEGER nlev
 
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_decl_cases.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_decl_cases.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_decl_cases.h	(revision 5117)
@@ -4,35 +4,35 @@
 !        integer nlev_prof
 !        parameter (nlev_prof = 41)
-        integer nlev_toga, nt_toga
+        INTEGER nlev_toga, nt_toga
         parameter (nlev_toga=41, nt_toga=480)
-        integer year_ini_toga, day_ini_toga, mth_ini_toga
-        real day_ju_ini_toga   ! Julian day of toga coare first day
+        INTEGER year_ini_toga, day_ini_toga, mth_ini_toga
+        REAL day_ju_ini_toga   ! Julian day of toga coare first day
         parameter (year_ini_toga=1992) 
         parameter (mth_ini_toga=11)
         parameter (day_ini_toga=1)  !  1erNov1992
-        real dt_toga
+        REAL dt_toga
         parameter (dt_toga=6.*3600.)
 !!
-        integer year_print, month_print, day_print
+        INTEGER year_print, month_print, day_print
         real    sec_print
 !!
-        real ts_toga(nt_toga)
-        real plev_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
-        real t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
-        real u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
-        real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
-        real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
-
-        real ts_prof
-        real plev_prof(nlev_toga),w_prof(nlev_toga)
-        real t_prof(nlev_toga),q_prof(nlev_toga)
-        real u_prof(nlev_toga),v_prof(nlev_toga)
-        real ht_prof(nlev_toga),vt_prof(nlev_toga)
-        real hq_prof(nlev_toga),vq_prof(nlev_toga)
-
-        real w_mod(llm), t_mod(llm),q_mod(llm)
-        real u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm),ug_mod(llm),vg_mod(llm)
-        real hq_mod(llm),vq_mod(llm),qv_mod(llm),ql_mod(llm),qt_mod(llm)
-        real th_mod(llm)
+        REAL ts_toga(nt_toga)
+        REAL plev_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
+        REAL t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
+        REAL u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
+        REAL ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
+        REAL hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
+
+        REAL ts_prof
+        REAL plev_prof(nlev_toga),w_prof(nlev_toga)
+        REAL t_prof(nlev_toga),q_prof(nlev_toga)
+        REAL u_prof(nlev_toga),v_prof(nlev_toga)
+        REAL ht_prof(nlev_toga),vt_prof(nlev_toga)
+        REAL hq_prof(nlev_toga),vq_prof(nlev_toga)
+
+        REAL w_mod(llm), t_mod(llm),q_mod(llm)
+        REAL u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm),ug_mod(llm),vg_mod(llm)
+        REAL hq_mod(llm),vq_mod(llm),qv_mod(llm),ql_mod(llm),qt_mod(llm)
+        REAL th_mod(llm)
 
         !real ts_cur
@@ -41,41 +41,41 @@
 ! Declarations specifiques au cas RICO
         character*80 :: fich_rico
-        integer nlev_rico
+        INTEGER nlev_rico
 
         parameter (nlev_rico=81)
-        real ts_rico,ps_rico
-        real w_rico(llm)
-        real t_rico(llm),q_rico(llm)
-        real u_rico(llm),v_rico(llm)
-        real dth_rico(llm)
-        real dqh_rico(llm)
+        REAL ts_rico,ps_rico
+        REAL w_rico(llm)
+        REAL t_rico(llm),q_rico(llm)
+        REAL u_rico(llm),v_rico(llm)
+        REAL dth_rico(llm)
+        REAL dqh_rico(llm)
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! Declarations specifiques au cas TWPice
         character*80 :: fich_twpice
-        integer nlev_twpi, nt_twpi
+        INTEGER nlev_twpi, nt_twpi
         parameter (nlev_twpi=40, nt_twpi=215)
-        integer year_ini_twpi, day_ini_twpi, mth_ini_twpi
-        real heure_ini_twpi
-        real day_ju_ini_twpi   ! Julian day of twpice first day
+        INTEGER year_ini_twpi, day_ini_twpi, mth_ini_twpi
+        REAL heure_ini_twpi
+        REAL day_ju_ini_twpi   ! Julian day of twpice first day
         parameter (year_ini_twpi=2006) 
         parameter (mth_ini_twpi=1)
         parameter (day_ini_twpi=17)  ! 17 = 17Jan2006
         parameter (heure_ini_twpi=10800.) !3h en secondes
-        real dt_twpi
+        REAL dt_twpi
         parameter (dt_twpi=3.*3600.)
 
-        real ts_twpi(nt_twpi)
-        real plev_twpi(nlev_twpi,nt_twpi),w_twpi(nlev_twpi,nt_twpi)
-        real t_twpi(nlev_twpi,nt_twpi),q_twpi(nlev_twpi,nt_twpi)
-        real u_twpi(nlev_twpi,nt_twpi),v_twpi(nlev_twpi,nt_twpi)
-        real ht_twpi(nlev_twpi,nt_twpi),vt_twpi(nlev_twpi,nt_twpi)
-        real hq_twpi(nlev_twpi,nt_twpi),vq_twpi(nlev_twpi,nt_twpi)
-
-        real ts_proftwp
-        real plev_proftwp(nlev_twpi),w_proftwp(nlev_twpi)
-        real t_proftwp(nlev_twpi),q_proftwp(nlev_twpi)
-        real u_proftwp(nlev_twpi),v_proftwp(nlev_twpi)
-        real ht_proftwp(nlev_twpi),vt_proftwp(nlev_twpi)
-        real hq_proftwp(nlev_twpi),vq_proftwp(nlev_twpi)
+        REAL ts_twpi(nt_twpi)
+        REAL plev_twpi(nlev_twpi,nt_twpi),w_twpi(nlev_twpi,nt_twpi)
+        REAL t_twpi(nlev_twpi,nt_twpi),q_twpi(nlev_twpi,nt_twpi)
+        REAL u_twpi(nlev_twpi,nt_twpi),v_twpi(nlev_twpi,nt_twpi)
+        REAL ht_twpi(nlev_twpi,nt_twpi),vt_twpi(nlev_twpi,nt_twpi)
+        REAL hq_twpi(nlev_twpi,nt_twpi),vq_twpi(nlev_twpi,nt_twpi)
+
+        REAL ts_proftwp
+        REAL plev_proftwp(nlev_twpi),w_proftwp(nlev_twpi)
+        REAL t_proftwp(nlev_twpi),q_proftwp(nlev_twpi)
+        REAL u_proftwp(nlev_twpi),v_proftwp(nlev_twpi)
+        REAL ht_proftwp(nlev_twpi),vt_proftwp(nlev_twpi)
+        REAL hq_proftwp(nlev_twpi),vq_proftwp(nlev_twpi)
 
 
@@ -83,8 +83,8 @@
 !Declarations specifiques au cas FIRE
         character*80 :: fich_fire
-        integer nlev_fire, nt_fire
+        INTEGER nlev_fire, nt_fire
         parameter (nlev_fire=120, nt_fire=1)  
-        integer year_ini_fire, day_ini_fire, mth_ini_fire
-        real heure_ini_fire
+        INTEGER year_ini_fire, day_ini_fire, mth_ini_fire
+        REAL heure_ini_fire
         parameter (year_ini_fire=1987) 
         parameter (mth_ini_fire=7)
@@ -95,33 +95,33 @@
 !Declarations specifiques au cas GABLS4   (MPL 20141023)
         character*80 :: fich_gabls4
-        integer nlev_gabls4, nt_gabls4, nsol_gabls4
+        INTEGER nlev_gabls4, nt_gabls4, nsol_gabls4
         parameter (nlev_gabls4=90, nt_gabls4=37, nsol_gabls4=19)  
-        integer year_ini_gabls4, day_ini_gabls4, mth_ini_gabls4
-        real heure_ini_gabls4
-        real day_ju_ini_gabls4   ! Julian day of gabls4 first day
+        INTEGER year_ini_gabls4, day_ini_gabls4, mth_ini_gabls4
+        REAL heure_ini_gabls4
+        REAL day_ju_ini_gabls4   ! Julian day of gabls4 first day
         parameter (year_ini_gabls4=2009) 
         parameter (mth_ini_gabls4=12)
         parameter (day_ini_gabls4=11)  ! 11 = 11 decembre 2009
         parameter (heure_ini_gabls4=0.) !0UTC en secondes
-        real dt_gabls4
+        REAL dt_gabls4
         parameter (dt_gabls4=3600.) ! 1 forcage ttes les heures
 
 !profils initiaux:
-        real plev_gabls4(nlev_gabls4)
-        real zz_gabls4(nlev_gabls4)
-        real th_gabls4(nlev_gabls4),t_gabls4(nlev_gabls4),qv_gabls4(nlev_gabls4)
-        real u_gabls4(nlev_gabls4), v_gabls4(nlev_gabls4)
-        real depth_sn_gabls4(nsol_gabls4),tsnow_gabls4(nsol_gabls4),snow_dens_gabls4(nsol_gabls4)
-        real t_gabi(nlev_gabls4),qv_gabi(nlev_gabls4)
-        real u_gabi(nlev_gabls4), v_gabi(nlev_gabls4),ug_gabi(nlev_gabls4), vg_gabi(nlev_gabls4)
-        real ht_gabi(nlev_gabls4),hq_gabi(nlev_gabls4),poub(nlev_gabls4)
+        REAL plev_gabls4(nlev_gabls4)
+        REAL zz_gabls4(nlev_gabls4)
+        REAL th_gabls4(nlev_gabls4),t_gabls4(nlev_gabls4),qv_gabls4(nlev_gabls4)
+        REAL u_gabls4(nlev_gabls4), v_gabls4(nlev_gabls4)
+        REAL depth_sn_gabls4(nsol_gabls4),tsnow_gabls4(nsol_gabls4),snow_dens_gabls4(nsol_gabls4)
+        REAL t_gabi(nlev_gabls4),qv_gabi(nlev_gabls4)
+        REAL u_gabi(nlev_gabls4), v_gabi(nlev_gabls4),ug_gabi(nlev_gabls4), vg_gabi(nlev_gabls4)
+        REAL ht_gabi(nlev_gabls4),hq_gabi(nlev_gabls4),poub(nlev_gabls4)
         
 !forcings
-        real ht_gabls4(nlev_gabls4,nt_gabls4),hq_gabls4(nlev_gabls4,nt_gabls4)
-        real ug_gabls4(nlev_gabls4,nt_gabls4),vg_gabls4(nlev_gabls4,nt_gabls4)
-        real tg_gabls4(nt_gabls4)
-        real ht_profg(nlev_gabls4),hq_profg(nlev_gabls4)
-        real ug_profg(nlev_gabls4),vg_profg(nlev_gabls4)
-        real tg_profg
+        REAL ht_gabls4(nlev_gabls4,nt_gabls4),hq_gabls4(nlev_gabls4,nt_gabls4)
+        REAL ug_gabls4(nlev_gabls4,nt_gabls4),vg_gabls4(nlev_gabls4,nt_gabls4)
+        REAL tg_gabls4(nt_gabls4)
+        REAL ht_profg(nlev_gabls4),hq_profg(nlev_gabls4)
+        REAL ug_profg(nlev_gabls4),vg_profg(nlev_gabls4)
+        REAL tg_profg
          
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -129,46 +129,46 @@
 !Declarations specifiques au cas DICE     (MPL 02072013)
         character*80 :: fich_dice
-        integer nlev_dice, nt_dice
+        INTEGER nlev_dice, nt_dice
         parameter (nlev_dice=70, nt_dice=145)  
-        integer year_ini_dice, day_ini_dice, mth_ini_dice
-        real heure_ini_dice
-        real day_ju_ini_dice   ! Julian day of dice first day
+        INTEGER year_ini_dice, day_ini_dice, mth_ini_dice
+        REAL heure_ini_dice
+        REAL day_ju_ini_dice   ! Julian day of dice first day
         parameter (year_ini_dice=1999) 
         parameter (mth_ini_dice=10)
         parameter (day_ini_dice=23)  ! 23 = 23 october 1999
         parameter (heure_ini_dice=68400.) !19UTC en secondes
-        real dt_dice
+        REAL dt_dice
         parameter (dt_dice=0.5*3600.) ! 1 forcage ttes les demi-heures
 
 !profils initiaux:
-        real plev_dice(nlev_dice)
-        
-        real zz_dice(nlev_dice)
-        real t_dice(nlev_dice),qv_dice(nlev_dice)
-        real u_dice(nlev_dice), v_dice(nlev_dice),o3_dice(nlev_dice)
-        real ht_dice(nlev_dice,nt_dice)
-        real hq_dice(nlev_dice,nt_dice), hu_dice(nlev_dice,nt_dice)
-        real hv_dice(nlev_dice,nt_dice)
-        real w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
-        real o3_mod(llm),hu_mod(llm),hv_mod(llm)
-        real t_dicei(nlev_dice),qv_dicei(nlev_dice)
-        real u_dicei(nlev_dice), v_dicei(nlev_dice),o3_dicei(nlev_dice)
-        real ht_dicei(nlev_dice)
-        real hq_dicei(nlev_dice), hu_dicei(nlev_dice)
-        real hv_dicei(nlev_dice)
-        real w_dicei(nlev_dice),omega_dicei(nlev_dice)
+        REAL plev_dice(nlev_dice)
+        
+        REAL zz_dice(nlev_dice)
+        REAL t_dice(nlev_dice),qv_dice(nlev_dice)
+        REAL u_dice(nlev_dice), v_dice(nlev_dice),o3_dice(nlev_dice)
+        REAL ht_dice(nlev_dice,nt_dice)
+        REAL hq_dice(nlev_dice,nt_dice), hu_dice(nlev_dice,nt_dice)
+        REAL hv_dice(nlev_dice,nt_dice)
+        REAL w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
+        REAL o3_mod(llm),hu_mod(llm),hv_mod(llm)
+        REAL t_dicei(nlev_dice),qv_dicei(nlev_dice)
+        REAL u_dicei(nlev_dice), v_dicei(nlev_dice),o3_dicei(nlev_dice)
+        REAL ht_dicei(nlev_dice)
+        REAL hq_dicei(nlev_dice), hu_dicei(nlev_dice)
+        REAL hv_dicei(nlev_dice)
+        REAL w_dicei(nlev_dice),omega_dicei(nlev_dice)
 
         
 !forcings
-        real shf_dice(nt_dice),lhf_dice(nt_dice)
-        real lwup_dice(nt_dice),swup_dice(nt_dice)
-        real tg_dice(nt_dice),ustar_dice(nt_dice),psurf_dice(nt_dice)
-        real ug_dice(nt_dice),vg_dice(nt_dice)
-
-        real shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof
-        real ustar_prof,psurf_prof,cdrag
-        real ht_profd(nlev_dice),hq_profd(nlev_dice),hu_profd(nlev_dice)
-        real hv_profd(nlev_dice),w_profd(nlev_dice)
-        real omega_profd(nlev_dice),ug_profd,vg_profd
+        REAL shf_dice(nt_dice),lhf_dice(nt_dice)
+        REAL lwup_dice(nt_dice),swup_dice(nt_dice)
+        REAL tg_dice(nt_dice),ustar_dice(nt_dice),psurf_dice(nt_dice)
+        REAL ug_dice(nt_dice),vg_dice(nt_dice)
+
+        REAL shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof
+        REAL ustar_prof,psurf_prof,cdrag
+        REAL ht_profd(nlev_dice),hq_profd(nlev_dice),hu_profd(nlev_dice)
+        REAL hv_profd(nlev_dice),w_profd(nlev_dice)
+        REAL omega_profd(nlev_dice),ug_profd,vg_profd
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -183,5 +183,5 @@
         real  Ts_gcssold
         real  dtime_frcg
-        logical :: Turb_fcg_gcssold
+        LOGICAL :: Turb_fcg_gcssold
 
         common /turb_forcing/                                                   &
@@ -192,24 +192,24 @@
 
 
-        integer nlev_armcu, nt_armcu
+        INTEGER nlev_armcu, nt_armcu
         parameter (nlev_armcu=40, nt_armcu=31)
-        integer year_ini_armcu, day_ini_armcu, mth_ini_armcu
+        INTEGER year_ini_armcu, day_ini_armcu, mth_ini_armcu
         real  heure_ini_armcu
-        real day_ju_ini_armcu                                ! Julian day of armcu case first day
+        REAL day_ju_ini_armcu                                ! Julian day of armcu case first day
         parameter (year_ini_armcu=1997) 
         parameter (mth_ini_armcu=6)
         parameter (day_ini_armcu=21)  ! 172 = 21 juin 1997
         parameter (heure_ini_armcu=41400)   ! 11:30 en secondes
-        real dt_armcu
+        REAL dt_armcu
         parameter (dt_armcu=1.*1800.)   ! forcages donnes ttes les demi-heures par ifa_armcu.txt
-        real sens_armcu(nt_armcu),flat_armcu(nt_armcu)
-        real adv_theta_armcu(nt_armcu),rad_theta_armcu(nt_armcu)
-        real adv_qt_armcu(nt_armcu)
-        real theta_mod(llm),rv_mod(llm),play_mod(llm)
+        REAL sens_armcu(nt_armcu),flat_armcu(nt_armcu)
+        REAL adv_theta_armcu(nt_armcu),rad_theta_armcu(nt_armcu)
+        REAL adv_qt_armcu(nt_armcu)
+        REAL theta_mod(llm),rv_mod(llm),play_mod(llm)
 ! profc comme "profil armcu"
         
 ! forcages interpoles dans le temps
-        real adv_theta_prof,rad_theta_prof,adv_qt_prof
-        real sens_prof,flat_prof,fact
+        REAL adv_theta_prof,rad_theta_prof,adv_qt_prof
+        REAL sens_prof,flat_prof,fact
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! declarations specifiques au cas Sandu
@@ -217,76 +217,76 @@
 !        integer nlev_prof
 !        parameter (nlev_prof = 41)
-        integer nlev_sandu, nt_sandu
+        INTEGER nlev_sandu, nt_sandu
         parameter (nlev_sandu=87, nt_sandu=13)
-        integer year_ini_sandu, day_ini_sandu, mth_ini_sandu
-        real day_ju_ini_sandu                                ! Julian day of sandu case first day
+        INTEGER year_ini_sandu, day_ini_sandu, mth_ini_sandu
+        REAL day_ju_ini_sandu                                ! Julian day of sandu case first day
         parameter (year_ini_sandu=2006)
         parameter (mth_ini_sandu=7)
         parameter (day_ini_sandu=15)  ! 196 = 15 juillet 2006
-        real dt_sandu, tau_sandu
+        REAL dt_sandu, tau_sandu
         logical  :: trouve_700=.TRUE.
         parameter (dt_sandu=6.*3600.)   ! forcages donnes ttes les 6 heures par ifa_sandu.txt
         parameter (tau_sandu=30000*3600.)  ! temps de relaxation u,v,thetal,qt vers profil init et au dessus 700hPa
 !!
-        real ts_sandu(nt_sandu)
+        REAL ts_sandu(nt_sandu)
 ! profs comme "profil sandu"
-        real plev_profs(nlev_sandu)
-        real t_profs(nlev_sandu),thl_profs(nlev_sandu)
-        real q_profs(nlev_sandu)
-        real u_profs(nlev_sandu),v_profs(nlev_sandu),w_profs(nlev_sandu)
-        real omega_profs(nlev_sandu),o3mmr_profs(nlev_sandu)
-
-        real, dimension(llm) :: relax_u,relax_v,relax_thl
-        real, dimension(llm,2) :: relax_q
-
-        real thl_mod(llm),omega_mod(llm),o3mmr_mod(llm),tke_mod(llm)
+        REAL plev_profs(nlev_sandu)
+        REAL t_profs(nlev_sandu),thl_profs(nlev_sandu)
+        REAL q_profs(nlev_sandu)
+        REAL u_profs(nlev_sandu),v_profs(nlev_sandu),w_profs(nlev_sandu)
+        REAL omega_profs(nlev_sandu),o3mmr_profs(nlev_sandu)
+
+        REAL, DIMENSION(llm) :: relax_u,relax_v,relax_thl
+        REAL, DIMENSION(llm,2) :: relax_q
+
+        REAL thl_mod(llm),omega_mod(llm),o3mmr_mod(llm),tke_mod(llm)
 !vertical advection computation
-        real d_t_z(llm),d_th_z(llm), d_q_z(llm)
-        real d_t_dyn_z(llm),d_th_dyn_z(llm), d_q_dyn_z(llm)
-        real d_u_z(llm),d_v_z(llm)
-        real d_u_dyn(llm),d_v_dyn(llm)
-        real d_u_dyn_z(llm),d_v_dyn_z(llm)
-        real d_u_adv(llm),d_v_adv(llm)
-        real zz(llm)
-        real zfact
+        REAL d_t_z(llm),d_th_z(llm), d_q_z(llm)
+        REAL d_t_dyn_z(llm),d_th_dyn_z(llm), d_q_dyn_z(llm)
+        REAL d_u_z(llm),d_v_z(llm)
+        REAL d_u_dyn(llm),d_v_dyn(llm)
+        REAL d_u_dyn_z(llm),d_v_dyn_z(llm)
+        REAL d_u_adv(llm),d_v_adv(llm)
+        REAL zz(llm)
+        REAL zfact
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! Declarations specifiques au cas Astex
         character*80 :: fich_astex
-        integer nlev_astex, nt_astex
+        INTEGER nlev_astex, nt_astex
         parameter (nlev_astex=34, nt_astex=49)
-        integer year_ini_astex, day_ini_astex, mth_ini_astex
-        real day_ju_ini_astex                                ! Julian day of astex case first day
+        INTEGER year_ini_astex, day_ini_astex, mth_ini_astex
+        REAL day_ju_ini_astex                                ! Julian day of astex case first day
         parameter (year_ini_astex=1992)
         parameter (mth_ini_astex=6)
         parameter (day_ini_astex=13)  ! 165 = 13 juin 1992
-        real dt_astex
+        REAL dt_astex
         parameter (dt_astex=3600.)    ! forcages donnes ttes les heures par ifa_astex.txt
-        real ts_astex(nt_astex),div_astex(nt_astex),ug_astex(nt_astex)
-        real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
-        real div_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
+        REAL ts_astex(nt_astex),div_astex(nt_astex),ug_astex(nt_astex)
+        REAL vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
+        REAL div_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
 ! profa comme "profil astex"
-        real plev_profa(nlev_astex)
-        real t_profa(nlev_astex),thl_profa(nlev_astex)
-        real qv_profa(nlev_astex),ql_profa(nlev_astex)
-        real qt_profa(nlev_astex),o3mmr_profa(nlev_astex)
-        real u_profa(nlev_astex),v_profa(nlev_astex),w_profa(nlev_astex)
-        real tke_profa(nlev_astex)
+        REAL plev_profa(nlev_astex)
+        REAL t_profa(nlev_astex),thl_profa(nlev_astex)
+        REAL qv_profa(nlev_astex),ql_profa(nlev_astex)
+        REAL qt_profa(nlev_astex),o3mmr_profa(nlev_astex)
+        REAL u_profa(nlev_astex),v_profa(nlev_astex),w_profa(nlev_astex)
+        REAL tke_profa(nlev_astex)
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 !Declarations specifiques au cas standard
 
-        real w_mod_cas(llm), t_mod_cas(llm),q_mod_cas(llm)
-        real theta_mod_cas(llm),thl_mod_cas(llm),thv_mod_cas(llm)
-        real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
-        real ug_mod_cas(llm),vg_mod_cas(llm)
-        real u_mod_cas(llm),v_mod_cas(llm)
-        real omega_mod_cas(llm)
-        real ht_mod_cas(llm),vt_mod_cas(llm),dt_mod_cas(llm),dtrad_mod_cas(llm)
-        real hth_mod_cas(llm),vth_mod_cas(llm),dth_mod_cas(llm)
-        real hq_mod_cas(llm),vq_mod_cas(llm),dq_mod_cas(llm)
-        real hu_mod_cas(llm),vu_mod_cas(llm),du_mod_cas(llm)
-        real hv_mod_cas(llm),vv_mod_cas(llm),dv_mod_cas(llm)
-        integer day_ini_cas
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
+        REAL w_mod_cas(llm), t_mod_cas(llm),q_mod_cas(llm)
+        REAL theta_mod_cas(llm),thl_mod_cas(llm),thv_mod_cas(llm)
+        REAL qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
+        REAL ug_mod_cas(llm),vg_mod_cas(llm)
+        REAL u_mod_cas(llm),v_mod_cas(llm)
+        REAL omega_mod_cas(llm)
+        REAL ht_mod_cas(llm),vt_mod_cas(llm),dt_mod_cas(llm),dtrad_mod_cas(llm)
+        REAL hth_mod_cas(llm),vth_mod_cas(llm),dth_mod_cas(llm)
+        REAL hq_mod_cas(llm),vq_mod_cas(llm),dq_mod_cas(llm)
+        REAL hu_mod_cas(llm),vu_mod_cas(llm),du_mod_cas(llm)
+        REAL hv_mod_cas(llm),vv_mod_cas(llm),dv_mod_cas(llm)
+        INTEGER day_ini_cas
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_interp_cases.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_interp_cases.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_interp_cases.h	(revision 5117)
@@ -5,5 +5,5 @@
 ! Forcing_LES case: constant dq_dyn
 !---------------------------------------------------------------------
-      if (forcing_LES) THEN
+      IF (forcing_LES) THEN
         DO l = 1,llm
           d_q_adv(l,1) = dq_dyn(l,1)
@@ -14,5 +14,5 @@
 ! Interpolation forcing in time and onto model levels
 !---------------------------------------------------------------------
-      if (forcing_GCSSold) THEN
+      IF (forcing_GCSSold) THEN
        CALL get_uvd(it,timestep,fich_gcssold_ctl,fich_gcssold_dat,              &
      &               ht_gcssold,hq_gcssold,hw_gcssold,                          &
@@ -21,5 +21,5 @@
      &               imp_fcg_gcssold,ts_fcg_gcssold,                            &
      &               Tp_fcg_gcssold,Turb_fcg_gcssold)
-       if (prt_level.ge.1) THEN
+       IF (prt_level.ge.1) THEN
          print *,' get_uvd -> hqturb_gcssold ',it,hqturb_gcssold
        endif
@@ -46,6 +46,6 @@
 ! Interpolation Toga forcing 
 !---------------------------------------------------------------------
-      if (forcing_toga) THEN
-       if (prt_level.ge.1) THEN
+      IF (forcing_toga) THEN
+       IF (prt_level.ge.1) THEN
         PRINT*,                                                             &
      & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_toga=',     &
@@ -61,5 +61,5 @@
      &             ,ht_prof,vt_prof,hq_prof,vq_prof)
 ! EV: tg instead of ts_cur
-        if (type_ts_forcing.eq.1) tg = ts_prof ! 
+        IF (type_ts_forcing.EQ.1) tg = ts_prof !
 
 ! vertical interpolation:
@@ -91,6 +91,6 @@
 ! Interpolation DICE forcing 
 !---------------------------------------------------------------------
-      if (forcing_dice) THEN
-       if (prt_level.ge.1) THEN
+      IF (forcing_dice) THEN
+       IF (prt_level.ge.1) THEN
         PRINT*,'#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_dice=',&
      &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_dice
@@ -111,5 +111,5 @@
 !     enddo
 ! EV tg instead of ts_cur
-        if (type_ts_forcing.eq.1) tg = tg_prof ! SST used 
+        IF (type_ts_forcing.EQ.1) tg = tg_prof ! SST used
 
 ! vertical interpolation:
@@ -191,6 +191,6 @@
 ! Interpolation gabls4 forcing 
 !---------------------------------------------------------------------
-      if (forcing_gabls4 ) THEN
-       if (prt_level.ge.1) THEN
+      IF (forcing_gabls4 ) THEN
+       IF (prt_level.ge.1) THEN
         PRINT*,'#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_gabls4=',&
      &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_gabls4
@@ -203,5 +203,5 @@
      &             ,ug_profg,vg_profg,ht_profg,hq_profg,tg_profg)
 !EV tg instead of ts_cur
-        if (type_ts_forcing.eq.1) tg = tg_prof ! SST used
+        IF (type_ts_forcing.EQ.1) tg = tg_prof ! SST used
 
 ! vertical interpolation:
@@ -232,5 +232,5 @@
 ! Interpolation forcing TWPice
 !---------------------------------------------------------------------
-      if (forcing_twpice) THEN
+      IF (forcing_twpice) THEN
         PRINT*,                                                             &
      & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_twpi=',     &
@@ -277,7 +277,7 @@
 !wind nudging above 500m with a 2h time scale
         do l=1,llm
-        if (nudge_wind) THEN
+        IF (nudge_wind) THEN
 !           if (phi(l).gt.5000.) THEN
-        if (phi(l).gt.0.) THEN
+        IF (phi(l).gt.0.) THEN
         u(l)=u(l)+timestep*(u_mod(l)-u(l))/(2.*3600.)
         v(l)=v(l)+timestep*(v_mod(l)-v(l))/(2.*3600.)
@@ -290,12 +290,12 @@
 
 !CR:nudging of q and theta with a 6h time scale above 15km
-        if (nudge_thermo) THEN
+        IF (nudge_thermo) THEN
         do l=1,llm
            zz(l)=phi(l)/9.8
-           if ((zz(l).le.16000.).and.(zz(l).gt.15000.)) THEN
+           IF ((zz(l).le.16000.).AND.(zz(l).gt.15000.)) THEN
              zfact=(zz(l)-15000.)/1000.
         q(l,1)=q(l,1)+timestep*(q_mod(l)-q(l,1))/(6.*3600.)*zfact
         temp(l)=temp(l)+timestep*(t_mod(l)-temp(l))/(6.*3600.)*zfact
-           else if (zz(l).gt.16000.) THEN
+           ELSE IF (zz(l).gt.16000.) THEN
         q(l,1)=q(l,1)+timestep*(q_mod(l)-q(l,1))/(6.*3600.)
         temp(l)=temp(l)+timestep*(t_mod(l)-temp(l))/(6.*3600.)
@@ -309,5 +309,5 @@
        alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
 !calcul de l'advection totale
-        if (cptadvw) THEN
+        IF (cptadvw) THEN
         d_t_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)-d_t_dyn_z(l)
 !        PRINT*,'temp vert adv',l,ht_mod(l),vt_mod(l),-d_t_dyn_z(l)
@@ -328,5 +328,5 @@
 !---------------------------------------------------------------------
 
-       if (forcing_amma) THEN
+       IF (forcing_amma) THEN
         PRINT*,                                                             &
      & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_amma=',     &
@@ -410,5 +410,5 @@
 ! Interpolation forcing Rico
 !---------------------------------------------------------------------
-      if (forcing_rico) THEN
+      IF (forcing_rico) THEN
 !      CALL lstendH(llm,omega,dt_dyn,dq_dyn,du_dyn, dv_dyn,q,temp,u,v,play)
        CALL lstendH(llm,nqtot,omega,dt_dyn,dq_dyn,q,temp,u,v,play)
@@ -424,5 +424,5 @@
 ! Interpolation forcing Arm_cu
 !---------------------------------------------------------------------
-      if (forcing_armcu) THEN
+      IF (forcing_armcu) THEN
         PRINT*,                                                             &
      & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_armcu=',    &
@@ -479,5 +479,5 @@
 ! Interpolation forcing in time and onto model levels
 !---------------------------------------------------------------------
-      if (forcing_sandu) THEN
+      IF (forcing_sandu) THEN
         PRINT*,                                                             &
      & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_sandu=',    &
@@ -492,5 +492,5 @@
      &             ,ts_sandu,ts_prof)
 ! EV tg instead of ts_cur
-        if (type_ts_forcing.eq.1) tg = ts_prof ! SST used in read_tsurf1d
+        IF (type_ts_forcing.EQ.1) tg = ts_prof ! SST used in read_tsurf1d
 
 ! vertical interpolation:
@@ -560,5 +560,5 @@
 ! Interpolation forcing in time and onto model levels
 !---------------------------------------------------------------------
-      if (forcing_astex) THEN
+      IF (forcing_astex) THEN
         PRINT*,                                                             &
      & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_astex=',    &
@@ -574,5 +574,5 @@
      &             ,ufa_prof,vfa_prof)
 ! EV tg instead of ts_cur
-        if (type_ts_forcing.eq.1) tg = ts_prof ! SST used 
+        IF (type_ts_forcing.EQ.1) tg = ts_prof ! SST used
 ! vertical interpolation:
       CALL interp_astex_vertical(play,nlev_astex,plev_profa                 &
@@ -642,5 +642,5 @@
 ! Interpolation forcing standard case
 !---------------------------------------------------------------------
-      if (forcing_case) THEN
+      IF (forcing_case) THEN
          PRINT*,'FORCING CASE forcing_case'
 
@@ -714,5 +714,5 @@
 
 !wind nudging 
-      if (nudge_u.gt.0.) THEN
+      IF (nudge_u.gt.0.) THEN
         do l=1,llm
            u(l)=u(l)+timestep*(u_mod_cas(l)-u(l))/(nudge_u)
@@ -724,5 +724,5 @@
       endif
 
-      if (nudge_v.gt.0.) THEN
+      IF (nudge_v.gt.0.) THEN
         do l=1,llm
            v(l)=v(l)+timestep*(v_mod_cas(l)-v(l))/(nudge_v)
@@ -734,5 +734,5 @@
       endif
 
-      if (nudge_w.gt.0.) THEN
+      IF (nudge_w.gt.0.) THEN
         do l=1,llm
            w(l)=w(l)+timestep*(w_mod_cas(l)-w(l))/(nudge_w)
@@ -745,10 +745,10 @@
 
 !nudging of q and temp 
-      if (nudge_t.gt.0.) THEN
+      IF (nudge_t.gt.0.) THEN
         do l=1,llm
            temp(l)=temp(l)+timestep*(t_mod_cas(l)-temp(l))/(nudge_t)
         enddo
       endif
-      if (nudge_q.gt.0.) THEN
+      IF (nudge_q.gt.0.) THEN
         do l=1,llm
            q(l,1)=q(l,1)+timestep*(q_mod_cas(l)-q(l,1))/(nudge_q)
@@ -762,33 +762,33 @@
 
 !calcul advection
-        if ((tend_u.eq.1).and.(tend_w.eq.0)) THEN
+        IF ((tend_u.EQ.1).AND.(tend_w.EQ.0)) THEN
            d_u_adv(l)=du_mod_cas(l)
-        else if ((tend_u.eq.1).and.(tend_w.eq.1)) THEN
+        ELSE IF ((tend_u.EQ.1).AND.(tend_w.EQ.1)) THEN
            d_u_adv(l)=hu_mod_cas(l)-d_u_dyn_z(l)
         endif
 
-        if ((tend_v.eq.1).and.(tend_w.eq.0)) THEN
+        IF ((tend_v.EQ.1).AND.(tend_w.EQ.0)) THEN
            d_v_adv(l)=dv_mod_cas(l)
-        else if ((tend_v.eq.1).and.(tend_w.eq.1)) THEN
+        ELSE IF ((tend_v.EQ.1).AND.(tend_w.EQ.1)) THEN
            d_v_adv(l)=hv_mod_cas(l)-d_v_dyn_z(l)
         endif
 
-        if ((tend_t.eq.1).and.(tend_w.eq.0)) THEN
+        IF ((tend_t.EQ.1).AND.(tend_w.EQ.0)) THEN
 !           d_t_adv(l)=alpha*omega(l)/rcpd+dt_mod_cas(l)
            d_t_adv(l)=alpha*omega(l)/rcpd-dt_mod_cas(l)
-        else if ((tend_t.eq.1).and.(tend_w.eq.1)) THEN
+        ELSE IF ((tend_t.EQ.1).AND.(tend_w.EQ.1)) THEN
 !           d_t_adv(l)=alpha*omega(l)/rcpd+ht_mod_cas(l)-d_t_dyn_z(l)
            d_t_adv(l)=alpha*omega(l)/rcpd-ht_mod_cas(l)-d_t_dyn_z(l)
         endif
 
-        if ((tend_q.eq.1).and.(tend_w.eq.0)) THEN
+        IF ((tend_q.EQ.1).AND.(tend_w.EQ.0)) THEN
 !           d_q_adv(l,1)=dq_mod_cas(l)
            d_q_adv(l,1)=-1*dq_mod_cas(l)
-        else if ((tend_q.eq.1).and.(tend_w.eq.1)) THEN
+        ELSE IF ((tend_q.EQ.1).AND.(tend_w.EQ.1)) THEN
 !           d_q_adv(l,1)=hq_mod_cas(l)-d_q_dyn_z(l)
            d_q_adv(l,1)=-1*hq_mod_cas(l)-d_q_dyn_z(l)
         endif
          
-        if (tend_rayo.eq.1) THEN
+        IF (tend_rayo.EQ.1) THEN
            dt_cooling(l) = dtrad_mod_cas(l)
 !          print *,'dt_cooling=',dt_cooling(l)
@@ -814,5 +814,5 @@
 ! Interpolation forcing standard case
 !---------------------------------------------------------------------
-      if (forcing_case2 .OR. forcing_SCM) THEN
+      IF (forcing_case2 .OR. forcing_SCM) THEN
          PRINT*,'FORCING CASE forcing_case2'
         PRINT*,                                                             &
@@ -904,5 +904,5 @@
 
 !geostrophic wind 
-      if (forc_geo.eq.1) THEN
+      IF (forc_geo.EQ.1) THEN
         do l=1,llm
         ug(l) = ug_mod_cas(l) 
@@ -911,5 +911,5 @@
       endif
 !wind nudging 
-      if (nudging_u.gt.0.) THEN
+      IF (nudging_u.gt.0.) THEN
         do l=1,llm
            u(l)=u(l)+timestep*(u_mod_cas(l)-u(l))/(nudge_u)
@@ -921,5 +921,5 @@
       endif
 
-      if (nudging_v.gt.0.) THEN
+      IF (nudging_v.gt.0.) THEN
         do l=1,llm
            v(l)=v(l)+timestep*(v_mod_cas(l)-v(l))/(nudge_v)
@@ -931,5 +931,5 @@
       endif
 
-      if (nudging_w.gt.0.) THEN
+      IF (nudging_w.gt.0.) THEN
         do l=1,llm
            w(l)=w(l)+timestep*(w_mod_cas(l)-w(l))/(nudge_w)
@@ -942,10 +942,10 @@
 
 !nudging of q and temp 
-      if (nudging_t.gt.0.) THEN
+      IF (nudging_t.gt.0.) THEN
         do l=1,llm
            temp(l)=temp(l)+timestep*(t_mod_cas(l)-temp(l))/(nudge_t)
         enddo
       endif
-      if (nudging_qv.gt.0.) THEN
+      IF (nudging_qv.gt.0.) THEN
         do l=1,llm
            q(l,1)=q(l,1)+timestep*(q_mod_cas(l)-q(l,1))/(nudge_q)
@@ -960,13 +960,13 @@
 
 !calcul advections
-        if ((forc_u.eq.1).and.(forc_w.eq.0)) THEN
+        IF ((forc_u.EQ.1).AND.(forc_w.EQ.0)) THEN
            d_u_adv(l)=du_mod_cas(l)
-        else if ((forc_u.eq.1).and.(forc_w.eq.1)) THEN
+        ELSE IF ((forc_u.EQ.1).AND.(forc_w.EQ.1)) THEN
            d_u_adv(l)=hu_mod_cas(l)-d_u_dyn_z(l)
         endif
 
-        if ((forc_v.eq.1).and.(forc_w.eq.0)) THEN
+        IF ((forc_v.EQ.1).AND.(forc_w.EQ.0)) THEN
            d_v_adv(l)=dv_mod_cas(l)
-        else if ((forc_v.eq.1).and.(forc_w.eq.1)) THEN
+        ELSE IF ((forc_v.EQ.1).AND.(forc_w.EQ.1)) THEN
            d_v_adv(l)=hv_mod_cas(l)-d_v_dyn_z(l)
         endif
@@ -974,29 +974,29 @@
 ! Puisque dth a ete converti en dt, on traite de la meme facon 
 ! les flags tadv et thadv
-        if ((tadv.eq.1.or.thadv.eq.1) .and. (forc_w.eq.0)) THEN
+        IF ((tadv.EQ.1.OR.thadv.EQ.1) .AND. (forc_w.EQ.0)) THEN
 !          d_t_adv(l)=alpha*omega(l)/rcpd-dt_mod_cas(l)
            d_t_adv(l)=alpha*omega(l)/rcpd+dt_mod_cas(l)
-        else if ((tadv.eq.1.or.thadv.eq.1) .and. (forc_w.eq.1)) THEN
+        ELSE IF ((tadv.EQ.1.OR.thadv.EQ.1) .AND. (forc_w.EQ.1)) THEN
 !          d_t_adv(l)=alpha*omega(l)/rcpd-ht_mod_cas(l)-d_t_dyn_z(l)
            d_t_adv(l)=alpha*omega(l)/rcpd+ht_mod_cas(l)-d_t_dyn_z(l)
         endif
 
-!       if ((thadv.eq.1) .and. (forc_w.eq.0)) THEN
+!       if ((thadv.EQ.1) .AND. (forc_w.EQ.0)) THEN
 !          d_t_adv(l)=alpha*omega(l)/rcpd-dth_mod_cas(l)
 !          d_t_adv(l)=alpha*omega(l)/rcpd+dth_mod_cas(l)
-!       else if ((thadv.eq.1) .and. (forc_w.eq.1)) THEN
+!       ELSE IF ((thadv.EQ.1) .AND. (forc_w.EQ.1)) THEN
 !          d_t_adv(l)=alpha*omega(l)/rcpd-hth_mod_cas(l)-d_t_dyn_z(l)
 !          d_t_adv(l)=alpha*omega(l)/rcpd+hth_mod_cas(l)-d_t_dyn_z(l)
 !       endif
 
-        if ((qadv.eq.1) .and. (forc_w.eq.0)) THEN
+        IF ((qadv.EQ.1) .AND. (forc_w.EQ.0)) THEN
            d_q_adv(l,1)=dq_mod_cas(l)
 !          d_q_adv(l,1)=-1*dq_mod_cas(l)
-        else if ((qadv.eq.1) .and. (forc_w.eq.1)) THEN
+        ELSE IF ((qadv.EQ.1) .AND. (forc_w.EQ.1)) THEN
            d_q_adv(l,1)=hq_mod_cas(l)-d_q_dyn_z(l)
 !          d_q_adv(l,1)=-1*hq_mod_cas(l)-d_q_dyn_z(l)
         endif
          
-        if (trad.eq.1) THEN
+        IF (trad.EQ.1) THEN
            tend_rayo=1
            dt_cooling(l) = dtrad_mod_cas(l)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_read_forc_cases.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_read_forc_cases.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_read_forc_cases.h	(revision 5117)
@@ -11,7 +11,7 @@
       nq2=0
 
-      if (forcing_les .or. forcing_radconv                                      &
-     &    .or. forcing_GCSSold .or. forcing_fire) THEN
-      if (forcing_fire) THEN
+      IF (forcing_les .OR. forcing_radconv                                      &
+     &    .OR. forcing_GCSSold .OR. forcing_fire) THEN
+      IF (forcing_fire) THEN
 !----------------------------------------------------------------------
 !read fire forcings from fire.nc
@@ -51,9 +51,9 @@
         ! Above the max altutide of the input file
 
-        if (zlay(l)<height(kmax)) mxcalc=l
+        IF (zlay(l)<height(kmax)) mxcalc=l
 
         frac = (height(kmax)-zlay(l))/(height (kmax)-height(kmax-1))
         ttt =tttprof(kmax)-frac*(tttprof(kmax)-tttprof(kmax-1))
-       if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
+       IF ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
           temp(l) = ttt*(play(l)/pzero)**rkappa
           teta(l) = ttt
@@ -78,7 +78,7 @@
           frac = (height(k)-zlay(l))/(height(k)-height(k-1))
           IF(l==1) PRINT*,'k, height, tttprof',k,height(k),tttprof(k)
-          IF(zlay(l)>height(k-1).and.zlay(l)<height(k)) THEN
+          IF(zlay(l)>height(k-1).AND.zlay(l)<height(k)) THEN
             ttt =tttprof(k)-frac*(tttprof(k)-tttprof(k-1))
-       if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
+       IF ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
           temp(l) = ttt*(play(l)/pzero)**rkappa
           teta(l) = ttt
@@ -100,5 +100,5 @@
           elseif(zlay(l)<height(1)) then ! profils uniformes pour z<height(1)
             ttt =tttprof(1)
-       if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
+       IF ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
           temp(l) = ttt*(play(l)/pzero)**rkappa
           teta(l) = ttt
@@ -121,10 +121,10 @@
         temp(l)=max(min(temp(l),350.),150.)
         rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
-        if (l .lt. llm) THEN
+        IF (l .lt. llm) THEN
           zlay(l+1) = zlay(l) + (play(l)-play(l+1))/(rg*rho(l))
         endif
         omega2(l)=-rho(l)*omega(l)
         omega(l)= omega(l)*(-rg*rho(l)) !en Pa/s
-        if (l>1) THEN
+        IF (l>1) THEN
         IF(zlay(l-1)>height(kmax)) THEN
            omega(l)=0.0
@@ -136,10 +136,10 @@
       enddo
 
-      endif ! forcing_les .or. forcing_GCSSold .or. forcing_fire
+      endif ! forcing_les .OR. forcing_GCSSold .OR. forcing_fire
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 !---------------------------------------------------------------------
 ! Forcing for GCSSold:
 !---------------------------------------------------------------------
-      if (forcing_GCSSold) THEN
+      IF (forcing_GCSSold) THEN
        fich_gcssold_ctl = './forcing.ctl'
        fich_gcssold_dat = './forcing8.dat'
@@ -157,5 +157,5 @@
 ! Forcing for RICO:
 !---------------------------------------------------------------------
-      if (forcing_rico) THEN
+      IF (forcing_rico) THEN
 !       CALL writefield_phy('omega', omega,llm+1)
       fich_rico = 'rico.txt'
@@ -185,5 +185,5 @@
 !---------------------------------------------------------------------
 
-      if (forcing_toga) THEN
+      IF (forcing_toga) THEN
 ! read TOGA-COARE forcing (native vertical grid, nt_toga timesteps):
       fich_toga = './d_toga/ifa_toga_coare_v21_dime.txt'
@@ -236,5 +236,5 @@
 !---------------------------------------------------------------------
 
-      if (forcing_twpice) THEN
+      IF (forcing_twpice) THEN
 !read TWP-ICE forcings
      fich_twpice='d_twpi/twp180iopsndgvarana_v2.1_C3.c1.20060117.000000.cdf'
@@ -290,5 +290,5 @@
 !---------------------------------------------------------------------
 
-      if (forcing_amma) THEN
+      IF (forcing_amma) THEN
       CALL read_1D_cases
 
@@ -360,5 +360,5 @@
 !---------------------------------------------------------------------
 
-      if (forcing_dice) THEN
+      IF (forcing_dice) THEN
 !read DICE forcings
       fich_dice='dice_driver.nc'
@@ -475,5 +475,5 @@
 !!!! Si la temperature de surface n'est pas impos??e:
   
-      if (forcing_gabls4) THEN
+      IF (forcing_gabls4) THEN
 !read GABLS4 forcings
       
@@ -586,5 +586,5 @@
 !---------------------------------------------------------------------
 
-      if (forcing_armcu) THEN
+      IF (forcing_armcu) THEN
 ! read armcu forcing :
        WRITE(*,*) 'Avant lecture Forcing Arm_Cu'
@@ -685,5 +685,5 @@
 !---------------------------------------------------------------------
 
-      if (forcing_sandu) THEN
+      IF (forcing_sandu) THEN
        WRITE(*,*) 'Avant lecture Forcing SANDU'
 
@@ -759,5 +759,5 @@
 !---------------------------------------------------------------------
 
-      if (forcing_astex) THEN
+      IF (forcing_astex) THEN
        WRITE(*,*) 'Avant lecture Forcing Astex'
 
@@ -835,5 +835,5 @@
 !---------------------------------------------------------------------
 
-      if (forcing_case) THEN
+      IF (forcing_case) THEN
          WRITE(*,*) 'avant CALL read_1D_cas'
          CALL read_1D_cas
@@ -909,5 +909,5 @@
 !---------------------------------------------------------------------
 
-      if (forcing_case2) THEN
+      IF (forcing_case2) THEN
          WRITE(*,*) 'avant CALL read2_1D_cas'
          CALL read2_1D_cas
@@ -1007,5 +1007,5 @@
 !---------------------------------------------------------------------
 
-      if (forcing_SCM) THEN
+      IF (forcing_SCM) THEN
          WRITE(*,*) 'avant CALL old_read_SCM_cas'
          CALL old_read_SCM_cas
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/replay1d.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/replay1d.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/replay1d.F90	(revision 5117)
@@ -18,7 +18,7 @@
 REAL :: rlat_rad(1),rlon_rad(1)
 
-integer ntime
-integer jour0,mois0,an0,day_step,anneeref,dayref
-integer klev,klon
+INTEGER ntime
+INTEGER jour0,mois0,an0,day_step,anneeref,dayref
+INTEGER klev,klon
 CHARACTER (len=10) :: calend
 CHARACTER(len=20) :: calendrier
@@ -104,5 +104,5 @@
  
       CHARACTER(LEN=*) modname
-      integer ierr
+      INTEGER ierr
       CHARACTER(LEN=*) message
  
@@ -114,5 +114,5 @@
       CALL getin_dump
 
-      if (ierr == 0) THEN
+      IF (ierr == 0) THEN
         WRITE(*,*) 'Everything is cool'
       else
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecumev6_flux.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecumev6_flux.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecumev6_flux.F90	(revision 5117)
@@ -145,5 +145,5 @@
 REAL, DIMENSION(klon), INTENT(OUT)   :: PRI        ! Richardson number
 REAL, DIMENSION(klon), INTENT(OUT)   :: PRESA      ! aerodynamical resistance
-real, dimension(3), intent(out)   :: coeffs
+REAL, DIMENSION(3), INTENT(OUT)   :: coeffs
 
 !       0.2. Declarations of local variables
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ener_conserv.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ener_conserv.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ener_conserv.F90	(revision 5117)
@@ -50,5 +50,5 @@
 
 ! Local
-      integer k,i
+      INTEGER k,i
 REAL, DIMENSION(klon,klev+1) :: fluxu,fluxv,fluxt
 REAL, DIMENSION(klon,klev+1) :: dddu,dddv,dddt
@@ -148,5 +148,5 @@
          d_v_vdf(:,:)=d_v_vdf(:,:)+dv_gwd_hines(:,:)
       ENDIF
-      IF (.not. ok_hines .and. ok_gwd_rando) THEN
+      IF (.NOT. ok_hines .AND. ok_gwd_rando) THEN
          d_u_vdf(:,:)=d_u_vdf(:,:)+du_gwd_front(:,:)
          d_v_vdf(:,:)=d_v_vdf(:,:)+dv_gwd_front(:,:)
@@ -165,5 +165,5 @@
 !----------------------------------------------------------------------------
 
-   if (iflag_ener_conserv==2) THEN
+   IF (iflag_ener_conserv==2) THEN
       zu(:,:)=puo(:,:)
       zv(:,:)=pvo(:,:)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/fcg_gcssold.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/fcg_gcssold.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/fcg_gcssold.h	(revision 5117)
@@ -2,7 +2,7 @@
 ! $Id: fcg_gcssold.h 2010-08-10 17:02:56Z lahellec $
 
-      logical :: imp_fcg_gcssold,ts_fcg_gcssold,Tp_fcg_gcssold
-      logical :: Tp_ini_gcssold
-      logical :: xTurb_fcg_gcssold
+      LOGICAL :: imp_fcg_gcssold,ts_fcg_gcssold,Tp_fcg_gcssold
+      LOGICAL :: Tp_ini_gcssold
+      LOGICAL :: xTurb_fcg_gcssold
 
       common /fcg_gcssold/imp_fcg_gcssold,ts_fcg_gcssold,Tp_fcg_gcssold,        & 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/flott_gwd_rando_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/flott_gwd_rando_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/flott_gwd_rando_m.F90	(revision 5117)
@@ -18,6 +18,6 @@
 
     !ONLINE:
-    use dimphy, ONLY: klon, klev
-    use lmdz_assert, ONLY: assert
+    USE dimphy, ONLY: klon, klev
+    USE lmdz_assert, ONLY: assert
     USE lmdz_ioipsl_getin_p, ONLY: getin_p
     USE lmdz_vertical_layers, ONLY: presnivs
@@ -37,17 +37,17 @@
 
     ! 0.1 INPUTS
-    REAL, intent(in) :: DTIME ! Time step of the Physics
-    REAL, intent(in) :: pp(:, :) ! (KLON, KLEV) Pressure at full levels
-    REAL, intent(in) :: prec(:) ! (klon) Precipitation (kg/m^2/s)
-    REAL, intent(in) :: TT(:, :) ! (KLON, KLEV) Temp at full levels
-    REAL, intent(in) :: UU(:, :) ! (KLON, KLEV) Zonal wind at full levels
-    REAL, intent(in) :: VV(:, :) ! (KLON, KLEV) Merid wind at full levels
+    REAL, INTENT(IN) :: DTIME ! Time step of the Physics
+    REAL, INTENT(IN) :: pp(:, :) ! (KLON, KLEV) Pressure at full levels
+    REAL, INTENT(IN) :: prec(:) ! (klon) Precipitation (kg/m^2/s)
+    REAL, INTENT(IN) :: TT(:, :) ! (KLON, KLEV) Temp at full levels
+    REAL, INTENT(IN) :: UU(:, :) ! (KLON, KLEV) Zonal wind at full levels
+    REAL, INTENT(IN) :: VV(:, :) ! (KLON, KLEV) Merid wind at full levels
 
     ! 0.2 OUTPUTS
-    REAL, intent(out) :: zustr(:), zvstr(:) ! (KLON) Surface Stresses
-
-    REAL, intent(inout) :: d_u(:, :), d_v(:, :)
-    REAL, intent(inout) :: east_gwstress(:, :) !  Profile of eastward stress
-    REAL, intent(inout) :: west_gwstress(:, :) !  Profile of westward stress
+    REAL, INTENT(OUT) :: zustr(:), zvstr(:) ! (KLON) Surface Stresses
+
+    REAL, INTENT(INOUT) :: d_u(:, :), d_v(:, :)
+    REAL, INTENT(INOUT) :: east_gwstress(:, :) !  Profile of eastward stress
+    REAL, INTENT(INOUT) :: west_gwstress(:, :) !  Profile of westward stress
 
     ! (KLON, KLEV) tendencies on winds
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/flux_arp.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/flux_arp.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/flux_arp.h	(revision 5117)
@@ -3,8 +3,8 @@
 ! Modif EV, 10/2020
 
-      logical :: ok_flux_surf
-      logical :: ok_prescr_ust !for prescribed ustar
-      logical :: ok_prescr_beta
-      logical :: ok_forc_tsurf
+      LOGICAL :: ok_flux_surf
+      LOGICAL :: ok_prescr_ust !for prescribed ustar
+      LOGICAL :: ok_prescr_beta
+      LOGICAL :: ok_forc_tsurf
 
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/fonte_neige_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/fonte_neige_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/fonte_neige_mod.F90	(revision 5117)
@@ -617,5 +617,5 @@
 !    ! inputs
 !    INTEGER, INTENT(IN)                      :: knon
-!    real, INTENT(IN), DIMENSION(niso,klon)   :: xtrun_off_lic_0_diag
+!    REAL, INTENT(IN), DIMENSION(niso,klon)   :: xtrun_off_lic_0_diag
 
 !    xtrun_off_lic_0(:,:)=xtrun_off_lic_0_diag(:,:)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/freinage.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/freinage.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/freinage.F90	(revision 5117)
@@ -6,5 +6,5 @@
 
     !ONLINE:
-    use dimphy, ONLY: klon, klev
+    USE dimphy, ONLY: klon, klev
 !    USE control, ONLY: nvm
 !    USE indice_sol_mod, ONLY: nvm_orch
@@ -96,8 +96,8 @@
       sumveg(i,k)= sumveg(i,k)+ veget(i,jv)
 
-!      if  ( (height(i,jv) .gt. yzlay(i,k)) .AND. (height(i,jv) .gt. 0.1) .and. LAI(i,jv).gt.0. ) THEN
-      if  ( (height(i,jv) > yzlay(i,k)) .AND. (height(i,jv) > 0.1) ) THEN
+!      if  ( (height(i,jv) .gt. yzlay(i,k)) .AND. (height(i,jv) .gt. 0.1) .AND. LAI(i,jv).gt.0. ) THEN
+      IF  ( (height(i,jv) > yzlay(i,k)) .AND. (height(i,jv) > 0.1) ) THEN
 !FC attention veut on le test sur le LAI ?
-         if (ifl_pbltree==1) THEN
+         IF (ifl_pbltree==1) THEN
       drag_pro(i,k)= drag_pro(i,k)+ &
       veget(i,jv)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/global_mean.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/global_mean.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/global_mean.F90	(revision 5117)
@@ -8,17 +8,17 @@
   USE lmdz_phys_para, ONLY: is_sequential
   USE lmdz_phys_transfert_para, ONLY: reduce_sum
-  use lmdz_phys_mpi_data, ONLY: is_mpi_root
+  USE lmdz_phys_mpi_data, ONLY: is_mpi_root
   USE ioipsl
   IMPLICIT NONE
 
-  real,dimension(klon),intent(in) :: field
-  real,dimension(klon),intent(in) :: airephy
-  LOGICAL, intent(in) :: laire
-  REAL, intent(out) :: mfield
+  REAL,DIMENSION(klon),INTENT(IN) :: field
+  REAL,DIMENSION(klon),INTENT(IN) :: airephy
+  LOGICAL, INTENT(IN) :: laire
+  REAL, INTENT(OUT) :: mfield
   REAL :: airetot     ! Total area the earth
   REAL :: sumtmp
   INTEGER :: i
 
-  if (is_sequential) THEN
+  IF (is_sequential) THEN
    airetot = 0.
    sumtmp = 0.
@@ -27,5 +27,5 @@
     sumtmp = sumtmp + field(i)
    END DO
-   if (laire) THEN
+   IF (laire) THEN
     IF(airetot/=0.) THEN
      mfield=sumtmp/airetot
@@ -41,6 +41,6 @@
 
 !$OMP MASTER
-  if (is_mpi_root) THEN
-  if (laire) THEN
+  IF (is_mpi_root) THEN
+  IF (laire) THEN
 !  PRINT*,'gmean airetot=',airetot
    IF(airetot/=0.) THEN
@@ -51,12 +51,12 @@
   else
    mfield=sumtmp
-  endif
+  ENDIF
 
 ! PRINT*,'gmean sumtmp mfield=',sumtmp,mfield
 
-  endif !(is_mpi_root) THEN
+  ENDIF !(is_mpi_root) THEN
 !$OMP END MASTER
 
-  endif
+  ENDIF
 
   END SUBROUTINE  global_mean
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/grid_index.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/grid_index.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/grid_index.F90	(revision 5117)
@@ -8,10 +8,10 @@
 USE lmdz_geometry, ONLY: latitude_deg, longitude_deg
 IMPLICIT NONE
-real, intent(in) :: lon_deg,lat_deg
+REAL, INTENT(IN) :: lon_deg,lat_deg
 INTEGER :: grid_index
-integer i
+INTEGER i
 grid_index=0
 DO i=1,klon
-   if ( abs(lon_deg-longitude_deg(i)) < 0.02 .and.  abs(lat_deg-latitude_deg(i)) < 0.02 ) THEN
+   IF ( abs(lon_deg-longitude_deg(i)) < 0.02 .AND.  abs(lat_deg-latitude_deg(i)) < 0.02 ) THEN
         grid_index=i
         exit
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm2l.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm2l.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm2l.F90	(revision 5117)
@@ -313,7 +313,7 @@
       ! wm=u_star/Phim
       ! ;;;;;;;;;;;En dehors de la couche de surface
-      ! endif else if (z(ind) gt 20) then begin
+      ! END IF ELSE IF (z(ind) gt 20) then begin
       ! wm=(u_star^3+c1*w_star^3)^(1/3.)
-      ! endif
+      ! END IF
       ! ***************************************************
       wm(i) = ustar(i)*phiminv(i)
@@ -333,5 +333,5 @@
       ! theta_s(i,j)=thetav_10(i,j)+sqrt(dTetavs)
       ! q_s(i,j)=q_10(i,j)+sqrt(dqs)
-      ! endif else begin
+      ! END IF else begin
       ! Theta_s(i,j)=thetav_10(i,j)
       ! q_s(i,j)=q_10(i,j)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm_mod.F90	(revision 5117)
@@ -114,5 +114,5 @@
     ! AM      REAL ztvd, ztvu,
     REAL zdu2
-    REAL, intent(out):: therm(:) ! (klon) thermal virtual temperature excess
+    REAL, INTENT(OUT):: therm(:) ! (klon) thermal virtual temperature excess
     REAL trmb1(klon), trmb2(klon), trmb3(klon)
     ! Algorithme thermique
@@ -420,7 +420,7 @@
           ! wm=u_star/Phim
           ! ;;;;;;;;;;;En dehors de la couche de surface
-          ! endif else if (z(ind) gt 20) then begin
+          ! END IF ELSE IF (z(ind) gt 20) then begin
           ! wm=(u_star^3+c1*w_star^3)^(1/3.)
-          ! endif
+          ! END IF
           ! ***************************************************
           wm(i) = ustar(i)*phiminv(i)
@@ -442,5 +442,5 @@
           ! theta_s(i,j)=thetav_10(i,j)+sqrt(dTetavs)
           ! q_s(i,j)=q_10(i,j)+sqrt(dqs)
-          ! endif else begin
+          ! END IF else begin
           ! Theta_s(i,j)=thetav_10(i,j)
           ! q_s(i,j)=q_10(i,j)
@@ -642,5 +642,5 @@
              ! if (i.EQ.1864) THEN
              ! PRINT*,'i,pblh(1864),obklen(1864)',i,pblh(i),obklen(i)
-             ! endif
+             ! END IF
 
              zh(i) = zmzp/pblh(i)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/hgardfou.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/hgardfou.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/hgardfou.F90	(revision 5117)
@@ -13,5 +13,5 @@
   include "YOMCST.h"
   REAL t(klon, klev), tsol(klon, nbsrf)
-  CHARACTER(len=*), intent(in):: text
+  CHARACTER(len=*), INTENT(IN):: text
   CHARACTER (LEN=20) :: modname = 'hgardfou'
   INTEGER abortphy
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/histo_o500_pctau.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/histo_o500_pctau.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/histo_o500_pctau.F90	(revision 5117)
@@ -18,5 +18,5 @@
   REAL, DIMENSION (klon, kmaxm1, lmaxm1) :: histo
 
-  ! LOGICAL, dimension(klon,nbreg) :: pct_ocean
+  ! LOGICAL, DIMENSION(klon,nbreg) :: pct_ocean
   INTEGER, DIMENSION (klon, nbreg) :: pct_ocean
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/infotrac_phy.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/infotrac_phy.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/infotrac_phy.F90	(revision 5117)
@@ -3,6 +3,6 @@
 MODULE infotrac_phy
 
-  USE       strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strIdx
-  USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
+  USE       lmdz_strings, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strIdx
+  USE lmdz_readTracFiles, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
           delPhase, niso, getKey, isot_type, processIsotopes, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
           addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate, iqWIsoPha, nbIso, ntiso, isoName, isoCheck
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ini_COSP.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ini_COSP.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ini_COSP.F90	(revision 5117)
@@ -10,5 +10,5 @@
 !         sortie Cosp
 
-      use dimphy
+      USE dimphy
       include "ini_COSP.h"
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ini_csts.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ini_csts.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ini_csts.F90	(revision 5117)
@@ -22,5 +22,5 @@
 !!    EXTERNAL
 !!    --------
-!!      FMLOOK : to retrieve logical unit number associated to a file
+!!      FMLOOK : to retrieve LOGICAL unit number associated to a file
 !!
 !!    IMPLICIT ARGUMENTS
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ini_histREGDYN.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ini_histREGDYN.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ini_histREGDYN.h	(revision 5117)
@@ -4,5 +4,5 @@
       IF (ok_regdyn) THEN
       
-        if (is_sequential) THEN
+        IF (is_sequential) THEN
 c
 cIM      PRINT*, 'La frequence de sortie REGDYN est de ', ecrit_mth
@@ -122,5 +122,5 @@
          CALL histend(nid_regdyn)
 	 
-	 endif ! is_sequential
+	 END IF ! is_sequential
 
       endif ! ok_regdyn
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/iniradia.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/iniradia.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/iniradia.F90	(revision 5117)
@@ -24,5 +24,5 @@
   ! PRINT*,'Physiq: apres suphel '
 #if CPP_RRTM
-  if (iflag_rrtm == 1) THEN
+  IF (iflag_rrtm == 1) THEN
      CALL suinit(klon, klev)
      PRINT *, 'iniradia: apres suinit '
@@ -32,5 +32,5 @@
      CALL surayolmd          ! initialiser le rayonnement RRTM
      PRINT *, 'iniradia: apres surayolmd '
-  endif
+  ENDIF
 #endif
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/init_be.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/init_be.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/init_be.F90	(revision 5117)
@@ -125,5 +125,5 @@
 !!!  Cas 19 niveaux verticaux
 !!!===========================
-!!  IF (klev.eq.19) THEN
+!!  IF (klev.EQ.19) THEN
 !!     DO k = 1,klev
 !!        DO i = 1,klon
@@ -140,139 +140,139 @@
 !!           IF ( kref .EQ. 1 ) THEN
 !!              IF (latgeo.GE.50.0) srcbe(i,k)=0.1
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.09
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.07
+!!              IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=0.09
+!!              IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=0.07
 !!           END IF
 !!           IF ( kref .EQ. 2 ) THEN
 !!              IF (latgeo.GE.50.0) srcbe(i,k)=0.12
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.1
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.09
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.07
+!!              IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=0.1
+!!              IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=0.09
+!!              IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=0.07
 !!           END IF
 !!           IF ( kref .EQ. 3 ) THEN
 !!              IF (latgeo.GE.50.0) srcbe(i,k)=0.14
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.12
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.1
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.09
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.07
+!!              IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=0.12
+!!              IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=0.1
+!!              IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=0.09
+!!              IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=0.07
 !!           END IF
 !!           IF ( kref .EQ. 4 ) THEN
 !!              IF (latgeo.GE.50.0) srcbe(i,k)=0.175
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.16
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.14
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.12
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.1
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.09
+!!              IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=0.16
+!!              IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=0.14
+!!              IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=0.12
+!!              IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=0.1
+!!              IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=0.09
 !!           END IF
 !!           IF ( kref .EQ. 5 ) THEN
 !!              IF (latgeo.GE.50.0) srcbe(i,k)=0.28
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.26
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.23
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.175
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.14
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.12
+!!              IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=0.26
+!!              IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=0.23
+!!              IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=0.175
+!!              IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=0.14
+!!              IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=0.12
 !!           END IF
 !!           IF ( kref .EQ. 6 ) THEN
 !!              IF (latgeo.GE.50.0) srcbe(i,k)=0.56
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.49
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.42
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.28
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.26
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.245
+!!              IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=0.49
+!!              IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=0.42
+!!              IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=0.28
+!!              IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=0.26
+!!              IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=0.245
 !!           END IF
 !!           IF ( kref .EQ. 7 ) THEN
 !!              IF (latgeo.GE.50.0) srcbe(i,k)=1.05
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.875
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.7
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.52
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.44
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.385
+!!              IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=0.875
+!!              IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=0.7
+!!              IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=0.52
+!!              IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=0.44
+!!              IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=0.385
 !!           END IF
 !!           IF ( kref .EQ. 8 ) THEN
 !!              IF (latgeo.GE.50.0) srcbe(i,k)=2.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=1.8
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=1.5
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=1.
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.8
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.75
+!!              IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=1.8
+!!              IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=1.5
+!!              IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=1.
+!!              IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=0.8
+!!              IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=0.75
 !!           END IF
 !!           IF ( kref .EQ. 9 ) THEN
 !!              IF (latgeo.GE.50.0) srcbe(i,k)=4.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=3.5
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=3.
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=2.5
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=1.8
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=1.4
+!!              IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=3.5
+!!              IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=3.
+!!              IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=2.5
+!!              IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=1.8
+!!              IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=1.4
 !!           END IF
 !!           IF ( kref .EQ. 10 ) THEN
 !!              IF (latgeo.GE.50.0) srcbe(i,k)=8.5
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=8.
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=7.
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=4.5
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=3.5
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=3.
+!!              IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=8.
+!!              IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=7.
+!!              IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=4.5
+!!              IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=3.5
+!!              IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=3.
 !!           END IF
 !!           IF ( kref .EQ. 11 ) THEN
 !!              IF (latgeo.GE.50.0) srcbe(i,k)=17.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=15.
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=11.
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=8.
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=5.
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=4.
+!!              IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=15.
+!!              IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=11.
+!!              IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=8.
+!!              IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=5.
+!!              IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=4.
 !!           END IF
 !!           IF ( kref .EQ. 12 ) THEN
 !!              IF (latgeo.GE.50.0) srcbe(i,k)=25.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=22.
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=17.
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=11.
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=7.5
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7.
+!!              IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=22.
+!!              IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=17.
+!!              IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=11.
+!!              IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=7.5
+!!              IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=7.
 !!           END IF
 !!           IF ( kref .EQ. 13 ) THEN
 !!              IF (latgeo.GE.60.0) srcbe(i,k)=33.
-!!              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=32.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=30.
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=22.
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=15.
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=11.
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=8.
+!!              IF (latgeo.GE.50.0 .AND. latgeo.LT.60.0) srcbe(i,k)=32.
+!!              IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=30.
+!!              IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=22.
+!!              IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=15.
+!!              IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=11.
+!!              IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=8.
 !!           END IF
 !!           IF ( kref .EQ. 14 ) THEN
 !!              IF (latgeo.GE.60.0) srcbe(i,k)=48.
-!!              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=45.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=36.
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=26.
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=17.5
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=12.5
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=10.
+!!              IF (latgeo.GE.50.0 .AND. latgeo.LT.60.0) srcbe(i,k)=45.
+!!              IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=36.
+!!              IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=26.
+!!              IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=17.5
+!!              IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=12.5
+!!              IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=10.
 !!           END IF
 !!           IF ( kref .EQ. 15 ) THEN
 !!              IF (latgeo.GE.70.0) srcbe(i,k)=58.
-!!              IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=57.
-!!              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=50.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=38.
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=25.
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=15.
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=12.5
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=10.
+!!              IF (latgeo.GE.60.0 .AND. latgeo.LT.70.0) srcbe(i,k)=57.
+!!              IF (latgeo.GE.50.0 .AND. latgeo.LT.60.0) srcbe(i,k)=50.
+!!              IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=38.
+!!              IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=25.
+!!              IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=15.
+!!              IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=12.5
+!!              IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=10.
 !!           END IF
 !!           IF ( kref .EQ. 16 ) THEN
 !!              IF (latgeo.GE.70.0) srcbe(i,k)=70.
-!!              IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=65.
-!!              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=50.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=32.
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=20.
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=13.
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=9.
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7.5
+!!              IF (latgeo.GE.60.0 .AND. latgeo.LT.70.0) srcbe(i,k)=65.
+!!              IF (latgeo.GE.50.0 .AND. latgeo.LT.60.0) srcbe(i,k)=50.
+!!              IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=32.
+!!              IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=20.
+!!              IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=13.
+!!              IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=9.
+!!              IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=7.5
 !!           END IF
 !!           IF ( kref .GE. 17 ) THEN
 !!              IF (latgeo.GE.70.0) srcbe(i,k)=80.
-!!              IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=70.
-!!              IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=45.
-!!              IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=27.
-!!              IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=17.5
-!!              IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=12.
-!!              IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=8.
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7.
+!!              IF (latgeo.GE.60.0 .AND. latgeo.LT.70.0) srcbe(i,k)=70.
+!!              IF (latgeo.GE.50.0 .AND. latgeo.LT.60.0) srcbe(i,k)=45.
+!!              IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=27.
+!!              IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=17.5
+!!              IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=12.
+!!              IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=8.
+!!              IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=7.
 !!           END IF
 !!        END DO
@@ -298,245 +298,245 @@
            IF ( kref == 5 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=0.1
-              IF (latgeo>=20.0 .and. latgeo<50.0) srcbe(i,k)=0.09
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=0.07
+              IF (latgeo>=20.0 .AND. latgeo<50.0) srcbe(i,k)=0.09
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.07
            END IF
            IF ( kref == 6 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=0.14
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=0.12
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=0.1
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=0.09
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=0.07
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=0.12
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.1
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.09
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.07
            END IF
            IF ( kref == 7 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=0.16
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=0.16
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=0.14
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=0.12
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=0.1
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=0.09
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=0.16
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.14
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.12
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.1
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.09
            END IF
            IF ( kref == 8 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=0.175
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=0.16
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=0.14
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=0.12
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=0.1
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=0.1
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=0.16
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.14
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.12
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.1
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.1
            END IF
            IF ( kref == 9 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=0.245
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=0.21
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=0.175
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=0.14
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=0.12
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=0.12
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=0.21
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.175
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.14
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.12
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.12
            END IF
            IF ( kref == 10 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=0.31
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=0.28
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=0.245
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=0.21
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=0.16
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=0.14
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=0.28
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.245
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.21
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.16
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.14
            END IF
            IF ( kref == 11 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=0.35
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=0.3
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=0.3
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=0.2
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=0.18
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=0.16
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=0.3
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.3
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.2
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.18
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.16
            END IF
            IF ( kref == 12 ) THEN
               IF (latgeo>=40.0) srcbe(i,k)=0.5
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=0.4
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=0.35
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=0.3
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=0.25
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.4
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.35
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.3
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.25
            END IF
            IF ( kref == 13 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=0.8
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=0.7
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=0.6
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=0.5
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=0.4
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=0.35
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=0.7
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.6
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.5
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.4
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.35
            END IF
            IF ( kref == 14 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=1.2
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=1.
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=0.75
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=0.6
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=0.5
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=0.4
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=1.
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.75
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.6
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.5
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.4
            END IF
            IF ( kref == 15 ) THEN
               IF (latgeo>=60.0) srcbe(i,k)=1.75
-              IF (latgeo>=50.0 .and. latgeo<60.0) srcbe(i,k)=1.8
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=1.6
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=1.4
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=0.9
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=0.75
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=0.65
+              IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=1.8
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=1.6
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=1.4
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.9
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.75
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.65
            END IF
            IF ( kref == 16 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=3.
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=2.5
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=1.8
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=1.5
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=1.2
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=0.9
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=2.5
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=1.8
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=1.5
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=1.2
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.9
            END IF
            IF ( kref == 17 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=4.
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=3.
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=2.5
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=2.
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=1.6
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=1.4
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=3.
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=2.5
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=2.
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=1.6
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=1.4
            END IF
            IF ( kref == 18 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=7.
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=6.
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=4.5
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=3.5
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=3.
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=2.
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=6.
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=4.5
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=3.5
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=3.
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=2.
            END IF
            IF ( kref == 19 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=8.5
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=8.
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=7.
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=4.
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=3.5
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=3.
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=8.
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=7.
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=4.
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=3.5
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=3.
            END IF
            IF ( kref == 20 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=12.5
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=12.
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=8.
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=6.
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=4.
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=3.5
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=12.
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=8.
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=6.
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=4.
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=3.5
            END IF
            IF ( kref == 21 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=16.
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=13.
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=10.
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=7.5
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=4.5
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=4.
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=13.
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=10.
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=7.5
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=4.5
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=4.
            END IF
            IF ( kref == 22 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=20.
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=17.5
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=12.5
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=9.
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=6.
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=4.5
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=17.5
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=12.5
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=9.
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=6.
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=4.5
            END IF
            IF ( kref == 23 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=25.
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=22.
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=15.
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=10.
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=7.5
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=6.
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=22.
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=15.
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=10.
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=7.5
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=6.
            END IF
            IF ( kref == 24 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=28.
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=26.
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=18.
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=12.
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=8.5
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=7.
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=26.
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=18.
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=12.
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=8.5
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=7.
            END IF
            IF ( kref == 25 ) THEN
               IF (latgeo>=50.0) srcbe(i,k)=33.
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=28.
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=20.
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=14.
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=10.
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=8.5
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=28.
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=20.
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=14.
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=10.
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=8.5
            END IF
            IF ( kref == 26 ) THEN
               IF (latgeo>=60.0) srcbe(i,k)=38.
-              IF (latgeo>=50.0 .and. latgeo<60.0) srcbe(i,k)=36.
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=32.
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=24.
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=15.
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=11.5
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=10.
+              IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=36.
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=32.
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=24.
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=15.
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=11.5
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=10.
 !!jyg
-!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=6.
+!!              IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=6.
 !!jyg end
            END IF
            IF ( kref == 27 ) THEN
               IF (latgeo>=60.0) srcbe(i,k)=46.
-              IF (latgeo>=50.0 .and. latgeo<60.0) srcbe(i,k)=44.
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=35.
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=25.
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=16.
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=12.5
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=10.
+              IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=44.
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=35.
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=25.
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=16.
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=12.5
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=10.
            END IF
            IF ( kref == 28 ) THEN
               IF (latgeo>=60.0) srcbe(i,k)=53.
-              IF (latgeo>=50.0 .and. latgeo<60.0) srcbe(i,k)=48.
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=37.
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=25.
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=16.
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=12.5
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=10.
+              IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=48.
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=37.
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=25.
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=16.
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=12.5
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=10.
            END IF
            IF ( kref == 29 ) THEN
               IF (latgeo>=70.0) srcbe(i,k)=58.
-              IF (latgeo>=60.0 .and. latgeo<70.0) srcbe(i,k)=56.
-              IF (latgeo>=50.0 .and. latgeo<60.0) srcbe(i,k)=50.
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=36.
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=24.
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=15.
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=11.5
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=10.
+              IF (latgeo>=60.0 .AND. latgeo<70.0) srcbe(i,k)=56.
+              IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=50.
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=36.
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=24.
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=15.
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=11.5
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=10.
            END IF
            IF ( kref == 30 ) THEN
               IF (latgeo>=70.0) srcbe(i,k)=65.
-              IF (latgeo>=60.0 .and. latgeo<70.0) srcbe(i,k)=60.
-              IF (latgeo>=50.0 .and. latgeo<60.0) srcbe(i,k)=50.
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=35.
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=22.
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=14.
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=10.
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=9.
+              IF (latgeo>=60.0 .AND. latgeo<70.0) srcbe(i,k)=60.
+              IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=50.
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=35.
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=22.
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=14.
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=10.
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=9.
            END IF
            IF ( kref == 31 ) THEN
               IF (latgeo>=70.0) srcbe(i,k)=70.
-              IF (latgeo>=60.0 .and. latgeo<70.0) srcbe(i,k)=62.
-              IF (latgeo>=50.0 .and. latgeo<60.0) srcbe(i,k)=48.
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=32.
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=21.
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=13.
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=9.
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=7.6
+              IF (latgeo>=60.0 .AND. latgeo<70.0) srcbe(i,k)=62.
+              IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=48.
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=32.
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=21.
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=13.
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=9.
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=7.6
            END IF
            IF ( kref == 32 ) THEN
               IF (latgeo>=70.0) srcbe(i,k)=80.
-              IF (latgeo>=60.0 .and. latgeo<70.0) srcbe(i,k)=60.
-              IF (latgeo>=50.0 .and. latgeo<60.0) srcbe(i,k)=46.
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=30.
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=17.5
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=11.
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=8.
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=7.4
+              IF (latgeo>=60.0 .AND. latgeo<70.0) srcbe(i,k)=60.
+              IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=46.
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=30.
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=17.5
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=11.
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=8.
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=7.4
            END IF
            IF ( kref >= 33 ) THEN
               IF (latgeo>=70.0) srcbe(i,k)=80.
-              IF (latgeo>=60.0 .and. latgeo<70.0) srcbe(i,k)=70.
-              IF (latgeo>=50.0 .and. latgeo<60.0) srcbe(i,k)=45.
-              IF (latgeo>=40.0 .and. latgeo<50.0) srcbe(i,k)=27.
-              IF (latgeo>=30.0 .and. latgeo<40.0) srcbe(i,k)=15.
-              IF (latgeo>=20.0 .and. latgeo<30.0) srcbe(i,k)=10.
-              IF (latgeo>=10.0 .and. latgeo<20.0) srcbe(i,k)=7.6
-              IF (latgeo>=0.0 .and. latgeo<10.0) srcbe(i,k)=7.
+              IF (latgeo>=60.0 .AND. latgeo<70.0) srcbe(i,k)=70.
+              IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=45.
+              IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=27.
+              IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=15.
+              IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=10.
+              IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=7.6
+              IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=7.
            END IF
         END DO
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/inlandsis.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/inlandsis.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/inlandsis.f90	(revision 5117)
@@ -183,7 +183,7 @@
   IMPLICIT NONE
 
-  logical :: SnoMod
-  logical :: BloMod
-  logical :: debut
+  LOGICAL :: SnoMod
+  LOGICAL :: BloMod
+  LOGICAL :: debut
   INTEGER :: jjtime
 
@@ -409,8 +409,8 @@
     IF (BloMod) THEN
 
-    if (klonv==1) THEN
-      IF(isnoSV(1)>=2                   .and. &
-            TsisSV(1,max(1,isnoSV(1)))<273.  .and. &
-            ro__SV(1,max(1,isnoSV(1)))<500.  .and. &
+    IF (klonv==1) THEN
+      IF(isnoSV(1)>=2                   .AND. &
+            TsisSV(1,max(1,isnoSV(1)))<273.  .AND. &
+            ro__SV(1,max(1,isnoSV(1)))<500.  .AND. &
             eta_SV(1,max(1,isnoSV(1)))<epsi) THEN
   ! +                       **********
@@ -518,5 +518,5 @@
   ! +     Gallee et al., 2001    eq 5, p5
 
-      if (usth_param == "gal") THEN
+      IF (usth_param == "gal") THEN
         Salt_us   =   (log(2.868) - log(1 + SaltMo)) * rCd10n/0.085
         Salt_us   = Salt_us * Fac_Mo
@@ -525,5 +525,5 @@
       endif
 
-      if (usth_param == "lis") then !Liston et al. 2007
+      IF (usth_param == "lis") then !Liston et al. 2007
         IF(ro__SV(ikl,isn)>300.) THEN
           Salt_us   = 0.005*exp(0.013*ro__SV(ikl,isn))
@@ -607,10 +607,10 @@
     hSalSV(ikl) = 8.436e-2  * us__SV(ikl)**SblPom
 
-    if (qsalt_param == "pom") THEN
+    IF (qsalt_param == "pom") THEN
       qSalSV(ikl) = (us__SV(ikl)**2 - usthSV(ikl)**2) *signus &
             / (hSalSV(ikl) * gravit * us__SV(ikl) * 3.25)
     endif
 
-    if (qsalt_param == "bin") THEN
+    IF (qsalt_param == "bin") THEN
       qSalSV(ikl) = (us__SV(ikl) * us__SV(ikl) &
             -usthSV(ikl) * usthSV(ikl))*signus &
@@ -662,5 +662,5 @@
   ! #BS       density_kotlyakov = .FALSE.  !C.Amory BS 2018
   ! + ...     Fallen Snow Density, Adapted for Antarctica
-        if (is_ok_density_kotlyakov) THEN
+        IF (is_ok_density_kotlyakov) THEN
             tt_tmp = TaT_SV(ikl)-TfSnow
             !vv_tmp = VV10SV(ikl)
@@ -668,5 +668,5 @@
   ! + ...         [ A compromise between
   ! + ...           Kotlyakov (1961) and Lenaerts (2012, JGR, Part1) ]
-            if (tt_tmp>=-10) THEN
+            IF (tt_tmp>=-10) THEN
               BufPro   =  max( rosMin, &
                     104. *sqrt( max( vv_tmp-6.0,0.0))) ! Kotlyakov (1961)
@@ -696,5 +696,5 @@
   !    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
-     if (BloMod) THEN
+     IF (BloMod) THEN
      Bros_N      = frsno
      ro_new      = ro__SV(ikl,max(1,isnoSV(ikl)))
@@ -894,6 +894,6 @@
 
 
-  if (discret_xf.AND.klonv==1) THEN
-   IF(isnoSV(1)>=1.or.NLaysv(1)>=1) THEN
+  IF (discret_xf.AND.klonv==1) THEN
+   IF(isnoSV(1)>=1.OR.NLaysv(1)>=1) THEN
   ! +          **********
      CALL SISVAT_zSn
@@ -904,5 +904,5 @@
     CALL SISVAT_zSn
   ! +          **********
-  endif
+  ENDIF
 
   ! +          **********
@@ -1080,5 +1080,5 @@
 
 
-  if (iflag_temp_inlandsis == 0) THEN
+  IF (iflag_temp_inlandsis == 0) THEN
    CALL SISVAT_TSo
 
@@ -1203,8 +1203,8 @@
   ! Etienne: extrapolation from the two uppermost levels:
 
-     if (isnoSV(ikl) >=2) THEN
+     IF (isnoSV(ikl) >=2) THEN
        zm1=-dzsnSV(ikl,isnoSV(ikl))/2.
        zm2=-(dzsnSV(ikl,isnoSV(ikl)) + dzsnSV(ikl,isnoSV(ikl)-1)/2.)
-     else if (isnoSV(ikl) == 1) THEN
+     ELSE IF (isnoSV(ikl) == 1) THEN
        zm1=-dzsnSV(ikl,isnoSV(ikl))/2.
        zm2=-(dzsnSV(ikl,isnoSV(ikl))+dz_dSV(0)/2.)
@@ -1234,15 +1234,15 @@
   IF (SnoMod)                                                 THEN
 
-  if (discret_xf .AND. klonv==1) THEN
+  IF (discret_xf .AND. klonv==1) THEN
   IF(isnoSV(1)>=1) THEN
   ! +          **********
   CALL SISVAT_GSn
   ! +          **********
-  endif
+  ENDIF
   else
   ! +          **********
     CALL SISVAT_GSn
   ! +          **********
-  endif
+  ENDIF
 
 
@@ -1334,9 +1334,9 @@
       coefd = log(z03)-coefc*ta3
 
-      if (TaT_SV(ikl) < ta1) THEN
+      IF (TaT_SV(ikl) < ta1) THEN
         Z0_obs = z01
-      else if (TaT_SV(ikl)>=ta1 .and. TaT_SV(ikl)<ta2) THEN
+      ELSE IF (TaT_SV(ikl)>=ta1 .AND. TaT_SV(ikl)<ta2) THEN
         Z0_obs = exp(coefa*TaT_SV(ikl) + coefb)
-      else if (TaT_SV(ikl)>=ta2 .and. TaT_SV(ikl)<ta3) THEN
+      ELSE IF (TaT_SV(ikl)>=ta2 .AND. TaT_SV(ikl)<ta3) THEN
         ! if st > 0, melting induce smooth surface
         Z0_obs = exp(coefc*TaT_SV(ikl) + coefd)
@@ -1471,5 +1471,5 @@
 
      IF(ro__SV(ikl,isnoSV(ikl))>50 &
-           .and.ro__SV(ikl,isnoSV(ikl))<roSdSV)THEN
+           .AND.ro__SV(ikl,isnoSV(ikl))<roSdSV)THEN
          Z0hnSV(ikl) = max(zero &
                , sign(unun,zzsnsv(ikl,isnoSV(ikl))-epsi)) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_bsn.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_bsn.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_bsn.f90	(revision 5117)
@@ -20,9 +20,9 @@
   ! +  =================
 
-  use VARphy
-  use VAR_SV
-  use VARdSV
-  use VARxSV
-  use VARySV
+  USE VARphy
+  USE VAR_SV
+  USE VARdSV
+  USE VARxSV
+  USE VARySV
 
 
@@ -71,6 +71,6 @@
 
     ! Densification of the uppermost snow layer if erosion:
-    if((dzweqo-dzweqn)>0                    .and. &
-          dzsnSV(ikl,isn)>0                    .and. &
+    IF((dzweqo-dzweqn)>0                    .AND. &
+          dzsnSV(ikl,isn)>0                    .AND. &
           ro__SV(ikl,max(1,isnoSV(ikl)))<roBdSV) THEN
     !characteristic time scale for drifting snow compaction set to 24h
@@ -83,5 +83,5 @@
     Fac         = max(0.,min(1.,Fac))
 
-    if (ro__SV(ikl,max(1,isnoSV(ikl)))>roBdSV) THEN
+    IF (ro__SV(ikl,max(1,isnoSV(ikl)))>roBdSV) THEN
       densif=densif*Fac
     endif
@@ -93,5 +93,5 @@
     endif
 
-    IF(dzsnSV(ikl,isn)>0 .and.dzsnSV(ikl,isn)<0.0001)THEN
+    IF(dzsnSV(ikl,isn)>0 .AND.dzsnSV(ikl,isn)<0.0001)THEN
     dbs_SV(ikl) = dbs_SV(ikl)+ dzsnSV(ikl,isn)*ro__SV(ikl,isn)
     dbs_Er(ikl) = dbs_Er(ikl)+ dzsnSV(ikl,isn)*ro__SV(ikl,isn)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_gsn.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_gsn.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_gsn.f90	(revision 5117)
@@ -165,10 +165,10 @@
   ! +  ================
 
-  use VARphy
-  use VAR_SV
-  use VARdSV
-  use VAR0SV
-  use VARxSV
-  use VARtSV
+  USE VARphy
+  USE VAR_SV
+  USE VARdSV
+  USE VAR0SV
+  USE VARxSV
+  USE VARtSV
 
 
@@ -190,5 +190,5 @@
   ! +  ================
 
-  logical :: vector                        !
+  LOGICAL :: vector                        !
   INTEGER :: ikl                           !
   INTEGER :: isn   ,isnp                   !
@@ -806,7 +806,7 @@
     DO isn=iiceSV(ikl),isnoSV(ikl)
       IF  (G1snSV(ikl,isn)>=0.)                               THEN
-        IF(G1snSV(ikl,isn)<vsphe4.and.istoSV(ikl,isn)==0)  THEN
+        IF(G1snSV(ikl,isn)<vsphe4.AND.istoSV(ikl,isn)==0)  THEN
                istoSV(ikl,isn)=istdSV(1)
-        ELSEIF(G1_dSV-G1snSV(ikl,isn)         <vsphe4.and. &
+        ELSEIF(G1_dSV-G1snSV(ikl,isn)         <vsphe4.AND. &
               etaSno(ikl,isn)/dzsnSV(ikl,isn)>vtelv1)       THEN
           IF  (istoSV(ikl,isn)==0) &
@@ -858,5 +858,5 @@
             *(1-min(1   , abs(istoSV(ikl,isn)-istdSV(1))))
   ! #wp     IF (G1snSV(ikl,isn).gt.0..AND.G1snSV(ikl,isn).lt.vsphe4
-  ! #wp.                             .AND.istoSV(ikl,isn).eq.     0)
+  ! #wp.                             .AND.istoSV(ikl,isn).EQ.     0)
   ! #wp.    THEN
   ! #wp       WRITE(6,*) ikl,isn,' G1,G2,hist,OK_Ang  ',
@@ -907,5 +907,5 @@
 
     isn=1
-    if (dzsnSV(ikl,isn)>0.and.ro__SV(ikl,isn)>0) THEN
+    IF (dzsnSV(ikl,isn)>0.AND.ro__SV(ikl,isn)>0) THEN
     dzsnSV(ikl,isn) = dzsnSV(ikl,isn) +0.9999*(smb_old-smb_new) &
           / ro__SV(ikl,isn)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_qsn.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_qsn.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_qsn.f90	(revision 5117)
@@ -55,11 +55,11 @@
   ! +  ================
 
-  use VARphy
-  use VAR_SV
-  use VARdSV
-  use VAR0SV
-  use VARxSV
-  use VARySV
-  use surface_data, ONLY: is_ok_slush,opt_runoff_ac
+  USE VARphy
+  USE VAR_SV
+  USE VARdSV
+  USE VAR0SV
+  USE VARxSV
+  USE VARySV
+  USE surface_data, ONLY: is_ok_slush,opt_runoff_ac
 
 
@@ -358,5 +358,5 @@
 
   !XF
-      IF(ro__SV(ikl,isn) >= roCdSV.and.ro__SV(ikl,1)<900) &
+      IF(ro__SV(ikl,isn) >= roCdSV.AND.ro__SV(ikl,1)<900) &
             PClose = min(0.50,PClose * &
             (1.-(ro_ice-ro__SV(ikl,isn))/(ro_ice-roCdSV)))
@@ -369,6 +369,6 @@
       endif
 
-      IF(drr_SV(ikl)    >0  .and.TsisSV(ikl,isn)>273.14) THEN
-       if((ro__SV(ikl,isn)>900.and.ro__SV(ikl,isn)<920).or. &
+      IF(drr_SV(ikl)    >0  .AND.TsisSV(ikl,isn)>273.14) THEN
+       IF((ro__SV(ikl,isn)>900.AND.ro__SV(ikl,isn)<920).OR. &
              ro__SV(ikl,isn)>950) THEN
          dzsnSV(ikl,isn) = dzsnSV(ikl,isn)*ro__SV(ikl,isn)/ro_ice
@@ -378,14 +378,14 @@
       endif
 
-      ! if (isn>1.and.isn<nsno     .and.
-  !    .      ro__SV(ikl,isn-1)>900    .and.
-  !    .      ro__SV(ikl,isn)  >roCdSV .and.
-  !    .      ro__SV(ikl,isn)  <900    .and.
-  !    .      TsisSV(ikl,isn)  >273.14 .and.
-  !    .      TsisSV(ikl,isn+1)<273.15 .and.
+      ! if (isn>1.AND.isn<nsno     .AND.
+  !    .      ro__SV(ikl,isn-1)>900    .AND.
+  !    .      ro__SV(ikl,isn)  >roCdSV .AND.
+  !    .      ro__SV(ikl,isn)  <900    .AND.
+  !    .      TsisSV(ikl,isn)  >273.14 .AND.
+  !    .      TsisSV(ikl,isn+1)<273.15 .AND.
   !    .      drr_SV(ikl)      >0)     THEN
       !  TsisSV(ikl,isn)=273.14
       !  PClose = 1
-      ! endif
+      ! END IF
 
   !XF
@@ -526,6 +526,6 @@
 
      IF(zt<0.005+(TaT_SV(ikl)-TfSnow)/1000..and. &
-           isnoSV(ikl)             >0         .and. &
-           TaT_SV(ikl)             >=TfSnow   .and. &
+           isnoSV(ikl)             >0         .AND. &
+           TaT_SV(ikl)             >=TfSnow   .AND. &
            istoSV(ikl,isnoSV(ikl)) >1       ) THEN
       DO isn=1,isnoSV(ikl)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_qso.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_qso.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_qso.f90	(revision 5117)
@@ -85,10 +85,10 @@
   ! +  ================
 
-  use VARphy
-  use VAR_SV
-  use VARdSV
-  use VAR0SV
-  use VARxSV
-  use VARySV
+  USE VARphy
+  USE VAR_SV
+  USE VARdSV
+  USE VAR0SV
+  USE VARxSV
+  USE VARySV
 
 
@@ -377,5 +377,5 @@
       ikp      = nkhy *  eta_SV(ikl,isl+1) / etadSV(ist)
 
-      IF(ikm<0.or.ik0<0.or.ikp<0)THEN
+      IF(ikm<0.OR.ik0<0.OR.ikp<0)THEN
        print *,"CRASH1 in sisvat_qso.f on pixel (i,j,n)", &
              ii__SV(ikl),jj__SV(ikl),nn__SV(ikl)
@@ -423,5 +423,5 @@
       ikp      = nkhy *  eta_SV(ikl,isl+1) / etadSV(ist)
 
-      IF(ik0<0.or.ikp<0)THEN
+      IF(ik0<0.OR.ikp<0)THEN
        print *,"CRASH2 in sisvat_qso.f on pixel (i,j,n)", &
              ii__SV(ikl),jj__SV(ikl),nn__SV(ikl)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_sno_albedo.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_sno_albedo.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_sno_albedo.f90	(revision 5117)
@@ -61,10 +61,10 @@
 
 
-  use VARphy
-  use VAR_SV
-  use VARdSV
-  use VARxSV
-  use VARySV
-  use VARtSV
+  USE VARphy
+  USE VAR_SV
+  USE VARdSV
+  USE VARxSV
+  USE VARySV
+  USE VARtSV
   USE surface_data, ONLY: iflag_albcalc,correc_alb
 
@@ -464,6 +464,6 @@
     ! prescription for each time step with NEMO values
 
-  ! #AO      if (LSmask(ikl) .eq. 0 .and. coupling_ao .eq. .TRUE.) THEN
-  ! #AO       if (AOmask(ikl) .eq. 0) THEN
+  ! #AO      if (LSmask(ikl) .EQ. 0 .AND. coupling_ao .EQ. .TRUE.) THEN
+  ! #AO       if (AOmask(ikl) .EQ. 0) THEN
   ! #AO       albisv(ikl) =  (1.-AOmask(ikl))* albAOsisv(ikl)
   ! #AO.                    +(AOmask(ikl)*albisv(ikl))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_tso.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_tso.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_tso.f90	(revision 5117)
@@ -71,11 +71,11 @@
   ! +  ================
 
-  use VARphy
-  use VAR_SV
-  use VARdSV
-  use VARxSV
-  use VARySV
-  use VARtSV
-  use VAR0SV
+  USE VARphy
+  USE VAR_SV
+  USE VARdSV
+  USE VARxSV
+  USE VARySV
+  USE VARtSV
+  USE VAR0SV
 
 
@@ -615,5 +615,5 @@
       TsisSV(ikl,isl)   = Aux__Q(ikl,isl)  *TsisSV(ikl,isl+1) &
             +TsisSV(ikl,isl)
-      IF(isl==0.and.isnoSV(ikl)==0) THEN
+      IF(isl==0.AND.isnoSV(ikl)==0) THEN
        TsisSV(ikl,isl)  = min(TaT_SV(ikl)+30,TsisSV(ikl,isl))
        TsisSV(ikl,isl)  = max(TaT_SV(ikl)-30,TsisSV(ikl,isl))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_weq.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_weq.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_weq.f90	(revision 5117)
@@ -22,7 +22,7 @@
   ! +  ================
 
-  use VARphy
-  use VAR_SV
-  use VARxSV
+  USE VARphy
+  USE VAR_SV
+  USE VARxSV
 
   IMPLICIT NONE
@@ -33,5 +33,5 @@
   INTEGER :: istart
 
-  logical :: logWEq
+  LOGICAL :: logWEq
   common/SISVAT_wEq_L/logWEq
 
@@ -84,5 +84,5 @@
   ! +  ======
 
-  !!      IF (istart.eq.1)                                              THEN
+  !!      IF (istart.EQ.1)                                              THEN
   !!        WRITE(45,45)dahost,i___SV(lwriSV(1)),j___SV(lwriSV(1)),
   !!     .              n___SV(lwriSV(1))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zag.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zag.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zag.f90	(revision 5117)
@@ -51,9 +51,9 @@
   ! +  ================
 
-  use VARphy
-  use VAR_SV
-  use VARdSV
-  use VAR0SV
-  use VARxSV
+  USE VARphy
+  USE VAR_SV
+  USE VARdSV
+  USE VAR0SV
+  USE VARxSV
 
   IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zcr.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zcr.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zcr.f90	(revision 5117)
@@ -34,11 +34,11 @@
   ! +  ================
   !
-  use VARphy
-  use VAR_SV
-  use VARdSV
-  use VAR0SV
-  use VARxSV
-  use VARySV
-  use VARtSV
+  USE VARphy
+  USE VAR_SV
+  USE VARdSV
+  USE VAR0SV
+  USE VARxSV
+  USE VARySV
+  USE VARtSV
 
   IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zsn.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zsn.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zsn.f90	(revision 5117)
@@ -46,11 +46,11 @@
 
 
-  use VARphy
-  use VAR_SV
-  use VARdSV
-  use VAR0SV
-  use VARxSV
-  use VARySV
-  use surface_data, ONLY: ok_zsn_ii
+  USE VARphy
+  USE VAR_SV
+  USE VARdSV
+  USE VAR0SV
+  USE VARxSV
+  USE VARySV
+  USE surface_data, ONLY: ok_zsn_ii
 
   IMPLICIT NONE
@@ -598,7 +598,7 @@
   ! + minimum uppermost layer thickness to guarantee a correct reproduction of the snow
   ! + atmosphere coupling
-    IF(dzsnSV(ikl,max(1,isnoSV(ikl)-0))>0.02 .or. & ! surface layers> 2-5-10
-          dzsnSV(ikl,max(1,isnoSV(ikl)-1))>0.05 .or. & ! XF 04/07/2019
-          dzsnSV(ikl,max(1,isnoSV(ikl)-2))>0.10 .or. &
+    IF(dzsnSV(ikl,max(1,isnoSV(ikl)-0))>0.02 .OR. & ! surface layers> 2-5-10
+          dzsnSV(ikl,max(1,isnoSV(ikl)-1))>0.05 .OR. & ! XF 04/07/2019
+          dzsnSV(ikl,max(1,isnoSV(ikl)-2))>0.10 .OR. &
           dzsnSV(ikl,max(1,isnoSV(ikl)-3))>0.30 )THEN
       Agrege(ikl) = min(1, &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/surf_inlandsis_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/surf_inlandsis_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/surf_inlandsis_mod.F90	(revision 5117)
@@ -158,10 +158,10 @@
         ! CA initialization
         ! dz_profil_15 : 1 m in 15 layers [m]
-        real, parameter :: dz_profil_15(15) = (/0.005, 0.01, 0.015, 0.02, 0.03, 0.04, 0.05, &
+        REAL, parameter :: dz_profil_15(15) = (/0.005, 0.01, 0.015, 0.02, 0.03, 0.04, 0.05, &
                                                 0.06, 0.07, 0.08, 0.09, 0.1, 0.12, 0.14, 0.17/)
         ! mean_temp : mean annual surface temperature [K]
-        real, dimension(klon) :: mean_temp
+        REAL, DIMENSION(klon) :: mean_temp
         ! mean_dens : mean surface density [kg/m3]
-        real, dimension(klon) :: mean_dens
+        REAL, DIMENSION(klon) :: mean_dens
         ! lat_scale : temperature lapse rate against latitude [K degree-1]
         REAL :: lat_scale
@@ -183,14 +183,14 @@
         ! constants for density profile
         ! C0, C1 : constant, 0.07 for z <= 550 kg m-3
-        real, parameter :: C0 = 0.07
-        real, parameter :: C1 = 0.03
+        REAL, parameter :: C0 = 0.07
+        REAL, parameter :: C1 = 0.03
         ! rho_i : ice density [kg m-3]
-        real, parameter :: rho_ice = 917.
+        REAL, parameter :: rho_ice = 917.
         ! E_c : activation energy [J mol-1]
-        real, parameter :: E_c = 60000.
+        REAL, parameter :: E_c = 60000.
         ! E_g : activation energy [J mol-1]
-        real, parameter :: E_g = 42400.
+        REAL, parameter :: E_g = 42400.
         ! R : gas constant [J mol-1 K-1]
-        real, parameter :: R = 8.3144621
+        REAL, parameter :: R = 8.3144621
 
       
@@ -368,5 +368,5 @@
                 ! with a moist-adiabatic lapse rate of 5 °C km-1 everywhere except for Antarctica,
                 ! for Antarctica, a dry-adiabatic lapse rate of 9.8 °C km-1 is assumed.
-                if (lati > 60.) THEN
+                IF (lati > 60.) THEN
                     ! CA todo : add longitude bounds
                     ! Greenland mean temperature : function of altitude and latitude
@@ -379,5 +379,5 @@
                     ! surface density: Fausto et al. 2018, https://doi.org/10.3389/feart.2018.00051
                     mean_dens(ikl) = 315.
-                else if (lati < -60.) THEN
+                ELSE IF (lati < -60.) THEN
                     ! Antarctica mean temperature : function of altitude and latitude
                     ! for altitudes 0. to 500. m, lat_scale varies from 1.3 to 0.6 °C °lat-1
@@ -463,5 +463,5 @@
                     rho0 = exp(E0 * depth) / (rho_ice / mean_dens(ikl) - 1 + exp(E0 * depth)) * rho_ice
                     rho1 = exp(E1 * depth) / (rho_ice / mean_dens(ikl) - 1 + exp(E1 * depth)) * rho_ice
-                    if (depth <= z550) THEN
+                    IF (depth <= z550) THEN
                         ro__SV(ikl, isl) = exp(E0 * depth) / (rho_ice / mean_dens(ikl) - 1 + exp(E0 * depth)) * rho_ice
                     else
@@ -553,5 +553,5 @@
             ! => Upper bound for eroded snow mass
             !        uss_SV(ikl) = SLussl(i,j,n) ! u*qs* (only for Tv in sisvatesbl.f)
-            ! #BS  IF(dsn_SV(ikl)>eps12.and.erprev(i,j,n).gt.eps9) THEN
+            ! #BS  IF(dsn_SV(ikl)>eps12.AND.erprev(i,j,n).gt.eps9) THEN
             ! #BS    dsnbSV(ikl) =1.0-min(qsHY(i,j,kB)     !BS neglib. at kb ~100 magl)
             ! #BS.                        /max(qshy(i,j,mz),eps9),unun)
@@ -560,5 +560,5 @@
             ! #BS  else
             ! #BS    dsnbSV(ikl) = 0.
-            ! #BS  endif
+            ! #BS  ENDIF
             !      dsnbSV is the drift fraction of deposited snow updated in sisvat.f
             !      will be used for characterizing the Buffer Layer
@@ -586,5 +586,5 @@
             ! +--Energy Fluxes                                          (INPUT/OUTPUT)
             ! +  ^^^^^^^^^^^^^                                           ^^^^^^^^^^^^
-            !IF (.not.firstcall) THEN
+            !IF (.NOT.firstcall) THEN
             Tsrfsv(ikl)  = tsurf(ikl)                     !hj 12 03 2010
             cld_SV(ikl) = cloudf(ikl)                    ! Cloudiness
@@ -932,5 +932,5 @@
         !c #kd END IF
 
-        !      IF (nsol.ne.4)                                              THEN
+        !      IF (nsol.NE.4)                                              THEN
         !        DO isl= 0,-nsol,-1
         !          misl_2 =     -mod(isl,2)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/iophy.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/iophy.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/iophy.F90	(revision 5117)
@@ -4,6 +4,6 @@
 MODULE iophy
 
-! abd  REAL,PRIVATE,allocatable,DIMENSION(:),save :: io_lat
-! abd  REAL,PRIVATE,allocatable,DIMENSION(:),save :: io_lon
+! abd  REAL,PRIVATE,ALLOCATABLE,DIMENSION(:),save :: io_lat
+! abd  REAL,PRIVATE,ALLOCATABLE,DIMENSION(:),save :: io_lon
   REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lat
   REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lon
@@ -44,5 +44,5 @@
   USE lmdz_print_control, ONLY: prt_level,lunout
     USE ioipsl, ONLY: flio_dom_set
-  use wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_context_init, using_xios
+  USE lmdz_wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_context_init, using_xios
     IMPLICIT NONE
     REAL,DIMENSION(klon),INTENT(IN) :: rlon
@@ -62,5 +62,5 @@
     INTEGER :: data_ibegin, data_iend
 
-    if (using_xios)  CALL wxios_context_init
+    IF (using_xios)  CALL wxios_context_init
     
 
@@ -211,5 +211,5 @@
   USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
   USE ioipsl, ONLY: histbeg
-  USE wxios, ONLY: wxios_add_file, using_xios
+  USE lmdz_wxios, ONLY: wxios_add_file, using_xios
   IMPLICIT NONE
   INCLUDE 'clesphys.h'
@@ -237,5 +237,5 @@
     IF((.NOT. is_using_mpi) .OR. is_mpi_root) THEN
         ! ug Création du fichier
-      IF (.not. ok_all_xml) THEN
+      IF (.NOT. ok_all_xml) THEN
         CALL wxios_add_file(name, ffreq, lev)
       ENDIF
@@ -294,5 +294,5 @@
     REAL,INTENT(IN) :: dtime
     INTEGER, INTENT(IN) :: pim
-    INTEGER, intent(out) :: nnhori
+    INTEGER, INTENT(OUT) :: nnhori
     CHARACTER(len=20), INTENT(IN) :: nname
     INTEGER, INTENT(OUT) :: nnid_day
@@ -303,5 +303,5 @@
     REAL,DIMENSION(pim), INTENT(IN) :: plat, plon
     INTEGER,DIMENSION(pim), INTENT(IN) :: ipt, jpt
-    REAL,DIMENSION(pim,2), intent(out) :: plat_bounds, plon_bounds
+    REAL,DIMENSION(pim,2), INTENT(OUT) :: plat_bounds, plon_bounds
 
     INTEGER, SAVE :: tabprocbeg, tabprocend
@@ -310,6 +310,6 @@
     INTEGER, PARAMETER :: nip=1
     INTEGER :: npproc
-    REAL, allocatable, DIMENSION(:) :: npplat, npplon
-    REAL, allocatable, DIMENSION(:,:) :: npplat_bounds, npplon_bounds
+    REAL, ALLOCATABLE, DIMENSION(:) :: npplat, npplon
+    REAL, ALLOCATABLE, DIMENSION(:,:) :: npplat_bounds, npplon_bounds
     REAL, DIMENSION(nbp_lon,nbp_lat) :: zx_lon, zx_lat
 
@@ -348,5 +348,5 @@
 
     ENDDO
-    if (is_sequential) THEN
+    IF (is_sequential) THEN
      npstn=pim
      IF(.NOT. ALLOCATED(nptabij)) THEN
@@ -589,5 +589,5 @@
     USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
     USE aero_mod, ONLY: naero_tot, name_aero_tau
-    USE wxios, ONLY: wxios_add_field_to_file, using_xios
+    USE lmdz_wxios, ONLY: wxios_add_field_to_file, using_xios
     USE lmdz_print_control, ONLY: prt_level,lunout
     IMPLICIT NONE
@@ -630,5 +630,5 @@
 
       IF (using_xios) THEN  
-        IF (.not. ok_all_xml) THEN
+        IF (.NOT. ok_all_xml) THEN
           IF ( var%flag(iff)<=lev_files(iff) ) THEN
             CALL wxios_add_field_to_file(var%name, 2, iff, phys_out_filenames(iff), &
@@ -704,5 +704,5 @@
     USE lmdz_print_control, ONLY: prt_level,lunout
     USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
-    USE wxios, ONLY: wxios_add_field_to_file, using_xios
+    USE lmdz_wxios, ONLY: wxios_add_field_to_file, using_xios
     USE lmdz_print_control, ONLY: prt_level,lunout
     IMPLICIT NONE
@@ -745,5 +745,5 @@
       IF (using_xios) THEN  
 
-        IF (.not. ok_all_xml) THEN
+        IF (.NOT. ok_all_xml) THEN
           IF ( var%flag(iff)<=lev_files(iff) ) THEN
           CALL wxios_add_field_to_file(var%name, 3, iff, phys_out_filenames(iff), &
@@ -819,5 +819,5 @@
     REAL,DIMENSION(:),INTENT(IN) :: field
     REAL,DIMENSION(klon_mpi) :: buffer_omp
-    INTEGER, allocatable, DIMENSION(:) :: index2d
+    INTEGER, ALLOCATABLE, DIMENSION(:) :: index2d
     REAL :: Field2d(nbp_lon,jj_nb)
 
@@ -889,5 +889,5 @@
     INTEGER :: ip, n, nlev
     INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
-    REAL,allocatable, DIMENSION(:,:) :: fieldok
+    REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
 
     IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_phy_old for ', name
@@ -969,5 +969,5 @@
 
   REAL,DIMENSION(klon_mpi) :: buffer_omp
-  INTEGER, allocatable, DIMENSION(:) :: index2d
+  INTEGER, ALLOCATABLE, DIMENSION(:) :: index2d
   REAL :: Field2d(nbp_lon,jj_nb)
 
@@ -995,7 +995,7 @@
 !$OMP MASTER
       !Si phase de définition.... on définit
-      IF (.not. ok_all_xml) THEN
+      IF (.NOT. ok_all_xml) THEN
       IF (prt_level >= 10) THEN
-      WRITE(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", &
+      WRITE(lunout,*)"histwrite2d_phy: .NOT.vars_defined ; time to define ", &
                      trim(var%name)
       ENDIF
@@ -1021,5 +1021,5 @@
         !$omp end master
         !$omp barrier
-        IF(.not. is_active) RETURN
+        IF(.NOT. is_active) RETURN
       ENDIF
     ENDIF
@@ -1030,5 +1030,5 @@
          'Field first DIMENSION not equal to klon/klev',1)
     IF (prt_level >= 10) THEn
-      WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", trim(var%name)
+      WRITE (lunout,*)"histwrite2d_phy: .NOT.vars_defined ; time to gather and write ", trim(var%name)
     ENDIF
     
@@ -1220,5 +1220,5 @@
         !$omp end master
         !$omp barrier
-        IF(.not. is_active) RETURN
+        IF(.NOT. is_active) RETURN
       ENDIF
     ENDIF
@@ -1373,5 +1373,5 @@
       
   REAL,DIMENSION(klon_mpi) :: buffer_omp
-  INTEGER, allocatable, DIMENSION(:) :: index2d
+  INTEGER, ALLOCATABLE, DIMENSION(:) :: index2d
   REAL :: Field2d(nbp_lon,jj_nb)
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/iophys.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/iophys.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/iophys.F90	(revision 5117)
@@ -47,11 +47,11 @@
 
 ! Arguments on input:
-      integer lllm
-      character (len=*) :: nom,titre,unite
-      integer imjmax
+      INTEGER lllm
+      CHARACTER (LEN=*) :: nom,titre,unite
+      INTEGER imjmax
       parameter (imjmax=100000)
-      real px(klon_omp,lllm)
-      real xglo(klon_glo,lllm)
-      real zx(nbp_lon,nbp_lat,lllm)
+      REAL px(klon_omp,lllm)
+      REAL xglo(klon_glo,lllm)
+      REAL zx(nbp_lon,nbp_lat,lllm)
 
 
@@ -138,5 +138,5 @@
 !   -------------
 
-real pi
+REAL pi
 INTEGER nlat_eff
 INTEGER jour0,mois0,an0
@@ -224,11 +224,11 @@
 
 ! Arguments on input:
-      integer lllm
-      character (len=*) :: nom,titre,unite
-      integer imjmax
+      INTEGER lllm
+      CHARACTER (LEN=*) :: nom,titre,unite
+      INTEGER imjmax
       parameter (imjmax=100000)
-      real px(imjmax*lllm)
-      real, allocatable :: zx(:,:,:)
-      integer i,j,l,ijl
+      REAL px(imjmax*lllm)
+      REAL, ALLOCATABLE :: zx(:,:,:)
+      INTEGER i,j,l,ijl
 
       allocate(zx(imax,jmax,lllm))
@@ -249,5 +249,5 @@
          enddo
          ! Pole sud
-         if ( jmax > 1 ) THEN
+         IF ( jmax > 1 ) THEN
             ijl=ijl+1
             do i=1,imax
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/iotd.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/iotd.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/iotd.h	(revision 5117)
@@ -10,9 +10,9 @@
 !=======================================================================
 
-      integer imax,jmax,lmax,nid
+      INTEGER imax,jmax,lmax,nid
       INTEGER dim_coord(4)
-      real iotd_ts,iotd_t0
+      REAL iotd_ts,iotd_t0
       INTEGER :: n_names_iotd_def
-      character*20, dimension(200) :: names_iotd_def
+      character*20, DIMENSION(200) :: names_iotd_def
       character*20 :: un_nom
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/iotd_ecrit.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/iotd_ecrit.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/iotd_ecrit.F90	(revision 5117)
@@ -32,9 +32,9 @@
 
 ! Arguments on input:
-      integer llm
-      character (len=*) :: nom,titre,unite
-      integer imjmax
+      INTEGER llm
+      CHARACTER (LEN=*) :: nom,titre,unite
+      INTEGER imjmax
       parameter (imjmax=100000)
-      real px(imjmax*llm)
+      REAL px(imjmax*llm)
 
 ! Local variables:
@@ -44,9 +44,9 @@
 
 
-      integer ierr,ndim,dim_cc(4)
-      integer iq
-      integer i,j,l
+      INTEGER ierr,ndim,dim_cc(4)
+      INTEGER iq
+      INTEGER i,j,l
 
-      integer zitau
+      INTEGER zitau
       character firstnom*20
       SAVE firstnom
@@ -57,13 +57,13 @@
 
 ! Ajouts
-      integer, save :: ntime=0
+      INTEGER, save :: ntime=0
       INTEGER :: idim,varid
-      character (len =50):: fichnom
-      integer, dimension(4) :: id
-      integer, dimension(4) :: edges,corner
+      CHARACTER (LEN =50):: fichnom
+      INTEGER, DIMENSION(4) :: id
+      INTEGER, DIMENSION(4) :: edges,corner
       
 
 
-       if (n_names_iotd_def>0 .and..not.any(names_iotd_def==nom)) RETURN
+       IF (n_names_iotd_def>0 .and..not.any(names_iotd_def==nom)) RETURN
 !***************************************************************
 ! Initialisation of 'firstnom' and create/open the "diagfi.nc" NetCDF file
@@ -83,5 +83,5 @@
 
         zx(1:imax*jmax*llm)=px(1:imax*jmax*llm)
-        if (firstnom =='1234567890') THEN
+        IF (firstnom =='1234567890') THEN
             firstnom=nom
         endif
@@ -90,5 +90,5 @@
 
 !! Quand on tombe sur la premiere variable on ajoute un pas de temps
-        if (nom==firstnom) THEN
+        IF (nom==firstnom) THEN
         ! We have identified a "first call" (at given date)
 
@@ -114,5 +114,5 @@
 !        PRINT*,'IOTD Date ,varid,nid,ntime,date',varid,nid,ntime,date
 
-           if (ierr/=nf90_noerr) THEN
+           IF (ierr/=nf90_noerr) THEN
               WRITE(*,*) "***** PUT_VAR matter in writediagfi_nc"
               WRITE(*,*) "***** with time"
@@ -121,10 +121,10 @@
 
 !          WRITE(6,*)'WRITEDIAGFI: date= ', date
-        end if ! of if (nom.eq.firstnom)
+        end if ! of if (nom.EQ.firstnom)
 
 
 !Case of a 3D variable
 !---------------------
-        if (llm==lmax) THEN
+        IF (llm==lmax) THEN
            ndim=4
            corner(1)=1
@@ -142,5 +142,5 @@
 !---------------------
 
-        else if (llm==1) THEN
+        ELSE IF (llm==1) THEN
            ndim=3
            corner(1)=1
@@ -160,5 +160,5 @@
 !-----------------------------------------------
 
-      if (ntime==1) THEN
+      IF (ntime==1) THEN
           ierr = nf90_redef (nid)
           ierr = nf90_def_var(nid,nom,nf90_float,dim_cc,varid)
@@ -175,5 +175,5 @@
       ierr= nf90_put_var(nid,varid,zx,corner,edges)
 
-      if (ierr/=nf90_noerr) THEN
+      IF (ierr/=nf90_noerr) THEN
            WRITE(*,*) "***** PUT_VAR problem in writediagfi"
            WRITE(*,*) "***** with ",nom
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/iotd_fin.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/iotd_fin.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/iotd_fin.F90	(revision 5117)
@@ -16,5 +16,5 @@
 
   INCLUDE "iotd.h"
-  integer ierr
+  INTEGER ierr
 
   !   Arguments:
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/iotd_ini.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/iotd_ini.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/iotd_ini.F90	(revision 5117)
@@ -23,13 +23,13 @@
 !   ----------
 
-      integer iim,jjm,llm
-      real prlon(iim),prlat(jjm),pcoordv(llm),timestep,t0
+      INTEGER iim,jjm,llm
+      REAL prlon(iim),prlat(jjm),pcoordv(llm),timestep,t0
       INTEGER id_FOCE
       INTEGER jour0,mois0,an0
       CHARACTER*(*) calendrier
 
-      integer corner(4),edges(4),ndim
+      INTEGER corner(4),edges(4),ndim
       real  px(1000)
-      character (len=10) :: nom
+      CHARACTER (LEN=10) :: nom
       real(kind=4) rlon(iim),rlat(jjm),coordv(llm)
 
@@ -43,9 +43,9 @@
 
       INTEGER :: nvarid
-      integer, dimension(2) :: id  
+      INTEGER, DIMENSION(2) :: id
 
       character*(*) fichnom
 
-      real pi
+      REAL pi
 
       iotd_ts=timestep
@@ -72,9 +72,9 @@
       n_names_iotd_def=0
       open(99,file='iotd.def',form='formatted',status='old',iostat=ierr)
-         if ( ierr==0 ) THEN
+         IF ( ierr==0 ) THEN
             ierr=0
             do while (ierr==0)
                read(99,*,iostat=ierr) un_nom
-               if (ierr==0) THEN
+               IF (ierr==0) THEN
                   n_names_iotd_def=n_names_iotd_def+1
                   names_iotd_def(n_names_iotd_def)=un_nom
@@ -128,5 +128,5 @@
       ierr=nf90_def_var(nid, "lev", nf90_float,dim_coord(3),nvarid)
       ierr=nf90_put_att(nid,nvarid,"long_name","vert level")
-      if ( coordv(2)>coordv(1) ) THEN
+      IF ( coordv(2)>coordv(1) ) THEN
          ierr=nf90_put_att(nid,nvarid,"long_name","pseudo-alt")
          ierr=nf90_put_att(nid,nvarid,'positive',"up")
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/isccp_cloud_types.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/isccp_cloud_types.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/isccp_cloud_types.F90	(revision 5117)
@@ -247,5 +247,5 @@
   ! PRINT*,' isccp_cloud_types npoints=',npoints
 
-  ! if ( debug.ne.0 ) THEN
+  ! if ( debug.NE.0 ) THEN
   ! j=1
   ! WRITE(6,'(a10)') 'j='
@@ -301,5 +301,5 @@
   ! WRITE(6,'(8f10.2)') (dem_c(j,i),i=1,nlev)
   ! enddo
-  ! endif
+  ! END IF
 
   ! ---------------------------------------------------!
@@ -338,5 +338,5 @@
   ! IM
   ! IM
-  ! if (ncolprint.ne.0) THEN
+  ! if (ncolprint.NE.0) THEN
   ! do j=1,npoints,1000
   ! WRITE(6,'(a10)') 'j='
@@ -354,5 +354,5 @@
   ! &   ((cca(j,ilev),ibox=1,ncolprint),ilev=1,nlev)
   ! enddo
-  ! endif
+  ! END IF
 
   IF (top_height==1 .OR. top_height==3) THEN
@@ -391,5 +391,5 @@
   ! num1=0
   ! do j=1,npoints
-  ! if (cc(j,ilev) .lt. 0. .or. cc(j,ilev) .gt. 1.) THEN
+  ! if (cc(j,ilev) .lt. 0. .OR. cc(j,ilev) .gt. 1.) THEN
   ! num1=num1+1
   ! index1(num1)=j
@@ -407,5 +407,5 @@
   ! num1=0
   ! do j=1,npoints
-  ! if (conv(j,ilev) .lt. 0. .or. conv(j,ilev) .gt. 1.) THEN
+  ! if (conv(j,ilev) .lt. 0. .OR. conv(j,ilev) .gt. 1.) THEN
   ! num1=num1+1
   ! index1(num1)=j
@@ -457,5 +457,5 @@
   ! num1=0
   ! do j=1,npoints
-  ! if (dem_s(j,ilev) .lt. 0. .or. dem_s(j,ilev) .gt. 1.) THEN
+  ! if (dem_s(j,ilev) .lt. 0. .OR. dem_s(j,ilev) .gt. 1.) THEN
   ! num1=num1+1
   ! index1(num1)=j
@@ -476,5 +476,5 @@
   ! num1=0
   ! do j=1,npoints
-  ! if (dem_c(j,ilev) .lt. 0. .or. dem_c(j,ilev) .gt. 1.) THEN
+  ! if (dem_c(j,ilev) .lt. 0. .OR. dem_c(j,ilev) .gt. 1.) THEN
   ! num1=num1+1
   ! index1(num1)=j
@@ -516,5 +516,5 @@
 
   ! IM
-  ! if (ncolprint.ne.0) THEN
+  ! if (ncolprint.NE.0) THEN
   ! write (6,'(a)') 'frac_out_pp_rev:'
   ! do j=1,npoints,1000
@@ -527,6 +527,6 @@
   ! write (6,'(a)') 'ncol:'
   ! write (6,'(I3)') ncol
-  ! endif
-  ! if (ncolprint.ne.0) THEN
+  ! END IF
+  ! if (ncolprint.NE.0) THEN
   ! write (6,'(a)') 'last_frac_pp:'
   ! do j=1,npoints,1000
@@ -535,5 +535,5 @@
   ! write (6,'(8f5.2)') (tca(j,0))
   ! enddo
-  ! endif
+  ! END IF
 
   ! ---------------------------------------------------!
@@ -570,5 +570,5 @@
       END IF
       ! IM
-      ! IF (ncolprint.ne.0) THEN
+      ! IF (ncolprint.NE.0) THEN
       ! write (6,'(a)') 'threshold_nsf2:'
       ! do j=1,npoints,1000
@@ -580,5 +580,5 @@
     END IF
 
-    ! IF (ncolprint.ne.0) THEN
+    ! IF (ncolprint.NE.0) THEN
     ! write (6,'(a)') 'ilev:'
     ! write (6,'(I2)') ilev
@@ -681,5 +681,5 @@
 
     ! IM
-    ! if (ncolprint.ne.0) THEN
+    ! if (ncolprint.NE.0) THEN
     ! do j=1,npoints ,1000
     ! WRITE(6,'(a10)') 'j='
@@ -707,5 +707,5 @@
     ! &       ((frac_out(j,ibox,ilev2),ibox=1,ncolprint),ilev2=1,nlev)
     ! enddo
-    ! endif
+    ! END IF
 
 
@@ -737,9 +737,9 @@
     DO ibox = 1, ncol
       DO j = 1, npoints
-        ! IM REAL              if (frac_out(j,ibox,ilev).eq.1) THEN
+        ! IM REAL              if (frac_out(j,ibox,ilev).EQ.1) THEN
         IF (frac_out(j,ibox,ilev)==1.0) THEN
           tau(j, ibox) = tau(j, ibox) + dtau_s(j, ilev)
         END IF
-        ! IM REAL              if (frac_out(j,ibox,ilev).eq.2) THEN
+        ! IM REAL              if (frac_out(j,ibox,ilev).EQ.2) THEN
         IF (frac_out(j,ibox,ilev)==2.0) THEN
           tau(j, ibox) = tau(j, ibox) + dtau_c(j, ilev)
@@ -749,5 +749,5 @@
   END DO ! ilev
   ! IM
-  ! if (ncolprint.ne.0) THEN
+  ! if (ncolprint.NE.0) THEN
   ! do j=1,npoints ,1000
   ! WRITE(6,'(a10)') 'j='
@@ -757,5 +757,5 @@
   ! &          (tau(j,ibox),ibox=1,ncolprint)
   ! enddo
-  ! endif
+  ! END IF
 
   ! ---------------------------------------------------!
@@ -796,5 +796,5 @@
     t0 = 296.
     ! IM
-    ! if (ncolprint .ne. 0)
+    ! if (ncolprint .NE. 0)
     ! &         WRITE(6,*)  'ilev   pw (kg/m2)   tauwv(j)      dem_wv'
     DO ilev = 1, nlev
@@ -816,5 +816,5 @@
       END DO
       ! IM
-      ! if (ncolprint .ne. 0) THEN
+      ! if (ncolprint .NE. 0) THEN
       ! do j=1,npoints ,1000
       ! WRITE(6,'(a10)') 'j='
@@ -824,5 +824,5 @@
       ! &           tauwv(j),dem_wv(j,ilev)
       ! enddo
-      ! endif
+      ! END IF
     END DO
 
@@ -856,5 +856,5 @@
       END DO
       ! IM
-      ! if (ncolprint.ne.0) THEN
+      ! if (ncolprint.NE.0) THEN
       ! do j=1,npoints ,1000
       ! WRITE(6,'(a10)') 'j='
@@ -868,5 +868,5 @@
       ! &             100.*fluxtop_clrsky(j),trans_layers_above_clrsky(j)
       ! enddo
-      ! endif
+      ! END IF
 
     END DO !loop over level
@@ -882,5 +882,5 @@
 
     ! IM
-    ! if (ncolprint.ne.0) THEN
+    ! if (ncolprint.NE.0) THEN
     ! do j=1,npoints ,1000
     ! WRITE(6,'(a10)') 'j='
@@ -894,5 +894,5 @@
     ! &       trans_layers_above_clrsky(j)
     ! enddo
-    ! endif
+    ! END IF
 
       !           END OF CLEAR SKY CALCULATION
@@ -902,5 +902,5 @@
 
     ! IM
-    ! if (ncolprint.ne.0) THEN
+    ! if (ncolprint.NE.0) THEN
     ! do j=1,npoints ,1000
     ! WRITE(6,'(a10)') 'j='
@@ -914,5 +914,5 @@
 
     ! enddo
-    ! endif
+    ! END IF
       !loop over columns
     DO ibox = 1, ncol
@@ -935,8 +935,8 @@
 
             ! emissivity for point in this layer
-          ! IM REAL             if (frac_out(j,ibox,ilev).eq.1) THEN
+          ! IM REAL             if (frac_out(j,ibox,ilev).EQ.1) THEN
           IF (frac_out(j,ibox,ilev)==1.0) THEN
             dem(j, ibox) = 1. - ((1.-dem_wv(j,ilev))*(1.-dem_s(j,ilev)))
-            ! IM REAL             else if (frac_out(j,ibox,ilev).eq.2) THEN
+            ! IM REAL             ELSE IF (frac_out(j,ibox,ilev).EQ.2) THEN
           ELSE IF (frac_out(j,ibox,ilev)==2.0) THEN
             dem(j, ibox) = 1. - ((1.-dem_wv(j,ilev))*(1.-dem_c(j,ilev)))
@@ -962,5 +962,5 @@
 
       ! IM
-      ! if (ncolprint.ne.0) THEN
+      ! if (ncolprint.NE.0) THEN
       ! do j=1,npoints,1000
       ! write (6,'(a)') 'ilev:'
@@ -983,5 +983,5 @@
       ! &          (trans_layers_above(j,ibox),ibox=1,ncolprint)
       ! enddo
-      ! endif
+      ! END IF
 
     END DO ! ilev
@@ -1006,5 +1006,5 @@
 
     ! IM
-    ! if (ncolprint.ne.0) THEN
+    ! if (ncolprint.NE.0) THEN
     ! do j=1,npoints ,1000
     ! WRITE(6,'(a10)') 'j='
@@ -1022,5 +1022,5 @@
     ! write (6,'(8f7.2)') (100.*fluxtop(j,ibox),ibox=1,ncolprint)
     ! END DO
-    ! endif
+    ! END IF
 
       !now that you have the top of atmosphere radiance account
@@ -1099,5 +1099,5 @@
 
     ! IM
-    ! if (ncolprint.ne.0) THEN
+    ! if (ncolprint.NE.0) THEN
     ! do j=1,npoints,1000
     ! WRITE(6,'(a10)') 'j='
@@ -1141,5 +1141,5 @@
     ! write (6,'(8f7.2)') (tb(j,ibox),ibox=1,ncolprint)
     ! enddo ! j
-    ! endif
+    ! END IF
 
   END IF
@@ -1198,5 +1198,5 @@
       END DO ! j
 
-    ELSE ! if (top_height .eq. 1 .or. top_height .eq. 3)
+    ELSE ! if (top_height .EQ. 1 .OR. top_height .EQ. 3)
 
       DO j = 1, npoints
@@ -1206,5 +1206,5 @@
         DO j = 1, npoints
           IF ((ptop(j,ibox)==0.) & ! IM  &
-                                   ! .and.(frac_out(j,ibox,ilev) .ne. 0))
+                                   ! .AND.(frac_out(j,ibox,ilev) .NE. 0))
                                    ! THEN
               .AND. (frac_out(j,ibox,ilev)/=0.0)) THEN
@@ -1385,21 +1385,21 @@
           ! if (tau(j,ibox) .lt. isccp_taumin) THEN
           ! itau(j)=1
-          ! else if (tau(j,ibox) .ge. isccp_taumin
+          ! ELSE IF (tau(j,ibox) .ge. isccp_taumin
           ! &
-          ! &          .and. tau(j,ibox) .lt. 1.3) THEN
+          ! &          .AND. tau(j,ibox) .lt. 1.3) THEN
           ! itau(j)=2
-          ! else if (tau(j,ibox) .ge. 1.3
-          ! &          .and. tau(j,ibox) .lt. 3.6) THEN
+          ! ELSE IF (tau(j,ibox) .ge. 1.3
+          ! &          .AND. tau(j,ibox) .lt. 3.6) THEN
           ! itau(j)=3
-          ! else if (tau(j,ibox) .ge. 3.6
-          ! &          .and. tau(j,ibox) .lt. 9.4) THEN
+          ! ELSE IF (tau(j,ibox) .ge. 3.6
+          ! &          .AND. tau(j,ibox) .lt. 9.4) THEN
           ! itau(j)=4
-          ! else if (tau(j,ibox) .ge. 9.4
-          ! &          .and. tau(j,ibox) .lt. 23.) THEN
+          ! ELSE IF (tau(j,ibox) .ge. 9.4
+          ! &          .AND. tau(j,ibox) .lt. 23.) THEN
           ! itau(j)=5
-          ! else if (tau(j,ibox) .ge. 23.
-          ! &          .and. tau(j,ibox) .lt. 60.) THEN
+          ! ELSE IF (tau(j,ibox) .ge. 23.
+          ! &          .AND. tau(j,ibox) .lt. 60.) THEN
           ! itau(j)=6
-          ! else if (tau(j,ibox) .ge. 60.) THEN
+          ! ELSE IF (tau(j,ibox) .ge. 60.) THEN
           ! itau(j)=7
           ! end if
@@ -1407,20 +1407,20 @@
           !determine cloud top pressure category
           ! if (    ptop(j,ibox) .gt. 0.
-          ! &          .and.ptop(j,ibox) .lt. 180.) THEN
+          ! &          .AND.ptop(j,ibox) .lt. 180.) THEN
           ! ipres(j)=1
           ! else IF(ptop(j,ibox) .ge. 180.
-          ! &          .and.ptop(j,ibox) .lt. 310.) THEN
+          ! &          .AND.ptop(j,ibox) .lt. 310.) THEN
           ! ipres(j)=2
           ! else IF(ptop(j,ibox) .ge. 310.
-          ! &          .and.ptop(j,ibox) .lt. 440.) THEN
+          ! &          .AND.ptop(j,ibox) .lt. 440.) THEN
           ! ipres(j)=3
           ! else IF(ptop(j,ibox) .ge. 440.
-          ! &          .and.ptop(j,ibox) .lt. 560.) THEN
+          ! &          .AND.ptop(j,ibox) .lt. 560.) THEN
           ! ipres(j)=4
           ! else IF(ptop(j,ibox) .ge. 560.
-          ! &          .and.ptop(j,ibox) .lt. 680.) THEN
+          ! &          .AND.ptop(j,ibox) .lt. 680.) THEN
           ! ipres(j)=5
           ! else IF(ptop(j,ibox) .ge. 680.
-          ! &          .and.ptop(j,ibox) .lt. 800.) THEN
+          ! &          .AND.ptop(j,ibox) .lt. 800.) THEN
           ! ipres(j)=6
           ! else IF(ptop(j,ibox) .ge. 800.) THEN
@@ -1439,6 +1439,6 @@
           !update frequencies W500
           ! if (pct_ocean(j)) THEN
-          ! if (ipres(j) .gt. 0.and.itau(j) .gt. 0) THEN
-          ! if (iw(j) .gt. int(wmin).and.iw(j) .le. iwmx) THEN
+          ! if (ipres(j) .gt. 0.AND.itau(j) .gt. 0) THEN
+          ! if (iw(j) .gt. int(wmin).AND.iw(j) .le. iwmx) THEN
           ! PRINT*,' ISCCP iw=',iw(j),j
           ! fq_dynreg(itau(j),ipres(j),iw(j))=
@@ -1469,9 +1469,9 @@
     ! IF(j.EQ.6722) THEN
     ! PRINT*,' ISCCP',w(j),iw(j),ipres(j),itau(j)
-    ! endif
+    ! END IF
 
     ! if (pct_ocean(j)) THEN
-    ! if (ipres(j) .gt. 0.and.itau(j) .gt. 0) THEN
-    ! if (iw(j) .gt. int(wmin).and.iw(j) .le. iwmx) THEN
+    ! if (ipres(j) .gt. 0.AND.itau(j) .gt. 0) THEN
+    ! if (iw(j) .gt. int(wmin).AND.iw(j) .le. iwmx) THEN
     ! IF(pctj(itau(j),ipres(j),iw(j))) THEN
     ! nfq_dynreg(itau(j),ipres(j),iw(j))=
@@ -1482,9 +1482,9 @@
     ! &    nfq_dynreg(itau(j),ipres(j),iw(j)),
     ! &    fq_dynreg(itau(j),ipres(j),iw(j))
-    ! endif
-    ! endif
-    ! endif
-    ! endif
-    ! endif
+    ! END IF
+    ! END IF
+    ! END IF
+    ! END IF
+    ! END IF
 
   END DO
@@ -1510,9 +1510,9 @@
   ! PRINT*,' isccp APRES',nfq_dynreg(k,l,nw),
   ! &   fq_dynreg(k,l,nw)
-  ! endif
+  ! END IF
   ! else
   ! IF(fq_dynreg(k,l,nw).NE.0.) THEN
   ! PRINT*,'nfq_dynreg = 0 tau,pc,nw',k,l,nw,fq_dynreg(k,l,nw)
-  ! endif
+  ! END IF
   ! fq_dynreg(k,l,nw) = -1.E+20
   ! nfq_dynreg(k,l,nw) = 1.E+20
@@ -1528,5 +1528,5 @@
 
   ! cIM
-  ! if (debugcol.ne.0) THEN
+  ! if (debugcol.NE.0) THEN
   ! do j=1,npoints,debugcol
 
@@ -1541,5 +1541,5 @@
   ! do ibox=1,ncol
   ! acc(ilev,ibox)=frac_out(j,ibox,ilev)*2
-  ! if (levmatch(j,ibox) .eq. ilev)
+  ! if (levmatch(j,ibox) .EQ. ilev)
   ! &                 acc(ilev,ibox)=acc(ilev,ibox)+1
   ! enddo
@@ -1565,5 +1565,5 @@
 
   ! IM
-  ! if (ncolprint.ne.0) THEN
+  ! if (ncolprint.NE.0) THEN
   ! WRITE(6,'(a1)') ' '
   ! WRITE(6,'(a2,1X,5(a7,1X),a50)')
@@ -1594,5 +1594,5 @@
   ! write (6,'(a)') 'ptop:'
   ! write (6,'(8f7.2)') (ptop(j,ibox),ibox=1,ncolprint)
-  ! endif
+  ! END IF
 
   ! enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_atke_exchange_coeff.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_atke_exchange_coeff.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_atke_exchange_coeff.F90	(revision 5117)
@@ -33,6 +33,6 @@
 ! INTEGER :: iflag_num_atke    ! flag that controls the numerical treatment of diffusion coeffiient calculation
 
-! logical :: atke_ok_vdiff    ! activate vertical diffusion of TKE or not
-! logical :: atke_ok_virtual  ! account for vapor for flottability
+! LOGICAL :: atke_ok_vdiff    ! activate vertical diffusion of TKE or not
+! LOGICAL :: atke_ok_virtual  ! account for vapor for flottability
 
 ! REAL :: kappa = 0.4         ! Von Karman constant
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_atke_turbulence_ini.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_atke_turbulence_ini.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_atke_turbulence_ini.F90	(revision 5117)
@@ -5,24 +5,24 @@
   ! declaration of constants and parameters
 
-  real, save, protected :: rg, rd, rpi, rcpd, rv, viscom, viscoh
+  REAL, SAVE, protected :: rg, rd, rpi, rcpd, rv, viscom, viscoh
   !$OMP THREADPRIVATE(rg, rd, rpi, rcpd, rv, viscom, viscoh)
 
-  integer, save, protected :: iflag_atke        ! flag that controls options in atke_compute_km_kh
-  integer, save, protected :: iflag_atke_lmix   ! flag that controls the calculation of mixing length in atke
-  integer, save, protected :: iflag_num_atke    ! flag that controls the numerical treatment of diffusion coeffiient calculation
+  INTEGER, SAVE, protected :: iflag_atke        ! flag that controls options in atke_compute_km_kh
+  INTEGER, SAVE, protected :: iflag_atke_lmix   ! flag that controls the calculation of mixing length in atke
+  INTEGER, SAVE, protected :: iflag_num_atke    ! flag that controls the numerical treatment of diffusion coeffiient calculation
   !$OMP THREADPRIVATE(iflag_atke, iflag_atke_lmix, iflag_num_atke)
 
-  logical, save, protected :: atke_ok_vdiff    ! activate vertical diffusion of TKE or not
-  logical, save, protected :: atke_ok_virtual  ! account for vapor for flottability
+  logical, SAVE, protected :: atke_ok_vdiff    ! activate vertical diffusion of TKE or not
+  logical, SAVE, protected :: atke_ok_virtual  ! account for vapor for flottability
   !$OMP THREADPRIVATE(atke_ok_vdiff, atke_ok_virtual)
 
-  real, save, protected :: kappa = 0.4         ! Von Karman constant
-  real, save, protected :: cn                  ! Sm value at Ri=0
-  real, save, protected :: cinf                ! Sm value at Ri=-Inf
-  real, save, protected :: ri0                 ! Richardson number near zero to guarantee continuity in slope of Sm (stability function) at Ri=0
-  real, save, protected :: ri1                 ! Richardson number near zero to guarantee continuity in slope of Pr (Prandlt's number) at Ri=0
-  real, save, protected :: lmin = 0.01         ! minimum mixing length corresponding to the Kolmogov dissipation scale  in planetary atmospheres (Chen et al 2016, JGR Atmos)
-  real, save, protected :: ctkes               ! coefficient for surface TKE
-  real, save, protected :: clmixshear          ! coefficient for mixing length depending on local wind shear
+  REAL, SAVE, protected :: kappa = 0.4         ! Von Karman constant
+  REAL, SAVE, protected :: cn                  ! Sm value at Ri=0
+  REAL, SAVE, protected :: cinf                ! Sm value at Ri=-Inf
+  REAL, SAVE, protected :: ri0                 ! Richardson number near zero to guarantee continuity in slope of Sm (stability function) at Ri=0
+  REAL, SAVE, protected :: ri1                 ! Richardson number near zero to guarantee continuity in slope of Pr (Prandlt's number) at Ri=0
+  REAL, SAVE, protected :: lmin = 0.01         ! minimum mixing length corresponding to the Kolmogov dissipation scale  in planetary atmospheres (Chen et al 2016, JGR Atmos)
+  REAL, SAVE, protected :: ctkes               ! coefficient for surface TKE
+  REAL, SAVE, protected :: clmixshear          ! coefficient for mixing length depending on local wind shear
   !$OMP THREADPRIVATE(kappa, cn, cinf, ri0, ri1, lmin, ctkes, clmixshear)
 
@@ -30,14 +30,14 @@
   ! Tunable parameters for the ATKE scheme and their range of values
   !!-------------------------------------------------------------------------------------------------------------
-  real, save, protected :: cepsilon            ! controls the value of the dissipation length scale, range [1.2 - 10]
-  real, save, protected :: cke                 ! controls the value of the diffusion coefficient of TKE, range [1 - 5]
-  real, save, protected :: l0                  ! asymptotic mixing length far from the ground [m] (Sun et al 2011, JAMC), range [15 - 75]
-  real, save, protected :: clmix               ! controls the value of the mixing length in stratified conditions, range [0.1 - 2]
-  real, save, protected :: ric                 ! critical Richardson number controlling the slope of Sm in stable conditions, range [0.19 - 0.25]
-  real, save, protected :: smmin               ! minimum value of Sm in very stable conditions (defined here as minsqrt(Ez/Ek)) at large Ri, range [0.025 - 0.1]
-  real, save, protected :: pr_neut             ! neutral value of the Prandtl number (Ri=0), range [0.7 - 1]
-  real, save, protected :: pr_slope            ! linear slope of Pr with Ri in the very stable regime, range [3 - 5]
-  real, save, protected :: cinffac             ! ratio between cinf and cn controlling the convective limit of Sm, range [1.2 - 5.0]
-  real, save, protected :: pr_asym             ! value of Prandlt in the convective limit(Ri=-Inf), range [0.3 - 0.5]
+  REAL, SAVE, protected :: cepsilon            ! controls the value of the dissipation length scale, range [1.2 - 10]
+  REAL, SAVE, protected :: cke                 ! controls the value of the diffusion coefficient of TKE, range [1 - 5]
+  REAL, SAVE, protected :: l0                  ! asymptotic mixing length far from the ground [m] (Sun et al 2011, JAMC), range [15 - 75]
+  REAL, SAVE, protected :: clmix               ! controls the value of the mixing length in stratified conditions, range [0.1 - 2]
+  REAL, SAVE, protected :: ric                 ! critical Richardson number controlling the slope of Sm in stable conditions, range [0.19 - 0.25]
+  REAL, SAVE, protected :: smmin               ! minimum value of Sm in very stable conditions (defined here as minsqrt(Ez/Ek)) at large Ri, range [0.025 - 0.1]
+  REAL, SAVE, protected :: pr_neut             ! neutral value of the Prandtl number (Ri=0), range [0.7 - 1]
+  REAL, SAVE, protected :: pr_slope            ! linear slope of Pr with Ri in the very stable regime, range [3 - 5]
+  REAL, SAVE, protected :: cinffac             ! ratio between cinf and cn controlling the convective limit of Sm, range [1.2 - 5.0]
+  REAL, SAVE, protected :: pr_asym             ! value of Prandlt in the convective limit(Ri=-Inf), range [0.3 - 0.5]
   !$OMP THREADPRIVATE(cepsilon, cke, l0, clmix, ric, smmin, pr_neut, pr_slope, cinffac, pr_asym)
   !!-------------------------------------------------------------------------------------------------------------
@@ -58,5 +58,5 @@
     ! input arguments (universal constants for planet)
     !-------------------------------------------------
-    real, intent(in) :: rg_in, rd_in, rpi_in, rcpd_in, rv_in, viscom_in, viscoh_in
+    REAL, INTENT(IN) :: rg_in, rd_in, rpi_in, rcpd_in, rv_in, viscom_in, viscoh_in
     !!----------------------------------------------------------------------
 
@@ -81,5 +81,5 @@
     CALL getin_p('iflag_atke_lmix', iflag_atke_lmix)
 
-    if (iflag_atke == 0 .and. iflag_atke_lmix>0) THEN
+    IF (iflag_atke == 0 .AND. iflag_atke_lmix>0) THEN
       CALL abort_physic("atke_turbulence_ini", &
               'stationary scheme must use mixing length formulation not depending on tke', 1)
@@ -121,5 +121,5 @@
     CALL getin_p('atke_cinffac', cinffac)
     cinf = cinffac * cn
-    if (cinf <= cn) THEN
+    IF (cinf <= cn) THEN
       CALL abort_physic("atke_turbulence_ini", &
               'cinf cannot be lower than cn', 1)
@@ -134,5 +134,5 @@
     pr_slope = 5.0 ! default value from Zilitinkevich et al. 2005
     CALL getin_p('atke_pr_slope', pr_slope)
-    if (pr_slope <= 1) THEN
+    IF (pr_slope <= 1) THEN
       CALL abort_physic("atke_turbulence_ini", &
               'pr_slope has to be greater than 1 for consistency of the tke scheme', 1)
@@ -146,5 +146,5 @@
     pr_asym = 0.4
     CALL getin_p('atke_pr_asym', pr_asym)
-    if (pr_asym >= pr_neut) THEN
+    IF (pr_asym >= pr_neut) THEN
       CALL abort_physic("atke_turbulence_ini", &
               'pr_asym must be be lower than pr_neut', 1)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_blowing_snow_ini.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_blowing_snow_ini.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_blowing_snow_ini.F90	(revision 5117)
@@ -3,8 +3,8 @@
 IMPLICIT NONE
 
-   real, save, protected :: RCPD, RV, RLSTT, RLVTT, RLMLT, RVTMP2, RTT,RD,RG, RPI
-   real, save, protected :: coef_sub_bs, fallv_bs, zeta_bs, c_esalt_bs
-   real, save, protected :: prt_bs, pbst_bs, qbst_bs, r_bs
-   integer, save, protected :: iflag_saltation_bs, iflag_sedim_bs, iflag_sublim_bs
+   REAL, SAVE, protected :: RCPD, RV, RLSTT, RLVTT, RLMLT, RVTMP2, RTT,RD,RG, RPI
+   REAL, SAVE, protected :: coef_sub_bs, fallv_bs, zeta_bs, c_esalt_bs
+   REAL, SAVE, protected :: prt_bs, pbst_bs, qbst_bs, r_bs
+   INTEGER, SAVE, protected :: iflag_saltation_bs, iflag_sedim_bs, iflag_sublim_bs
 
    !$OMP THREADPRIVATE(RCPD, RV, RLSTT, RLVTT, RLMLT, RVTMP2, RTT,RD,RG, RPI)
@@ -13,17 +13,17 @@
    !$OMP THREADPRIVATE(iflag_sedim_bs, iflag_sublim_bs)
 
-   real, save, protected :: tbsmelt=278.15    ! parameter to calculate melting fraction of BS sedimentation
-   real, save, protected :: taumeltbs0=600.0  ! Melting time scale of blowing snow at 273.15K
-   real, save, protected :: qbmin=1.E-10      ! Minimum blowing snow specific content
+   REAL, SAVE, protected :: tbsmelt=278.15    ! parameter to calculate melting fraction of BS sedimentation
+   REAL, SAVE, protected :: taumeltbs0=600.0  ! Melting time scale of blowing snow at 273.15K
+   REAL, SAVE, protected :: qbmin=1.E-10      ! Minimum blowing snow specific content
    !$OMP THREADPRIVATE(tbsmelt, taumeltbs0, qbmin)
 
-   real, save, protected :: tau_dens0_bs=864000.      ! 10 days by default, in s
-   real, save, protected :: tau_densmin_bs= 21600.    ! 1/4 days according to in situ obs by C. Amory during blowing snow +
+   REAL, SAVE, protected :: tau_dens0_bs=864000.      ! 10 days by default, in s
+   REAL, SAVE, protected :: tau_densmin_bs= 21600.    ! 1/4 days according to in situ obs by C. Amory during blowing snow +
                                                       ! Marshall et al. 1999 (snow densification during rain)
-   real, save, protected :: tau_eqsalt_bs= 10.        ! Nemoto and Nishimura 2004 show that steady-state saltation is achieved within a time tau_eqsalt of about 10s
-   real, save, protected :: rhofresh_bs = 300.0       ! fresh snow density kg/m3
-   real, save, protected :: rhohard_bs = 450.0       ! hard snow density kg/m3
-   real, save, protected :: rhoice_bs = 920.0         ! ice density kg/m3
-   real, save, protected :: rhobs=900.0               ! blowing snow density (kg/m3) following Bintanja et al. 2001 part I
+   REAL, SAVE, protected :: tau_eqsalt_bs= 10.        ! Nemoto and Nishimura 2004 show that steady-state saltation is achieved within a time tau_eqsalt of about 10s
+   REAL, SAVE, protected :: rhofresh_bs = 300.0       ! fresh snow density kg/m3
+   REAL, SAVE, protected :: rhohard_bs = 450.0       ! hard snow density kg/m3
+   REAL, SAVE, protected :: rhoice_bs = 920.0         ! ice density kg/m3
+   REAL, SAVE, protected :: rhobs=900.0               ! blowing snow density (kg/m3) following Bintanja et al. 2001 part I
    !$OMP THREADPRIVATE(rhoice_bs, rhofresh_bs, rhohard_bs, tau_dens0_bs, tau_densmin_bs, tau_eqsalt_bs, rhobs)
 
@@ -36,6 +36,6 @@
          USE lmdz_ioipsl_getin_p, ONLY: getin_p
 
-         real, intent(in) :: RCPD_in, RLSTT_in, RLVTT_in, RLMLT_in, RPI_in
-         real, intent(in) ::  RVTMP2_in, RTT_in, RD_in, RG_in, RV_in
+         REAL, INTENT(IN) :: RCPD_in, RLSTT_in, RLVTT_in, RLMLT_in, RPI_in
+         REAL, INTENT(IN) ::  RVTMP2_in, RTT_in, RD_in, RG_in, RV_in
 
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_blowing_snow_sublim_sedim.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_blowing_snow_sublim_sedim.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_blowing_snow_sublim_sedim.F90	(revision 5117)
@@ -11,6 +11,6 @@
 
 
-use lmdz_blowing_snow_ini, ONLY: iflag_sublim_bs, iflag_sedim_bs, coef_sub_bs,RTT,RD,RG,fallv_bs
-use lmdz_blowing_snow_ini, ONLY: qbmin, RCPD, RLSTT, RLMLT, RLVTT, RVTMP2, RV, RPI, tbsmelt, taumeltbs0, rhobs, r_bs
+USE lmdz_blowing_snow_ini, ONLY: iflag_sublim_bs, iflag_sedim_bs, coef_sub_bs,RTT,RD,RG,fallv_bs
+USE lmdz_blowing_snow_ini, ONLY: qbmin, RCPD, RLSTT, RLMLT, RLVTT, RVTMP2, RV, RPI, tbsmelt, taumeltbs0, rhobs, r_bs
 USE lmdz_lscp_tools, ONLY: calc_qsat_ecmwf
 
@@ -25,11 +25,11 @@
 !=====
 
-integer, intent(in)                     :: ngrid,nlay
-real, intent(in)                        :: dtime
-real, intent(in), dimension(ngrid,nlay) :: temp
-real, intent(in), dimension(ngrid,nlay) :: qv
-real, intent(in), dimension(ngrid,nlay) :: qb
-real, intent(in), dimension(ngrid,nlay) :: pplay
-real, intent(in), dimension(ngrid,nlay+1) :: paprs
+INTEGER, INTENT(IN)                     :: ngrid,nlay
+REAL, INTENT(IN)                        :: dtime
+REAL, INTENT(IN), DIMENSION(ngrid,nlay) :: temp
+REAL, INTENT(IN), DIMENSION(ngrid,nlay) :: qv
+REAL, INTENT(IN), DIMENSION(ngrid,nlay) :: qb
+REAL, INTENT(IN), DIMENSION(ngrid,nlay) :: pplay
+REAL, INTENT(IN), DIMENSION(ngrid,nlay+1) :: paprs
 
 
@@ -39,9 +39,9 @@
 
 
-real, intent(out), dimension(ngrid,nlay) :: dtemp_bs
-real, intent(out), dimension(ngrid,nlay) :: dqv_bs
-real, intent(out), dimension(ngrid,nlay) :: dqb_bs
-real, intent(out), dimension(ngrid,nlay+1) :: bsfl
-real, intent(out), dimension(ngrid)      :: precip_bs
+REAL, INTENT(OUT), DIMENSION(ngrid,nlay) :: dtemp_bs
+REAL, INTENT(OUT), DIMENSION(ngrid,nlay) :: dqv_bs
+REAL, INTENT(OUT), DIMENSION(ngrid,nlay) :: dqb_bs
+REAL, INTENT(OUT), DIMENSION(ngrid,nlay+1) :: bsfl
+REAL, INTENT(OUT), DIMENSION(ngrid)      :: precip_bs
 
 
@@ -50,5 +50,5 @@
 
 
-integer                                  :: k,i,n
+INTEGER                                  :: k,i,n
 real                                     :: cpd, cpw, dqbsub, maxdqbsub, dqbmelt, zmair
 real                                     :: dqsedim,precbs, dqvmelt, zmelt, taumeltbs
@@ -56,7 +56,7 @@
 real                                     :: delta_p, b_p, a_p, c_p, c_sub, qvsub
 real                                     :: p0, T0, Dv, Aprime, Bprime, Ka
-real, dimension(ngrid)                   :: ztemp,zqv,zqb,zpres,qsi,dqsi,qsl,dqsl,qzero,sedim
-real, dimension(ngrid)                   :: zpaprsup, zpaprsdn, ztemp_up, zqb_up, zvelo
-real, dimension(ngrid,nlay)              :: temp_seri, qb_seri, qv_seri
+REAL, DIMENSION(ngrid)                   :: ztemp,zqv,zqb,zpres,qsi,dqsi,qsl,dqsl,qzero,sedim
+REAL, DIMENSION(ngrid)                   :: zpaprsup, zpaprsdn, ztemp_up, zqb_up, zvelo
+REAL, DIMENSION(ngrid,nlay)              :: temp_seri, qb_seri, qv_seri
 
 !++++++++++++++++++++++++++++++++++++++++++++++++++
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_call_atke.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_call_atke.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_call_atke.F90	(revision 5117)
@@ -118,8 +118,8 @@
 
 
-integer i,k
-real ml,F1,rho
-real, dimension(ngrid) :: play1,temp1
-real, dimension(ngrid,nlay+1) :: K_big
+INTEGER i,k
+REAL ml,F1,rho
+REAL, DIMENSION(ngrid) :: play1,temp1
+REAL, DIMENSION(ngrid,nlay+1) :: K_big
 
 ! computation of K_big
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_call_blowing_snow.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_call_blowing_snow.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_call_blowing_snow.F90	(revision 5117)
@@ -6,5 +6,5 @@
                                   dtemp_bs,dq_bs,dqbs_bs,bsfl,precip_bs)
 
-use lmdz_blowing_snow_sublim_sedim, ONLY: blowing_snow_sublim_sedim
+USE lmdz_blowing_snow_sublim_sedim, ONLY: blowing_snow_sublim_sedim
 IMPLICIT NONE
 
@@ -12,11 +12,11 @@
 !=====
 
-integer, intent(in)                     :: ngrid,nlay
-real, intent(in)                        :: dtime
-real, intent(in), dimension(ngrid,nlay) :: temp
-real, intent(in), dimension(ngrid,nlay) :: q
-real, intent(in), dimension(ngrid,nlay) :: qbs
-real, intent(in), dimension(ngrid,nlay) :: pplay
-real, intent(in), dimension(ngrid,nlay+1) :: paprs
+INTEGER, INTENT(IN)                     :: ngrid,nlay
+REAL, INTENT(IN)                        :: dtime
+REAL, INTENT(IN), DIMENSION(ngrid,nlay) :: temp
+REAL, INTENT(IN), DIMENSION(ngrid,nlay) :: q
+REAL, INTENT(IN), DIMENSION(ngrid,nlay) :: qbs
+REAL, INTENT(IN), DIMENSION(ngrid,nlay) :: pplay
+REAL, INTENT(IN), DIMENSION(ngrid,nlay+1) :: paprs
 
 
@@ -25,9 +25,9 @@
 
 
-real, intent(out), dimension(ngrid,nlay) :: dtemp_bs
-real, intent(out), dimension(ngrid,nlay) :: dq_bs
-real, intent(out), dimension(ngrid,nlay) :: dqbs_bs
-real, intent(out), dimension(ngrid,nlay+1) :: bsfl
-real, intent(out), dimension(ngrid)      :: precip_bs
+REAL, INTENT(OUT), DIMENSION(ngrid,nlay) :: dtemp_bs
+REAL, INTENT(OUT), DIMENSION(ngrid,nlay) :: dq_bs
+REAL, INTENT(OUT), DIMENSION(ngrid,nlay) :: dqbs_bs
+REAL, INTENT(OUT), DIMENSION(ngrid,nlay+1) :: bsfl
+REAL, INTENT(OUT), DIMENSION(ngrid)      :: precip_bs
 
       
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloudth.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloudth.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloudth.F90	(revision 5117)
@@ -13,5 +13,5 @@
 
 
-      use lmdz_cloudth_ini, ONLY: iflag_cloudth_vert,iflag_ratqs
+      USE lmdz_cloudth_ini, ONLY: iflag_cloudth_vert,iflag_ratqs
 
       IMPLICIT NONE
@@ -31,5 +31,5 @@
       INTEGER itap,ind1,ind2
       INTEGER ngrid,klev,klon,l,ig 
-      real, dimension(ngrid,klev), intent(out) :: cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
+      REAL, DIMENSION(ngrid,klev), INTENT(OUT) :: cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
       
       REAL ztv(ngrid,klev)
@@ -117,5 +117,5 @@
       do ind1=1,ngrid
 
-      if ((ztv(ind1,1)>ztv(ind1,2)).and.(fraca(ind1,ind2)>1.e-10)) THEN
+      IF ((ztv(ind1,1)>ztv(ind1,2)).AND.(fraca(ind1,ind2)>1.e-10)) THEN
       zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2))
 
@@ -185,5 +185,5 @@
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      if (ctot(ind1,ind2)<1.e-10) THEN
+      IF (ctot(ind1,ind2)<1.e-10) THEN
       ctot(ind1,ind2)=0.
       qcloud(ind1)=zqsatenv(ind1,ind2) 
@@ -226,5 +226,5 @@
       qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
       
-      if (ctot(ind1,ind2)<1.e-3) THEN
+      IF (ctot(ind1,ind2)<1.e-3) THEN
       ctot(ind1,ind2)=0.
       qcloud(ind1)=zqsatenv(ind1,ind2) 
@@ -264,5 +264,5 @@
 
 
-      use lmdz_cloudth_ini, ONLY: iflag_cloudth_vert, vert_alpha
+      USE lmdz_cloudth_ini, ONLY: iflag_cloudth_vert, vert_alpha
 
       IMPLICIT NONE
@@ -346,5 +346,5 @@
       do ind1=1,ngrid
 
-      if ((ztv(ind1,1)>ztv(ind1,2)).and.(fraca(ind1,ind2)>1.e-10)) THEN
+      IF ((ztv(ind1,1)>ztv(ind1,2)).AND.(fraca(ind1,ind2)>1.e-10)) THEN
       zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2))
 
@@ -508,5 +508,5 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-      if (cenv(ind1,ind2)<1.e-10.or.cth(ind1,ind2)<1.e-10) THEN
+      IF (cenv(ind1,ind2)<1.e-10.OR.cth(ind1,ind2)<1.e-10) THEN
       ctot(ind1,ind2)=0.
       qcloud(ind1)=zqsatenv(ind1,ind2) 
@@ -552,5 +552,5 @@
       qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
       
-      if (ctot(ind1,ind2)<1.e-3) THEN
+      IF (ctot(ind1,ind2)<1.e-3) THEN
       ctot(ind1,ind2)=0.
       qcloud(ind1)=zqsatenv(ind1,ind2) 
@@ -584,5 +584,5 @@
              cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
 
-      use lmdz_cloudth_ini, ONLY: iflag_cloudth_vert
+      USE lmdz_cloudth_ini, ONLY: iflag_cloudth_vert
 
       IMPLICIT NONE
@@ -600,23 +600,23 @@
       INCLUDE "FCTTRE.h"
 
-      integer, intent(in) :: ind2
-      integer, intent(in) :: ngrid,klev
-      
-      real, dimension(ngrid,klev), intent(in) :: ztv
-      real, dimension(ngrid), intent(in) :: po
-      real, dimension(ngrid,klev), intent(in) :: zqta
-      real, dimension(ngrid,klev+1), intent(in) :: fraca
-      real, dimension(ngrid), intent(out) :: qcloud
-      real, dimension(ngrid,klev), intent(out) :: ctot
-      real, dimension(ngrid,klev), intent(out) :: ctot_vol
-      real, dimension(ngrid,klev), intent(in) :: zpspsk
-      real, dimension(ngrid,klev+1), intent(in) :: paprs
-      real, dimension(ngrid,klev), intent(in) :: pplay
-      real, dimension(ngrid,klev), intent(in) :: ztla
-      real, dimension(ngrid,klev), intent(inout) :: zthl
-      real, dimension(ngrid,klev), intent(in) :: ratqs
-      real, dimension(ngrid), intent(in) :: zqs
-      real, dimension(ngrid,klev), intent(in) :: t
-      real, dimension(ngrid,klev), intent(out) :: cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
+      INTEGER, INTENT(IN) :: ind2
+      INTEGER, INTENT(IN) :: ngrid,klev
+      
+      REAL, DIMENSION(ngrid,klev), INTENT(IN) :: ztv
+      REAL, DIMENSION(ngrid), INTENT(IN) :: po
+      REAL, DIMENSION(ngrid,klev), INTENT(IN) :: zqta
+      REAL, DIMENSION(ngrid,klev+1), INTENT(IN) :: fraca
+      REAL, DIMENSION(ngrid), INTENT(OUT) :: qcloud
+      REAL, DIMENSION(ngrid,klev), INTENT(OUT) :: ctot
+      REAL, DIMENSION(ngrid,klev), INTENT(OUT) :: ctot_vol
+      REAL, DIMENSION(ngrid,klev), INTENT(IN) :: zpspsk
+      REAL, DIMENSION(ngrid,klev+1), INTENT(IN) :: paprs
+      REAL, DIMENSION(ngrid,klev), INTENT(IN) :: pplay
+      REAL, DIMENSION(ngrid,klev), INTENT(IN) :: ztla
+      REAL, DIMENSION(ngrid,klev), INTENT(INOUT) :: zthl
+      REAL, DIMENSION(ngrid,klev), INTENT(IN) :: ratqs
+      REAL, DIMENSION(ngrid), INTENT(IN) :: zqs
+      REAL, DIMENSION(ngrid,klev), INTENT(IN) :: t
+      REAL, DIMENSION(ngrid,klev), INTENT(OUT) :: cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
 
 
@@ -692,5 +692,5 @@
       do ind1=1,ngrid
 
-      if ((ztv(ind1,1)>ztv(ind1,2)).and.(fraca(ind1,ind2)>1.e-10)) THEN
+      IF ((ztv(ind1,1)>ztv(ind1,2)).AND.(fraca(ind1,ind2)>1.e-10)) THEN
       zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2))
 
@@ -756,5 +756,5 @@
       qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
 
-      if (ctot(ind1,ind2)<1.e-10) THEN
+      IF (ctot(ind1,ind2)<1.e-10) THEN
       ctot(ind1,ind2)=0.
       qcloud(ind1)=zqsatenv(ind1,ind2) 
@@ -787,5 +787,5 @@
       qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt2*cenv(ind1,ind2))
 
-      if (ctot(ind1,ind2)<1.e-3) THEN
+      IF (ctot(ind1,ind2)<1.e-3) THEN
       ctot(ind1,ind2)=0.
       qcloud(ind1)=zqsatenv(ind1,ind2)
@@ -816,6 +816,6 @@
 !===========================================================================
 
-      use lmdz_cloudth_ini, ONLY: iflag_cloudth_vert,iflag_ratqs
-      use lmdz_cloudth_ini, ONLY: vert_alpha,vert_alpha_th, sigma1s_factor, sigma1s_power , sigma2s_factor , sigma2s_power , cloudth_ratqsmin , iflag_cloudth_vert_noratqs
+      USE lmdz_cloudth_ini, ONLY: iflag_cloudth_vert,iflag_ratqs
+      USE lmdz_cloudth_ini, ONLY: vert_alpha,vert_alpha_th, sigma1s_factor, sigma1s_power , sigma2s_factor , sigma2s_power , cloudth_ratqsmin , iflag_cloudth_vert_noratqs
 
       IMPLICIT NONE
@@ -829,5 +829,5 @@
       INTEGER itap,ind1,ind2
       INTEGER ngrid,klev,klon,l,ig 
-      real, dimension(ngrid,klev), intent(out) :: cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
+      REAL, DIMENSION(ngrid,klev), INTENT(OUT) :: cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
       
       REAL ztv(ngrid,klev)
@@ -923,5 +923,5 @@
       do ind1=1,ngrid
 
-      if ((ztv(ind1,1)>ztv(ind1,2)).and.(fraca(ind1,ind2)>1.e-10)) then !Thermal and environnement
+      IF ((ztv(ind1,1)>ztv(ind1,2)).AND.(fraca(ind1,ind2)>1.e-10)) then !Thermal and environnement
 
       zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2)) !qt = a*qtth + (1-a)*qtenv
@@ -1070,5 +1070,5 @@
       IntJ=0.5*senv*(1-erf(xenv2))+(sigma1s/sqrt2pi)*exp_xenv2
       IntJ_CF=0.5*(1.-1.*erf(xenv2))
-      if (deltasenv < 1.e-10) THEN
+      IF (deltasenv < 1.e-10) THEN
       qlenv(ind1,ind2)=IntJ
       cenv_vol(ind1,ind2)=IntJ_CF
@@ -1086,5 +1086,5 @@
       IntJ=0.5*sth*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp_xth2
       IntJ_CF=0.5*(1.-1.*erf(xth2))
-      if (deltasth < 1.e-10) THEN
+      IF (deltasth < 1.e-10) THEN
       qlth(ind1,ind2)=IntJ
       cth_vol(ind1,ind2)=IntJ_CF
@@ -1155,5 +1155,5 @@
 
 !      if (ctot(ind1,ind2).lt.1.e-10) THEN
-      if (cenv(ind1,ind2)<1.e-10.or.cth(ind1,ind2)<1.e-10) THEN
+      IF (cenv(ind1,ind2)<1.e-10.OR.cth(ind1,ind2)<1.e-10) THEN
       ctot(ind1,ind2)=0.
       ctot_vol(ind1,ind2)=0.
@@ -1198,5 +1198,5 @@
       qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
       
-      if (ctot(ind1,ind2)<1.e-3) THEN
+      IF (ctot(ind1,ind2)<1.e-3) THEN
       ctot(ind1,ind2)=0.
       qcloud(ind1)=zqsatenv(ind1,ind2)
@@ -1230,5 +1230,5 @@
              cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
 
-      use lmdz_cloudth_ini, ONLY: iflag_cloudth_vert
+      USE lmdz_cloudth_ini, ONLY: iflag_cloudth_vert
 
       IMPLICIT NONE
@@ -1243,5 +1243,5 @@
       INTEGER ngrid !indice Max lat-lon
       INTEGER klev  !indice Max alt
-      real, dimension(ngrid,klev), intent(out) :: cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
+      REAL, DIMENSION(ngrid,klev), INTENT(OUT) :: cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
       INTEGER ind1  !indice in [1:ngrid]
       INTEGER ind2  !indice in [1:klev]
@@ -1324,5 +1324,5 @@
 !Both thermal and environment in the gridbox
 !-------------------------------------------------------------------------------
-      IF ((ztv(ind1,1)>ztv(ind1,2)).and.(fraca(ind1,ind2)>1.e-10)) THEN
+      IF ((ztv(ind1,1)>ztv(ind1,2)).AND.(fraca(ind1,ind2)>1.e-10)) THEN
         !--------------------------------------------
         !calcul de qsat_env
@@ -1395,5 +1395,5 @@
         !Incloud Condensed water qcloud
         !--------------------------------------------
-      if (ctot_surf(ind1,ind2) < 1.e-10) THEN
+      IF (ctot_surf(ind1,ind2) < 1.e-10) THEN
       ctot_vol(ind1,ind2)=0.
       ctot_surf(ind1,ind2)=0.
@@ -1456,5 +1456,5 @@
         !Incloud Condensed water qcloud
         !--------------------------------------------
-      if (ctot_surf(ind1,ind2) < 1.e-8) THEN
+      IF (ctot_surf(ind1,ind2) < 1.e-8) THEN
       ctot_vol(ind1,ind2)=0.
       ctot_surf(ind1,ind2)=0.
@@ -1494,8 +1494,8 @@
 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
-      use lmdz_cloudth_ini, ONLY: iflag_cloudth_vert,iflag_ratqs
-      use lmdz_cloudth_ini, ONLY: C_mpc ,Ni,C_cap,Ei,d_top ,vert_alpha, vert_alpha_th ,sigma1s_factor,sigma1s_power,sigma2s_factor,sigma2s_power,cloudth_ratqsmin ,iflag_cloudth_vert_noratqs
-      use lmdz_lscp_tools,  only: CALC_QSAT_ECMWF
-      use lmdz_lscp_ini,    only: RTT, RG, RPI, RD, RCPD, RLVTT, RLSTT, temp_nowater, min_frac_th_cld, min_neb_th
+      USE lmdz_cloudth_ini, ONLY: iflag_cloudth_vert,iflag_ratqs
+      USE lmdz_cloudth_ini, ONLY: C_mpc ,Ni,C_cap,Ei,d_top ,vert_alpha, vert_alpha_th ,sigma1s_factor,sigma1s_power,sigma2s_factor,sigma2s_power,cloudth_ratqsmin ,iflag_cloudth_vert_noratqs
+      USE lmdz_lscp_tools,  only: CALC_QSAT_ECMWF
+      USE lmdz_lscp_ini,    only: RTT, RG, RPI, RD, RCPD, RLVTT, RLSTT, temp_nowater, min_frac_th_cld, min_neb_th
 
       IMPLICIT NONE
@@ -1763,5 +1763,5 @@
             ctot_vol(ind1)=frac_th(ind1)*cth_vol(ind1)+(1.-1.*frac_th(ind1))*cenv_vol(ind1)
 
-            IF (cenv(ind1)<min_neb_th.and.cth(ind1)<min_neb_th) THEN
+            IF (cenv(ind1)<min_neb_th.AND.cth(ind1)<min_neb_th) THEN
                 ctot(ind1)=0.
                 ctot_vol(ind1)=0.
@@ -1992,8 +1992,8 @@
 
 !            sigma1s = sigma1s_fraca + sigma1s_ratqs
-!            IF (iflag_ratqs.eq.11) THEN
+!            IF (iflag_ratqs.EQ.11) THEN
 !               sigma1s = ratqs(ind1,ind2)*po(ind1)*aenv
 !            ENDIF
-!            IF (iflag_ratqs.eq.11) THEN
+!            IF (iflag_ratqs.EQ.11) THEN
 !              sigma1s = ratqs(ind1,ind2)*po(ind1)*aenvl
 !            ENDIF
@@ -2043,5 +2043,5 @@
 !            ENDIF
 
-!            IF (cenv(ind1,ind2).LT.1.e-10.or.cth(ind1,ind2).LT.1.e-10) THEN
+!            IF (cenv(ind1,ind2).LT.1.e-10.OR.cth(ind1,ind2).LT.1.e-10) THEN
 !                ctot(ind1,ind2)=0.
 !                ctot_vol(ind1,ind2)=0.
@@ -2120,5 +2120,5 @@
 !=============================================================================
 
-    use phys_state_var_mod, ONLY: fm_therm, detr_therm, entr_therm
+    USE phys_state_var_mod, ONLY: fm_therm, detr_therm, entr_therm
 
     IMPLICIT none
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloudth_ini.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloudth_ini.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloudth_ini.F90	(revision 5117)
@@ -1,6 +1,6 @@
 module lmdz_cloudth_ini
 
-real, save, protected :: C_cap ,cloudth_ratqsmin ,sigma1s_factor ,sigma1s_power ,sigma2s_factor ,sigma2s_power ,vert_alpha_th ,vert_alpha ,C_mpc , d_top , Ei , Ni
-integer, save, protected :: iflag_cloudth_vert_noratqs,iflag_cloudth_vert,iflag_ratqs
+REAL, SAVE, protected :: C_cap ,cloudth_ratqsmin ,sigma1s_factor ,sigma1s_power ,sigma2s_factor ,sigma2s_power ,vert_alpha_th ,vert_alpha ,C_mpc , d_top , Ei , Ni
+INTEGER, SAVE, protected :: iflag_cloudth_vert_noratqs,iflag_cloudth_vert,iflag_ratqs
 
 !$OMP THREADPRIVATE(C_cap ,cloudth_ratqsmin ,sigma1s_factor ,sigma1s_power ,sigma2s_factor ,sigma2s_power ,vert_alpha_th ,vert_alpha ,C_mpc , d_top , Ei , Ni)
@@ -12,7 +12,7 @@
 SUBROUTINE cloudth_ini(iflag_cloudth_vert_in,iflag_ratqs_in)
 
-use lmdz_ioipsl_getin_p, ONLY: getin_p
+USE lmdz_ioipsl_getin_p, ONLY: getin_p
 IMPLICIT NONE
-integer, intent(in) :: iflag_cloudth_vert_in,iflag_ratqs_in
+INTEGER, INTENT(IN) :: iflag_cloudth_vert_in,iflag_ratqs_in
 
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp.F90	(revision 5117)
@@ -432,5 +432,5 @@
         zt(i) = temp(i, k)
         zq(i) = qt(i, k)
-        IF (.not. iftop) THEN
+        IF (.NOT. iftop) THEN
           ztupnew(i) = temp(i, k + 1) + d_t(i, k + 1)
           zqupnew(i) = qt(i, k + 1) + d_q(i, k + 1) + d_ql(i, k + 1) + d_qi(i, k + 1)
@@ -889,5 +889,5 @@
                       Tcontr(i, k), qcontr(i, k), qcontr2(i, k), fcontrN(i, k), fcontrP(i, k))
 
-            ENDIF ! ((flag_ice_sursat.eq.0).or.(Tbef(i).gt.t_glace_min))
+            ENDIF ! ((flag_ice_sursat.EQ.0).OR.(Tbef(i).gt.t_glace_min))
 
             ! If vertical heterogeneity, change fraction by volume as well
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_ini.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_ini.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_ini.F90	(revision 5117)
@@ -262,6 +262,6 @@
    REAL, INTENT(IN)      :: RCPD_in, RLSTT_in, RLVTT_in, RLMLT_in
    REAL, INTENT(IN)      ::  RVTMP2_in, RTT_in, RD_in, RG_in, RV_in, RPI_in
-   character (len=20) :: modname='lscp_ini_mod'
-   character (len=80) :: abort_message
+   CHARACTER (LEN=20) :: modname='lscp_ini_mod'
+   CHARACTER (LEN=80) :: abort_message
 
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_old.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_old.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_old.F90	(revision 5117)
@@ -213,5 +213,5 @@
   rneblsvol(1:klon,1:klev)=0.0
 
-  if (prt_level>9)WRITE(lunout,*)'NUAGES4 A. JAM'
+  IF (prt_level>9)WRITE(lunout,*)'NUAGES4 A. JAM'
   IF (appel1er) THEN
      WRITE(lunout,*) 'fisrtilp, ninter:', ninter
@@ -354,5 +354,5 @@
            zcpair=RCPD*(1.0+RVTMP2*zq(i))
            zcpeau=RCPD*RVTMP2
-         if (fl_cor_ebil > 0) THEN
+         IF (fl_cor_ebil > 0) THEN
            ! zmqc: masse de precip qui doit etre thermalisee avec l'air de la couche atm 
            ! pour s'assurer que la precip arrivant au sol aura bien la temperature de la 
@@ -420,5 +420,5 @@
              ! Ajout de la prise en compte des precip a thermiser
              ! avec petite reecriture 
-             if  (fl_cor_ebil > 0) then ! nouveau
+             IF  (fl_cor_ebil > 0) then ! nouveau
                 ! Calcul de l'evaporation du flux de precip herite
                 !   d'au-dessus
@@ -432,5 +432,5 @@
                 zrfln(i) = zrfl(i) - zqev*zmair(i)/dtime
                 ! Aucun flux liquide pour T < t_coup, on reevapore tout.
-                IF (zt(i) < t_coup.and.reevap_ice) THEN
+                IF (zt(i) < t_coup.AND.reevap_ice) THEN
                   zrfln(i)=0.
                   zqev = (zrfl(i)-zrfln(i))/zmair(i)*dtime
@@ -456,5 +456,5 @@
                      /RG/dtime
                 ! Aucun flux liquide pour T < t_coup
-                IF (zt(i) < t_coup.and.reevap_ice) zrfln(i)=0.
+                IF (zt(i) < t_coup.AND.reevap_ice) zrfln(i)=0.
                 ! Nouvelle vapeur 
                 zq(i) = zq(i) - (zrfln(i)-zrfl(i)) &
@@ -596,5 +596,5 @@
          zq(i) = zq(i) - (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
                   * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-       if (fl_cor_ebil > 0) then ! avec correction thermalisation des precips
+       IF (fl_cor_ebil > 0) then ! avec correction thermalisation des precips
          zmqc(i) = zmqc(i) + (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
                   * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
@@ -647,5 +647,5 @@
                    zrfl(i)=zrfl(i)+zmelt*zifl(i)
            ENDIF
-           if (fl_cor_ebil <= 0) THEN
+           IF (fl_cor_ebil <= 0) THEN
              ! the following line should not be here. Indeed, if zifl is modified
              ! now, zifl(i)*zmelt is no more the amount of ice that has melt
@@ -654,5 +654,5 @@
            end if
            ! Chaleur latente de fusion
-        if (fl_cor_ebil > 0) then ! avec correction thermalisation des precips
+        IF (fl_cor_ebil > 0) then ! avec correction thermalisation des precips
            zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
                       *RLMLT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
@@ -661,5 +661,5 @@
                       *RLMLT/RCPD/(1.0+RVTMP2*zq(i))
         end if
-           if (fl_cor_ebil > 0) then ! correction bug, deplacement ligne precedente
+           IF (fl_cor_ebil > 0) then ! correction bug, deplacement ligne precedente
 !<LTP
              IF (iflag_evap_prec==4) THEN
@@ -693,5 +693,5 @@
            zdelta = MAX(0.,SIGN(1.,RTT-zt(i)))
            zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-       if  (fl_cor_ebil > 0) then ! nouveau
+       IF  (fl_cor_ebil > 0) then ! nouveau
            zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
        else    
@@ -722,5 +722,5 @@
 
 !verification de la valeur de iflag_fisrtilp_qsat pour iflag_ice_thermo=1
-!       if ((iflag_ice_thermo.eq.1).and.(iflag_fisrtilp_qsat.ne.0)) THEN
+!       if ((iflag_ice_thermo.EQ.1).AND.(iflag_fisrtilp_qsat.NE.0)) THEN
 !         WRITE(*,*) " iflag_ice_thermo==1 requires iflag_fisrtilp_qsat==0", &
 !        " but iflag_fisrtilp_qsat=",iflag_fisrtilp_qsat, ". Might as well stop here."
@@ -756,5 +756,5 @@
         ! P2.A.0> Calcul des grandeurs nuageuses une pdf en creneau
         ! ----------------------------------------------------------------
-        if (iflag_pdf==0) THEN
+        IF (iflag_pdf==0) THEN
            ! version creneau de (Li, 1998)
            do i=1,klon
@@ -764,5 +764,5 @@
            enddo
 
-        else !  if (iflag_pdf.eq.0)
+        else !  if (iflag_pdf.EQ.0)
            ! ----------------------------------------------------------------
            ! P2.A.1> Avec les nouvelles PDFs, calcul des grandeurs nuageuses pour 
@@ -776,6 +776,6 @@
            enddo
 
-           if (iflag_cld_th>=5) THEN
-              if (iflag_cloudth_vert<=2) THEN
+           IF (iflag_cld_th>=5) THEN
+              IF (iflag_cloudth_vert<=2) THEN
                CALL cloudth(klon,klev,k,ztv, &
                    zq,zqta,fraca, &
@@ -784,5 +784,5 @@
                    cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
 
-              elseif (iflag_cloudth_vert>=3 .and. iflag_cloudth_vert<=5) THEN
+              elseif (iflag_cloudth_vert>=3 .AND. iflag_cloudth_vert<=5) THEN
                CALL cloudth_v3(klon,klev,k,ztv, &
                    zq,zqta,fraca, &
@@ -809,5 +809,5 @@
            endif
 
-           if (iflag_cld_th <= 4) THEN
+           IF (iflag_cld_th <= 4) THEN
               lognormale = .TRUE.
            elseif (iflag_cld_th >= 6) THEN
@@ -844,5 +844,5 @@
 
 !Boucle iterative: ATTENTION, l'option -1 n'est plus activable ici
-           if (iflag_fisrtilp_qsat>=0) THEN
+           IF (iflag_fisrtilp_qsat>=0) THEN
              ! Iteration pour condensation avec variation de qsat(T) 
              ! -----------------------------------------------------
@@ -850,9 +850,9 @@
                 
                do i=1,klon
-!                 do while ((abs(DT(i)).gt.DDT0).or.(n_i(i).eq.0))
+!                 do while ((abs(DT(i)).gt.DDT0).OR.(n_i(i).EQ.0))
                  ! !! convergence = .TRUE. tant que l'on n'a pas converge !!
                  ! ------------------------------
                  convergence(i)=abs(DT(i))>DDT0
-                 if ((convergence(i).or.(n_i(i)==0)).and.lognormale(i)) THEN
+                 IF ((convergence(i).OR.(n_i(i)==0)).AND.lognormale(i)) THEN
                  ! si on n'a pas converge
 
@@ -866,11 +866,11 @@
 
                  Tbef(i)=Tbef(i)+DT(i) ! nouvelle temperature
-                 if (.not.ice_thermo) THEN
+                 IF (.NOT.ice_thermo) THEN
                     zdelta = MAX(0.,SIGN(1.,RTT-Tbef(i)))
                  else
-                    if (iflag_t_glace==0) THEN
+                    IF (iflag_t_glace==0) THEN
                     zdelta = MAX(0.,SIGN(1.,t_glace_min_old-Tbef(i)))
-                    else if (iflag_t_glace>=1) THEN
-                       if (iflag_oldbug_fisrtilp==0) THEN
+                    ELSE IF (iflag_t_glace>=1) THEN
+                       IF (iflag_oldbug_fisrtilp==0) THEN
                           zdelta = MAX(0.,SIGN(1.,t_glace_max-Tbef(i)))
                        else
@@ -882,5 +882,5 @@
                  ! Calcul de rneb, qzn et zcond pour les PDF lognormales
                  zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-               if (fl_cor_ebil > 0) THEN
+               IF (fl_cor_ebil > 0) THEN
                  zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
                else
@@ -904,5 +904,5 @@
                  zpdf_e2(i)=1.-erf(zpdf_e2(i))
              
-                 if (zpdf_e1(i)<1.e-10) THEN
+                 IF (zpdf_e1(i)<1.e-10) THEN
                     rneb(i,k)=0.
                     zqn(i)=zqs(i)
@@ -913,5 +913,5 @@
 
                  ! If vertical heterogeneity, change fraction by volume as well
-                 if (iflag_cloudth_vert>=3) THEN
+                 IF (iflag_cloudth_vert>=3) THEN
                    ctot_vol(i,k)=rneb(i,k)
                    rneblsvol(i,k)=ctot_vol(i,k)
@@ -928,10 +928,10 @@
                  ! DT : variation de temperature due a la condensation 
 
-                 if (.not. ice_thermo) THEN
+                 IF (.NOT. ice_thermo) THEN
                  ! --------------------------
                  do i=1,klon
-                 if ((convergence(i).or.(n_i(i)==0)).and.lognormale(i)) THEN
+                 IF ((convergence(i).OR.(n_i(i)==0)).AND.lognormale(i)) THEN
                  qlbef(i)=max(0.,zqn(i)-zqs(i))
-               if (fl_cor_ebil > 0) THEN
+               IF (fl_cor_ebil > 0) THEN
                  num=-Tbef(i)+zt(i)+rneb(i,k)*RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*qlbef(i)
                else
@@ -944,13 +944,13 @@
                  enddo
 
-                 else ! if (.not. ice_thermo)
+                 else ! if (.NOT. ice_thermo)
                  ! --------------------------
-                 if (iflag_t_glace>=1) THEN
+                 IF (iflag_t_glace>=1) THEN
                  CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
                  endif
 
                  do i=1,klon
-                 if ((convergence(i).or.(n_i(i)==0)).and.lognormale(i)) THEN
-                 if (iflag_t_glace==0) THEN
+                 IF ((convergence(i).OR.(n_i(i)==0)).AND.lognormale(i)) THEN
+                 IF (iflag_t_glace==0) THEN
                     zfice(i) = 1.0 - (Tbef(i)-t_glace_min_old) / (RTT-t_glace_min_old)
                     zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
@@ -960,14 +960,14 @@
                  endif
                  
-                 if (iflag_t_glace>=1.and.zfice(i)>0.) THEN
+                 IF (iflag_t_glace>=1.AND.zfice(i)>0.) THEN
                  dzfice(i)= exposant_glace * zfice(i)**(exposant_glace-1) &
                       / (t_glace_min - t_glace_max)
                  endif
                
-                 if ((zfice(i)==0).or.(zfice(i)==1)) THEN
+                 IF ((zfice(i)==0).OR.(zfice(i)==1)) THEN
                     dzfice(i)=0.
                  endif
 
-                 if (zfice(i)<1) THEN
+                 IF (zfice(i)<1) THEN
                     cste=RLVTT
                  else
@@ -976,5 +976,5 @@
 
                  qlbef(i)=max(0.,zqn(i)-zqs(i))
-               if (fl_cor_ebil > 0) THEN
+               IF (fl_cor_ebil > 0) THEN
                  num = -Tbef(i)+zt(i)+rneb(i,k)*((1-zfice(i))*RLVTT &
             +zfice(i)*RLSTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*qlbef(i)
@@ -1006,5 +1006,5 @@
         endif ! iflag_pdf
 
-!        if (iflag_fisrtilp_qsat.eq.-1) THEN
+!        if (iflag_fisrtilp_qsat.EQ.-1) THEN
 !------------------------------------------
 !CR: ATTENTION option fausse mais a existe:
@@ -1064,5 +1064,5 @@
        
         ! If vertical heterogeneity, change fraction by volume as well
-        if (iflag_cloudth_vert>=3) THEN
+        IF (iflag_cloudth_vert>=3) THEN
           ctot_vol(1:klon,k)=min(max(ctot_vol(1:klon,k),0.),1.)
           rneblsvol(1:klon,k)=ctot_vol(1:klon,k)
@@ -1100,11 +1100,11 @@
 
      IF (.NOT. ice_thermo) THEN
-        if (iflag_fisrtilp_qsat<1) THEN
+        IF (iflag_fisrtilp_qsat<1) THEN
            DO i = 1, klon
              zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
            ENDDO
-        else if (iflag_fisrtilp_qsat>0) THEN
+        ELSE IF (iflag_fisrtilp_qsat>0) THEN
            DO i= 1, klon
-    if (fl_cor_ebil > 0) THEN
+    IF (fl_cor_ebil > 0) THEN
              zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
     else
@@ -1114,13 +1114,13 @@
         endif
      ELSE
-         if (iflag_t_glace>=1) THEN
+         IF (iflag_t_glace>=1) THEN
             CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
          endif
-         if (iflag_fisrtilp_qsat<1) THEN
+         IF (iflag_fisrtilp_qsat<1) THEN
            DO i = 1, klon
 ! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
 !              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
 !                                     t_glace_max, exposant_glace)
-              if (iflag_t_glace==0) THEN
+              IF (iflag_t_glace==0) THEN
                     zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (RTT-t_glace_min_old)
                     zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
@@ -1135,10 +1135,10 @@
 !              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
 !                                     t_glace_max, exposant_glace)
-              if (iflag_t_glace==0) THEN
+              IF (iflag_t_glace==0) THEN
                     zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (RTT-t_glace_min_old)
                     zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
                     zfice(i) = zfice(i)**exposant_glace_old
               endif
-        if (fl_cor_ebil > 0) THEN
+        IF (fl_cor_ebil > 0) THEN
               zt(i) = zt(i) + (1.-zfice(i))*zcond(i) & 
                * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i))) &
@@ -1272,5 +1272,5 @@
                  !  quantite d'eau a eliminer: zchau (Sundqvist, 1978)
                  !  meme chose pour la glace: zfroi (Zender & Kiehl, 1997)
-                 if (ptconv(i,k)) THEN
+                 IF (ptconv(i,k)) THEN
                     zcl   =cld_lc_con
                     zct   =1./cld_tau_con
@@ -1288,5 +1288,5 @@
                  ! surfacique modifiee, qui est plus grande et reduit
                  ! sinon l'eau in-cloud de facon artificielle
-                 if ((iflag_cloudth_vert>=3).AND.(iflag_rain_incloud_vol==1)) THEN
+                 IF ((iflag_cloudth_vert>=3).AND.(iflag_rain_incloud_vol==1)) THEN
                     zchau    = zct   *dtime/REAL(ninter) * zoliq(i) &
                          *(1.0-EXP(-(zoliq(i)/ctot_vol(i,k)/zcl   )**2)) *(1.-zfice(i))
@@ -1351,5 +1351,5 @@
              zqpreci(i)=(zcond(i)-zoliq(i))*zfice(i)
              zqprecl(i)=(zcond(i)-zoliq(i))*(1.-zfice(i))
-           if (fl_cor_ebil > 0) THEN
+           IF (fl_cor_ebil > 0) THEN
              zcp=RCPD*(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
              coef1 = rneb(i,k)*RLSTT/zcp*zdqsdT_raw(i)
@@ -1415,6 +1415,6 @@
          IF (rneb(i,k)>0.0) THEN
 !CR on prend en compte la phase glace
-!JLD inutile car on ne passe jamais ici si .not.ice_thermo
-!           if (.not.ice_thermo) THEN
+!JLD inutile car on ne passe jamais ici si .NOT.ice_thermo
+!           if (.NOT.ice_thermo) THEN
 !           d_ql(i,k) = zoliq(i)
 !           d_qi(i,k) = 0.
@@ -1463,5 +1463,5 @@
                  ENDIF!iflag_evap_prec==4
 
-           if (fl_cor_ebil > 0) THEN
+           IF (fl_cor_ebil > 0) THEN
               zt(i)=zt(i)+zsolid*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
                       *(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
@@ -1568,8 +1568,8 @@
         zprec_cond(i) = MAX(zcond(i)-zoliq(i),0.0) &
              * (paprs(i,k)-paprs(i,k+1))/RG
-        IF (rneb(i,k)>0.0.and.zprec_cond(i)>0.) THEN
+        IF (rneb(i,k)>0.0.AND.zprec_cond(i)>0.) THEN
            !AA lessivage nucleation LMD5 dans la couche elle-meme
           IF (iflag_t_glace==0) THEN
-           if (t(i,k) >= t_glace_min_old) THEN
+           IF (t(i,k) >= t_glace_min_old) THEN
               zalpha_tr = a_tr_sca(3)
            else
@@ -1577,5 +1577,5 @@
            endif
           ELSE ! of IF (iflag_t_glace.EQ.0)
-           if (t(i,k) >= t_glace_min) THEN
+           IF (t(i,k) >= t_glace_min) THEN
               zalpha_tr = a_tr_sca(3)
            else
@@ -1597,7 +1597,7 @@
      DO kk = k-1, 1, -1
         DO i = 1, klon
-           IF (rneb(i,k)>0.0.and.zprec_cond(i)>0.) THEN
+           IF (rneb(i,k)>0.0.AND.zprec_cond(i)>0.) THEN
              IF (iflag_t_glace==0) THEN
-              if (t(i,kk) >= t_glace_min_old) THEN
+              IF (t(i,kk) >= t_glace_min_old) THEN
                  zalpha_tr = a_tr_sca(1)
               else
@@ -1605,5 +1605,5 @@
               endif
              ELSE ! of IF (iflag_t_glace.EQ.0)
-              if (t(i,kk) >= t_glace_min) THEN
+              IF (t(i,kk) >= t_glace_min) THEN
                  zalpha_tr = a_tr_sca(1)
               else
@@ -1652,5 +1652,5 @@
   ! latent heat is considered.
 !CR: si thermo de la glace, neige deja prise en compte
-  IF (.not.ice_thermo) THEN
+  IF (.NOT.ice_thermo) THEN
   DO k = 1, klev
      DO i = 1, klon
@@ -1663,7 +1663,7 @@
   ENDIF
 
-  if (ncoreczq>0) THEN
+  IF (ncoreczq>0) THEN
      WRITE(lunout,*)'WARNING : ZQ dans fisrtilp ',ncoreczq,' val < 1.e-15.'
-  endif
+  ENDIF
 
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_tools.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_tools.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_tools.F90	(revision 5117)
@@ -16,6 +16,6 @@
     ! 3212–3234. https://doi.org/10.1029/2019MS001642
     
-    use lmdz_lscp_ini, ONLY: iflag_vice, ffallv_con, ffallv_lsc
-    use lmdz_lscp_ini, ONLY: cice_velo, dice_velo
+    USE lmdz_lscp_ini, ONLY: iflag_vice, ffallv_con, ffallv_lsc
+    USE lmdz_lscp_ini, ONLY: cice_velo, dice_velo
 
     IMPLICIT NONE
@@ -51,5 +51,5 @@
     IF (iflag_vice == 1) THEN
         ! so-called 'empirical parameterization' in Stubenrauch et al. 2019
-        if (tempc >= -60.0) THEN
+        IF (tempc >= -60.0) THEN
             logvm= -0.0000414122*tempc*tempc*log(iwcg)-0.00538922*tempc*log(iwcg) &
                     -0.0516344*log(iwcg)+0.00216078*tempc + 1.9714    
@@ -575,5 +575,5 @@
 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
-    use lmdz_lscp_ini, ONLY: iflag_gammasat, t_glace_min, RTT
+    USE lmdz_lscp_ini, ONLY: iflag_gammasat, t_glace_min, RTT
 
     IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_ini.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_ini.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_ini.F90	(revision 5117)
@@ -27,7 +27,7 @@
    USE lmdz_ioipsl_getin_p, ONLY: getin_p
 
-integer, intent(in) :: klon,klev,iflag_thermals,lunout_in
-integer, intent(in) :: nbsrf_in,is_lic_in,is_ter_in
-real, intent(in) :: RG_in,RV_in,RD_in,RCPD_in,RLSTT_in,RLVTT_in,RTT_in
+INTEGER, INTENT(IN) :: klon,klev,iflag_thermals,lunout_in
+INTEGER, INTENT(IN) :: nbsrf_in,is_lic_in,is_ter_in
+REAL, INTENT(IN) :: RG_in,RV_in,RD_in,RCPD_in,RLSTT_in,RLVTT_in,RTT_in
 
 INTEGER :: i,k
@@ -45,5 +45,5 @@
 
 PRINT*,'ratqs_ini'
-IF (iflag_thermals==15.or.iflag_thermals==16) THEN
+IF (iflag_thermals==15.OR.iflag_thermals==16) THEN
    dqimpl=-1
 else
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_main.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_main.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_main.F90	(revision 5117)
@@ -30,36 +30,36 @@
 
 ! Input
-integer,intent(in) :: klon,klev,nbsrf,prt_level,lunout
-integer,intent(in) :: iflag_con,iflag_cld_th,iflag_ratqs
-real,intent(in) :: pdtphys,ratqsbas,ratqshaut,fact_cldcon,tau_ratqs
-real,intent(in) :: ratqsp0, ratqsdp
-real, dimension(klon,klev),intent(in) :: omega
-real, dimension(klon,klev+1),intent(in) :: paprs,tke,tke_dissip,lmix,wprime
-real, dimension(klon,klev),intent(in) :: pplay,t_seri,q_seri,zqsat
-real, dimension(klon,klev),intent(in) :: entr_therm,detr_therm,qtc_cv, sigt_cv
-real, dimension(klon,klev) :: detrain_cv,fm_cv,fqd,fqcomp
-real, dimension(klon) :: sigd
-
-real, dimension(klon,klev+1),intent(in) :: fm_therm
-logical, dimension(klon,klev),intent(in) :: ptconv
-real, dimension(klon,klev),intent(in) :: rnebcon0th,clwcon0th
-real, dimension(klon,klev),intent(in) :: wake_deltaq,wake_s
-real, dimension(klon,nbsrf),intent(in) :: t2m,q2m
-real, dimension(klon), intent(in) :: cell_area
-real, dimension(klon,nbsrf),intent(in) :: pctsrf
-real, dimension(klon),intent(in) :: s_pblh
-real, dimension(klon),intent(in) :: zstd
+INTEGER,INTENT(IN) :: klon,klev,nbsrf,prt_level,lunout
+INTEGER,INTENT(IN) :: iflag_con,iflag_cld_th,iflag_ratqs
+REAL,INTENT(IN) :: pdtphys,ratqsbas,ratqshaut,fact_cldcon,tau_ratqs
+REAL,INTENT(IN) :: ratqsp0, ratqsdp
+REAL, DIMENSION(klon,klev),INTENT(IN) :: omega
+REAL, DIMENSION(klon,klev+1),INTENT(IN) :: paprs,tke,tke_dissip,lmix,wprime
+REAL, DIMENSION(klon,klev),INTENT(IN) :: pplay,t_seri,q_seri,zqsat
+REAL, DIMENSION(klon,klev),INTENT(IN) :: entr_therm,detr_therm,qtc_cv, sigt_cv
+REAL, DIMENSION(klon,klev) :: detrain_cv,fm_cv,fqd,fqcomp
+REAL, DIMENSION(klon) :: sigd
+
+REAL, DIMENSION(klon,klev+1),INTENT(IN) :: fm_therm
+logical, DIMENSION(klon,klev),INTENT(IN) :: ptconv
+REAL, DIMENSION(klon,klev),INTENT(IN) :: rnebcon0th,clwcon0th
+REAL, DIMENSION(klon,klev),INTENT(IN) :: wake_deltaq,wake_s
+REAL, DIMENSION(klon,nbsrf),INTENT(IN) :: t2m,q2m
+REAL, DIMENSION(klon), INTENT(IN) :: cell_area
+REAL, DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf
+REAL, DIMENSION(klon),INTENT(IN) :: s_pblh
+REAL, DIMENSION(klon),INTENT(IN) :: zstd
 
 ! Output
-real, dimension(klon,klev),intent(inout) :: ratqs,ratqsc,ratqs_inter_
-
-logical, dimension(klon,klev),intent(inout) :: ptconvth
+REAL, DIMENSION(klon,klev),INTENT(INOUT) :: ratqs,ratqsc,ratqs_inter_
+
+logical, DIMENSION(klon,klev),INTENT(INOUT) :: ptconvth
 
 ! local
-integer i,k
-real, dimension(klon,klev) :: ratqss
-real facteur,zfratqs1,zfratqs2
-real, dimension(klon,klev) :: ratqs_hetero_,ratqs_oro_,ratqs_tke_
-real resol,resolmax,fact
+INTEGER i,k
+REAL, DIMENSION(klon,klev) :: ratqss
+REAL facteur,zfratqs1,zfratqs2
+REAL, DIMENSION(klon,klev) :: ratqs_hetero_,ratqs_oro_,ratqs_tke_
+REAL resol,resolmax,fact
 
 !-------------------------------------------------------------------------
@@ -71,5 +71,5 @@
 !   ----------------
 !   on ecrase le tableau ratqsc calcule par clouds_gno
-      if (iflag_cld_th==1) THEN
+      IF (iflag_cld_th==1) THEN
          do k=1,klev
          do i=1,klon
@@ -86,5 +86,5 @@
 !  par nversion de la fonction log normale
 !-----------------------------------------------------------------------
-      else if (iflag_cld_th==4) THEN
+      ELSE IF (iflag_cld_th==4) THEN
          ptconvth(:,:)=.FALSE.
          ratqsc(:,:)=0.
@@ -99,5 +99,5 @@
 !   -------------
 
-      if (iflag_ratqs==0) THEN
+      IF (iflag_ratqs==0) THEN
 ! Le cas iflag_ratqs=0 correspond a la version IPCC 2005 du modele.
          do k=1,klev
@@ -115,10 +115,10 @@
 ! avec thermiques.
 
-      else if (iflag_ratqs==1) THEN
+      ELSE IF (iflag_ratqs==1) THEN
          do k=1,klev
             do i=1, klon
-               if (pplay(i,k)>=60000.) THEN
+               IF (pplay(i,k)>=60000.) THEN
                   ratqss(i,k)=ratqsbas
-               else if ((pplay(i,k)>=30000.).and.(pplay(i,k)<60000.)) THEN
+               ELSE IF ((pplay(i,k)>=30000.).AND.(pplay(i,k)<60000.)) THEN
                   ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*(60000.-pplay(i,k))/(60000.-30000.)
                else
@@ -128,10 +128,10 @@
          enddo
 
-      else if (iflag_ratqs==2) THEN
+      ELSE IF (iflag_ratqs==2) THEN
          do k=1,klev
             do i=1, klon
-               if (pplay(i,k)>=60000.) THEN
+               IF (pplay(i,k)>=60000.) THEN
                   ratqss(i,k)=ratqsbas*(paprs(i,1)-pplay(i,k))/(paprs(i,1)-60000.)
-               else if ((pplay(i,k)>=30000.).and.(pplay(i,k)<60000.)) THEN
+               ELSE IF ((pplay(i,k)>=30000.).AND.(pplay(i,k)<60000.)) THEN
                     ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*(60000.-pplay(i,k))/(60000.-30000.)
                else
@@ -141,5 +141,5 @@
          enddo
 
-      else if (iflag_ratqs==3) THEN
+      ELSE IF (iflag_ratqs==3) THEN
          do k=1,klev
            ratqss(:,k)=ratqsbas+(ratqshaut-ratqsbas) &
@@ -147,5 +147,5 @@
          enddo
 
-      else if (iflag_ratqs==4) THEN
+      ELSE IF (iflag_ratqs==4) THEN
          do k=1,klev
            ratqss(:,k)=ratqsbas+0.5*(ratqshaut-ratqsbas) &
@@ -155,5 +155,5 @@
 
 
-      else if (iflag_ratqs==5) THEN
+      ELSE IF (iflag_ratqs==5) THEN
 ! Dependency of ratqs on model resolution
 ! Audran, Meryl, Lea, Gwendal and Etienne
@@ -170,5 +170,5 @@
 
 
-       else if (iflag_ratqs > 9) THEN
+       ELSE IF (iflag_ratqs > 9) THEN
        ! interactive ratqs calculations that depend on cold pools, orography, surface heterogeneity and small-scale turbulence
        ! This should help getting a more realistic ratqs in the low and mid troposphere
@@ -189,5 +189,5 @@
           enddo
       
-          if (iflag_ratqs == 10) THEN
+          IF (iflag_ratqs == 10) THEN
              ! interactive ratqs in presence of cold pools     
              CALL ratqs_inter(klon,klev,iflag_ratqs,pdtphys,paprs, &
@@ -201,5 +201,5 @@
              enddo
              ratqss=ratqss+ratqs_inter_
-          else if (iflag_ratqs == 11) THEN
+          ELSE IF (iflag_ratqs == 11) THEN
             PRINT*,'avant ratqs_inter'
             ! interactive ratqs with several sources
@@ -209,13 +209,13 @@
                        ratqs_inter_)
              ratqss=ratqss+ratqs_inter_
-          else if (iflag_ratqs == 12) THEN
+          ELSE IF (iflag_ratqs == 12) THEN
              ! contribution of surface heterogeneities to ratqs
              CALL ratqs_hetero(klon,klev,pctsrf,s_pblh,t2m,q2m,t_seri,q_seri,pplay,paprs,ratqs_hetero_)
              ratqss=ratqss+ratqs_hetero_
-          else if (iflag_ratqs == 13) THEN
+          ELSE IF (iflag_ratqs == 13) THEN
              ! contribution of ubgrid orography to ratqs
              CALL ratqs_oro(klon,klev,pctsrf,zstd,zqsat,t_seri,pplay,paprs,ratqs_oro_)
              ratqss=ratqss+ratqs_oro_
-          else if (iflag_ratqs == 14) THEN
+          ELSE IF (iflag_ratqs == 14) THEN
              ! effect of subgrid-scale TKE on ratqs (in development)
              CALL ratqs_tke(klon,klev,pdtphys,t_seri,q_seri,zqsat,pplay,paprs,omega,tke,tke_dissip,lmix,wprime,ratqs_tke_)
@@ -230,5 +230,5 @@
 !  -----------
 
-      if (iflag_cld_th==1 .or.iflag_cld_th==2.or.iflag_cld_th==4) THEN
+      IF (iflag_cld_th==1 .OR.iflag_cld_th==2.OR.iflag_cld_th==4) THEN
 ! On ajoute une constante au ratqsc*2 pour tenir compte de 
 ! fluctuations turbulentes de petite echelle
@@ -236,5 +236,5 @@
          do k=1,klev
             do i=1,klon
-               if ((fm_therm(i,k)>1.e-10)) THEN
+               IF ((fm_therm(i,k)>1.e-10)) THEN
                   ratqsc(i,k)=sqrt(ratqsc(i,k)**2+0.05**2)
                endif
@@ -245,5 +245,5 @@
        IF(prt_level>=9) WRITE(lunout,*)'PHYLMD NOUVEAU TAU_RATQS ',tau_ratqs
 
-         if (tau_ratqs>1.e-10) THEN
+         IF (tau_ratqs>1.e-10) THEN
             facteur=exp(-pdtphys/tau_ratqs)
          else
@@ -258,5 +258,5 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
          ratqs(:,:)=max(ratqs(:,:),ratqss(:,:))
-      else if (iflag_cld_th<=6) THEN
+      ELSE IF (iflag_cld_th<=6) THEN
 !   on ne prend que le ratqs stable pour fisrtilp
          ratqs(:,:)=ratqss(:,:)
@@ -266,5 +266,5 @@
           do k=1,klev
              do i=1,klon
-                if (ratqsc(i,k)>1.e-10) THEN
+                IF (ratqsc(i,k)>1.e-10) THEN
                    ratqs(i,k)=ratqs(i,k)*zfratqs2+(iflag_cld_th/100.)*ratqsc(i,k)*(1.-zfratqs2)
                 endif
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_multi.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_multi.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_multi.F90	(revision 5117)
@@ -44,15 +44,15 @@
 ! Declarations
 ! Input
-integer,intent(in) :: klon,klev,iflag_ratqs
-real,intent(in) :: pdtphys,ratqsbas
-real, dimension(klon,klev+1),intent(in) :: paprs
-real, dimension(klon,klev),intent(in) :: wake_deltaq, q_seri,qtc_cv, sigt_cv
-real, dimension(klon),intent(in) :: wake_s
-real, dimension(klon,klev+1),intent(in) :: fm_therm
-real, dimension(klon,klev),intent(in) :: entr_therm,detr_therm,detrain_cv,fm_cv,fqd,fqcomp
-real, dimension(klon),intent(in) :: sigd
+INTEGER,INTENT(IN) :: klon,klev,iflag_ratqs
+REAL,INTENT(IN) :: pdtphys,ratqsbas
+REAL, DIMENSION(klon,klev+1),INTENT(IN) :: paprs
+REAL, DIMENSION(klon,klev),INTENT(IN) :: wake_deltaq, q_seri,qtc_cv, sigt_cv
+REAL, DIMENSION(klon),INTENT(IN) :: wake_s
+REAL, DIMENSION(klon,klev+1),INTENT(IN) :: fm_therm
+REAL, DIMENSION(klon,klev),INTENT(IN) :: entr_therm,detr_therm,detrain_cv,fm_cv,fqd,fqcomp
+REAL, DIMENSION(klon),INTENT(IN) :: sigd
 
 ! Output
-real, dimension(klon,klev),intent(inout) :: ratqs_inter_
+REAL, DIMENSION(klon,klev),INTENT(INOUT) :: ratqs_inter_
 
 ! local
@@ -64,10 +64,10 @@
 REAL, DIMENSION (klon,klev) :: zmasse,entr0,detr0,detraincv,dqp,detrain_p,q0,qd0,tau_diss
 REAL, DIMENSION (klon,klev+1) :: fm0
-integer i,k
-real, dimension(klon,klev) :: wake_dq
-
-real, dimension(klon) :: max_sigd, max_dqconv,max_sigt
-real, dimension(klon,klev) :: zoa,zocarrea,pdocarreadj,pocarre,po,pdoadj,varq_therm
-real, dimension(klon,klev) :: var_moy, var_var, var_desc_th,var_det_conv,var_desc_prec,var_desc_conv,sigma_therm
+INTEGER i,k
+REAL, DIMENSION(klon,klev) :: wake_dq
+
+REAL, DIMENSION(klon) :: max_sigd, max_dqconv,max_sigt
+REAL, DIMENSION(klon,klev) :: zoa,zocarrea,pdocarreadj,pocarre,po,pdoadj,varq_therm
+REAL, DIMENSION(klon,klev) :: var_moy, var_var, var_desc_th,var_det_conv,var_desc_prec,var_desc_conv,sigma_therm
 
 lev_out=0.
@@ -127,5 +127,5 @@
             var_var(i,k) = detr0(i,k)*(varq_therm(i,k)-povariance(i,k))/zmasse(i,k)
             var_det_conv(i,k) =  a_ratqs_cv*(detrain_cv(i,k)/zmasse(i,k))
-            if (sigd(i)/=0) THEN
+            IF (sigd(i)/=0) THEN
                var_desc_prec(i,k) = sigd(i)*(1-sigd(i))*(fqd(i,k)*tau_cumul/sigd(i))**2/tau_cumul
             else
@@ -145,9 +145,9 @@
       var_desc_conv(:,klev) = var_desc_conv(:,klev-1)
       
-      if (klein) THEN
+      IF (klein) THEN
          do k=1,klev-1
             do i=1,klon
               qd0(:,:) = 0.0
-              if (sigd(i)/=0) THEN
+              IF (sigd(i)/=0) THEN
                 qd0(i,k) = fqd(i,k)*tau_cumul/sigd(i) 
               endif
@@ -169,8 +169,8 @@
          do k=1,klev-1
             do i=1,klon
-               if (sigd(i)/=0) then    ! termes de variance par accumulation
+               IF (sigd(i)/=0) then    ! termes de variance par accumulation
                  qd0(i,k) = fqd(i,k)*tau_cumul/sigd(i) 
                endif
-               if (sigt_cv(i,k)/=0) THEN
+               IF (sigt_cv(i,k)/=0) THEN
                  q0(i,k) = fqcomp(i,k)*tau_cumul/sigt_cv(i,k)
                endif
@@ -233,5 +233,5 @@
 ! OUTPUTS
 
-REAL, DIMENSION(klon,klev), INTENT(out) :: ratqs_oro_ ! ratqs profile due to subgrid orography
+REAL, DIMENSION(klon,klev), INTENT(OUT) :: ratqs_oro_ ! ratqs profile due to subgrid orography
 
 
@@ -315,5 +315,5 @@
 ! OUTPUTS
 
-REAL, DIMENSION(klon,klev), INTENT(out) :: ratqs_hetero_ ! ratsq profile due to surface heterogeneities
+REAL, DIMENSION(klon,klev), INTENT(OUT) :: ratqs_hetero_ ! ratsq profile due to surface heterogeneities
 
 
@@ -398,5 +398,5 @@
 ! OUTPUTS
 
-REAL, DIMENSION(klon,klev), INTENT(out) :: ratqs_tke_  ! ratsq profile due to subgrid TKE
+REAL, DIMENSION(klon,klev), INTENT(OUT) :: ratqs_tke_  ! ratsq profile due to subgrid TKE
 
 ! LOCAL
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alim.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alim.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alim.F90	(revision 5117)
@@ -43,5 +43,5 @@
       do l=1,klev-1
          do ig=1,ngrid
-            if (ztv(ig,l)> ztv(ig,l+1) .and. ztv(ig,1)>=ztv(ig,l) ) THEN
+            IF (ztv(ig,l)> ztv(ig,l+1) .AND. ztv(ig,1)>=ztv(ig,l) ) THEN
                alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
                          *sqrt(zlev(ig,l+1))
@@ -53,5 +53,5 @@
       do l=1,klev
          do ig=1,ngrid 
-            if (alim_star_tot(ig) > 1.e-10 ) THEN
+            IF (alim_star_tot(ig) > 1.e-10 ) THEN
                alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
             endif
@@ -82,5 +82,5 @@
          do ig=1,ngrid
             ztv_parcel=ztv(ig,1)+d_temp(ig)
-            if (ztv_parcel<ztv(ig,l+1)) lalim(ig)=l
+            IF (ztv_parcel<ztv(ig,l+1)) lalim(ig)=l
          enddo
       enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alp.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alp.F90	(revision 5117)
@@ -46,31 +46,31 @@
 
 !------Entrees
-      integer, intent(in) :: ngrid,nlay
-      real, intent(in) :: ptimestep
-      real, intent(in) :: pplay(ngrid,nlay),pplev(ngrid,nlay+1)
-      integer, intent(in), dimension(ngrid) ::lmax,lalim
-      real, intent(in), dimension(ngrid) :: zmax, zcong
-      real, intent(in), dimension(ngrid,nlay+1) :: zw2
-      real, intent(in), dimension(ngrid,nlay+1) :: fraca
-      real, intent(in), dimension(ngrid,nlay) :: wth3
-      real, intent(in), dimension(ngrid,nlay) :: rhobarz
-      real, intent(in), dimension(ngrid) :: wmax_sec
-      real, intent(in), dimension(ngrid,nlay) :: entr0
-      real, intent(in), dimension(ngrid,nlay+1) :: fm0,fm
-      real, intent(in), dimension(ngrid) :: pcon
-      real, intent(in), dimension(ngrid,nlay) :: alim_star
-      real, intent(in), dimension(ngrid,nlay+1,nbsrf) :: pbl_tke
-      real, intent(in), dimension(ngrid,nbsrf) :: pctsrf
-      real, intent(in), dimension(ngrid,nlay) :: omega
-      real, intent(in), dimension(ngrid) :: airephy
+      INTEGER, INTENT(IN) :: ngrid,nlay
+      REAL, INTENT(IN) :: ptimestep
+      REAL, INTENT(IN) :: pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      INTEGER, INTENT(IN), DIMENSION(ngrid) ::lmax,lalim
+      REAL, INTENT(IN), DIMENSION(ngrid) :: zmax, zcong
+      REAL, INTENT(IN), DIMENSION(ngrid,nlay+1) :: zw2
+      REAL, INTENT(IN), DIMENSION(ngrid,nlay+1) :: fraca
+      REAL, INTENT(IN), DIMENSION(ngrid,nlay) :: wth3
+      REAL, INTENT(IN), DIMENSION(ngrid,nlay) :: rhobarz
+      REAL, INTENT(IN), DIMENSION(ngrid) :: wmax_sec
+      REAL, INTENT(IN), DIMENSION(ngrid,nlay) :: entr0
+      REAL, INTENT(IN), DIMENSION(ngrid,nlay+1) :: fm0,fm
+      REAL, INTENT(IN), DIMENSION(ngrid) :: pcon
+      REAL, INTENT(IN), DIMENSION(ngrid,nlay) :: alim_star
+      REAL, INTENT(IN), DIMENSION(ngrid,nlay+1,nbsrf) :: pbl_tke
+      REAL, INTENT(IN), DIMENSION(ngrid,nbsrf) :: pctsrf
+      REAL, INTENT(IN), DIMENSION(ngrid,nlay) :: omega
+      REAL, INTENT(IN), DIMENSION(ngrid) :: airephy
 !------Sorties
-      real, intent(out), dimension(ngrid) :: ale_bl,alp_bl
-      real, intent(out), dimension(ngrid,nlay) :: wght_th
-      integer, intent(out), dimension(ngrid) :: lalim_conv
-      real, intent(out), dimension(ngrid) :: zlcl,fraca0,w0,w_conv
-      real, intent(out), dimension(ngrid) :: therm_tke_max0,env_tke_max0,n2,s2,ale_bl_stat,strig
-      real, intent(out), dimension(ngrid,nlay) :: therm_tke_max,env_tke_max
-      real, intent(out), dimension(ngrid) :: alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke
-      real, intent(out), dimension(ngrid) :: alp_bl_conv,alp_bl_stat
+      REAL, INTENT(OUT), DIMENSION(ngrid) :: ale_bl,alp_bl
+      REAL, INTENT(OUT), DIMENSION(ngrid,nlay) :: wght_th
+      INTEGER, INTENT(OUT), DIMENSION(ngrid) :: lalim_conv
+      REAL, INTENT(OUT), DIMENSION(ngrid) :: zlcl,fraca0,w0,w_conv
+      REAL, INTENT(OUT), DIMENSION(ngrid) :: therm_tke_max0,env_tke_max0,n2,s2,ale_bl_stat,strig
+      REAL, INTENT(OUT), DIMENSION(ngrid,nlay) :: therm_tke_max,env_tke_max
+      REAL, INTENT(OUT), DIMENSION(ngrid) :: alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke
+      REAL, INTENT(OUT), DIMENSION(ngrid) :: alp_bl_conv,alp_bl_stat
 
 !=============================================================================================
@@ -80,30 +80,30 @@
       REAL susqr2pi, reuler
       INTEGER ig,k,l
-      integer nsrf
-      real rhobarz0(ngrid)                    ! Densité au LCL
-      logical ok_lcl(ngrid)                   ! Existence du LCL des thermiques
-      integer klcl(ngrid)                     ! Niveau du LCL
-      real interp(ngrid)                      ! Coef d'interpolation pour le LCL
+      INTEGER nsrf
+      REAL rhobarz0(ngrid)                    ! Densité au LCL
+      LOGICAL ok_lcl(ngrid)                   ! Existence du LCL des thermiques
+      INTEGER klcl(ngrid)                     ! Niveau du LCL
+      REAL interp(ngrid)                      ! Coef d'interpolation pour le LCL
 !--Triggering
-      real, parameter :: su_cst=4e4              ! Surface unite: celle d'un updraft élémentaire
-      real, parameter :: hcoef=1             ! Coefficient directeur pour le calcul de s2
-      real, parameter :: hmincoef=0.3        ! Coefficient directeur pour l'ordonnée à l'origine pour le calcul de s2
-      real, parameter :: eps1=0.3            ! Fraction de surface occupée par la population 1 : eps1=n1*s1/(fraca0*Sd)
-      real, dimension(ngrid) :: hmin         ! Ordonnée à l'origine pour le calcul de s2
-      real, dimension(ngrid) :: zmax_moy     ! Hauteur moyenne des thermiques : zmax_moy = zlcl + 0.33 (zmax-zlcl)
-      real, parameter :: zmax_moy_coef=0.33
-      real, dimension(ngrid) :: depth        ! Epaisseur moyenne du cumulus
-      real, dimension(ngrid) :: zcong_moy 
-      real, dimension(ngrid) ::  w_max                 ! Vitesse max statistique 
-      real, dimension(ngrid) ::  s_max(ngrid)
+      REAL, parameter :: su_cst=4e4              ! Surface unite: celle d'un updraft élémentaire
+      REAL, parameter :: hcoef=1             ! Coefficient directeur pour le calcul de s2
+      REAL, parameter :: hmincoef=0.3        ! Coefficient directeur pour l'ordonnée à l'origine pour le calcul de s2
+      REAL, parameter :: eps1=0.3            ! Fraction de surface occupée par la population 1 : eps1=n1*s1/(fraca0*Sd)
+      REAL, DIMENSION(ngrid) :: hmin         ! Ordonnée à l'origine pour le calcul de s2
+      REAL, DIMENSION(ngrid) :: zmax_moy     ! Hauteur moyenne des thermiques : zmax_moy = zlcl + 0.33 (zmax-zlcl)
+      REAL, parameter :: zmax_moy_coef=0.33
+      REAL, DIMENSION(ngrid) :: depth        ! Epaisseur moyenne du cumulus
+      REAL, DIMENSION(ngrid) :: zcong_moy
+      REAL, DIMENSION(ngrid) ::  w_max                 ! Vitesse max statistique
+      REAL, DIMENSION(ngrid) ::  s_max(ngrid)
 !--Closure
-      real, dimension(ngrid,nlay) :: pbl_tke_max       ! Profil de TKE moyenne 
-      real, dimension(ngrid) :: pbl_tke_max0           ! TKE moyenne au LCL
-      real, dimension(ngrid,nlay) :: w_ls              ! Vitesse verticale grande échelle (m/s)
-      real, parameter :: coef_m=1.            ! On considère un rendement pour alp_bl_fluct_m
-      real, parameter :: coef_tke=1.          ! On considère un rendement pour alp_bl_fluct_tke
+      REAL, DIMENSION(ngrid,nlay) :: pbl_tke_max       ! Profil de TKE moyenne
+      REAL, DIMENSION(ngrid) :: pbl_tke_max0           ! TKE moyenne au LCL
+      REAL, DIMENSION(ngrid,nlay) :: w_ls              ! Vitesse verticale grande échelle (m/s)
+      REAL, parameter :: coef_m=1.            ! On considère un rendement pour alp_bl_fluct_m
+      REAL, parameter :: coef_tke=1.          ! On considère un rendement pour alp_bl_fluct_tke
       REAL :: zdp
-      real, dimension(ngrid) :: alp_int,dp_int
-      real, dimension(ngrid) :: fm_tot
+      REAL, DIMENSION(ngrid) :: alp_int,dp_int
+      REAL, DIMENSION(ngrid) :: fm_tot
 
 !------------------------------------------------------------
@@ -137,5 +137,5 @@
     do ig=1,ngrid
       ok_lcl(ig)=.FALSE.
-      if ( (pcon(ig) > pplay(ig,nlay-1)) .and. (pcon(ig) < pplay(ig,1)) ) ok_lcl(ig)=.TRUE.
+      IF ( (pcon(ig) > pplay(ig,nlay-1)) .AND. (pcon(ig) < pplay(ig,1)) ) ok_lcl(ig)=.TRUE.
     enddo
 
@@ -143,11 +143,11 @@
     do l=1,nlay-1
       do ig=1,ngrid
-        if (ok_lcl(ig)) THEN
+        IF (ok_lcl(ig)) THEN
 !ATTENTION,zw2 calcule en pplev
-!          if ((pplay(ig,l) .ge. pcon(ig)) .and. (pplay(ig,l+1) .le. pcon(ig))) THEN
+!          if ((pplay(ig,l) .ge. pcon(ig)) .AND. (pplay(ig,l+1) .le. pcon(ig))) THEN
 !          klcl(ig)=l
 !          interp(ig)=(pcon(ig)-pplay(ig,klcl(ig)))/(pplay(ig,klcl(ig)+1)-pplay(ig,klcl(ig)))
 !          endif
-          if ((pplev(ig,l) >= pcon(ig)) .and. (pplev(ig,l+1) <= pcon(ig))) THEN
+          IF ((pplev(ig,l) >= pcon(ig)) .AND. (pplev(ig,l+1) <= pcon(ig))) THEN
           klcl(ig)=l
           interp(ig)=(pcon(ig)-pplev(ig,klcl(ig)))/(pplev(ig,klcl(ig)+1)-pplev(ig,klcl(ig)))
@@ -159,5 +159,5 @@
     do ig =1,ngrid
 !CR:REHABILITATION ZMAX CONTINU
-     if (ok_lcl(ig)) THEN
+     IF (ok_lcl(ig)) THEN
       rhobarz0(ig)=rhobarz(ig,klcl(ig))+(rhobarz(ig,klcl(ig)+1) &
                  -rhobarz(ig,klcl(ig)))*interp(ig)
@@ -172,5 +172,5 @@
 
 !------------Calcul des propriétés du thermique au LCL
-  IF ( (iflag_trig_bl>=1) .or. (iflag_clos_bl>=1) ) THEN
+  IF ( (iflag_trig_bl>=1) .OR. (iflag_clos_bl>=1) ) THEN
 
   !-----Initialisation de la TKE moyenne 
@@ -214,5 +214,5 @@
 
   do ig=1,ngrid
-   if (ok_lcl(ig)) THEN
+   IF (ok_lcl(ig)) THEN
      fraca0(ig)=fraca(ig,klcl(ig))+(fraca(ig,klcl(ig)+1) &
                -fraca(ig,klcl(ig)))*interp(ig)
@@ -227,7 +227,7 @@
      pbl_tke_max0(ig)=pbl_tke_max(ig,klcl(ig))+(pbl_tke_max(ig,klcl(ig)+1) &
                      -pbl_tke_max(ig,klcl(ig)))*interp(ig)
-     if (therm_tke_max0(ig)>=20.) therm_tke_max0(ig)=20.
-     if (env_tke_max0(ig)>=20.) env_tke_max0(ig)=20.
-     if (pbl_tke_max0(ig)>=20.) pbl_tke_max0(ig)=20.
+     IF (therm_tke_max0(ig)>=20.) therm_tke_max0(ig)=20.
+     IF (env_tke_max0(ig)>=20.) env_tke_max0(ig)=20.
+     IF (pbl_tke_max0(ig)>=20.) pbl_tke_max0(ig)=20.
    else 
      fraca0(ig)=0.
@@ -239,6 +239,6 @@
   enddo
 
-  ENDIF ! IF ( (iflag_trig_bl.ge.1) .or. (iflag_clos_bl.ge.1) )
-!  print *,'ENDIF  ( (iflag_trig_bl.ge.1) .or. (iflag_clos_bl.ge.1) ) '    !!jyg
+  ENDIF ! IF ( (iflag_trig_bl.ge.1) .OR. (iflag_clos_bl.ge.1) )
+!  print *,'ENDIF  ( (iflag_trig_bl.ge.1) .OR. (iflag_clos_bl.ge.1) ) '    !!jyg
 
 !------------Triggering------------------
@@ -258,5 +258,5 @@
      depth(ig)=zmax_moy(ig)-zlcl(ig)
      hmin(ig)=hmincoef*zlcl(ig)
-     if (depth(ig)>=10.) THEN
+     IF (depth(ig)>=10.) THEN
        s2(ig)=(hcoef*depth(ig)+hmin(ig))**2
        n2(ig)=(1.-eps1)*fraca0(ig)*airephy(ig)/s2(ig)
@@ -275,7 +275,7 @@
 
 !CR: calcul de strig
-   if (iflag_strig==0) THEN
+   IF (iflag_strig==0) THEN
       strig(:)=s_trig
-   else if (iflag_strig==1) THEN
+   ELSE IF (iflag_strig==1) THEN
       do ig=1,ngrid
 !         zcong_moy(ig)=zlcl(ig)+zmax_moy_coef*(zcong(ig)-zlcl(ig))
@@ -283,7 +283,7 @@
          strig(ig)=(zcong(ig)-zlcl(ig))**2  
       enddo
-   else if (iflag_strig==2) THEN
+   ELSE IF (iflag_strig==2) THEN
       do ig=1,ngrid 
-         if (h_trig>zlcl(ig)) THEN
+         IF (h_trig>zlcl(ig)) THEN
          strig(ig)=(h_trig-zlcl(ig))**2
          else
@@ -296,5 +296,5 @@
    reuler=exp(1.)
    do ig=1,ngrid
-     if ( (depth(ig)>=10.) .and. (s_max(ig)>susqr2pi*reuler) ) THEN
+     IF ( (depth(ig)>=10.) .AND. (s_max(ig)>susqr2pi*reuler) ) THEN
       w_max(ig)=w0(ig)*(1.+sqrt(2.*log(s_max(ig)/susqr2pi)-log(2.*log(s_max(ig)/susqr2pi))))
       ale_bl_stat(ig)=0.5*w_max(ig)**2
@@ -319,5 +319,5 @@
   alp_bl_fluct_tke(ig)=3.*coef_m*rhobarz0(ig)*w0(ig)*fraca0(ig)*(therm_tke_max0(ig)-env_tke_max0(ig)) &
                       +3.*rhobarz0(ig)*w_conv(ig)*pbl_tke_max0(ig)
-    if (iflag_clos_bl>=2) THEN
+    IF (iflag_clos_bl>=2) THEN
     alp_bl_conv(ig)=1.5*coef_m*rhobarz0(ig)*fraca0(ig)*(fraca0(ig)/(1.-fraca0(ig)))*w_conv(ig)* &
                      (w0(ig)**2)
@@ -330,5 +330,5 @@
 !-----Sécurité ALP infinie
   do ig=1,ngrid
-   if (fraca0(ig)>0.98) alp_bl_stat(ig)=2.
+   IF (fraca0(ig)>0.98) alp_bl_stat(ig)=2.
   enddo
 
@@ -363,5 +363,5 @@
       do k=1,nlay
          do ig=1,ngrid
-            if (k<=lalim_conv(ig)) fm_tot(ig)=fm_tot(ig)+fm(ig,k)
+            IF (k<=lalim_conv(ig)) fm_tot(ig)=fm_tot(ig)+fm(ig,k)
          enddo
       enddo
@@ -371,5 +371,5 @@
       do k=1,nlay
          do ig=1,ngrid
-            if (k<=lalim_conv(ig).and.alim_star(ig,k)>1.e-10) THEN
+            IF (k<=lalim_conv(ig).AND.alim_star(ig,k)>1.e-10) THEN
                wght_th(ig,k)=alim_star(ig,k)
             endif
@@ -380,6 +380,6 @@
 !test pour prolonger la convection
       do ig=1,ngrid
-!v1d  if ((alim_star(ig,1).lt.1.e-10).and.(therm)) THEN
-      if ((alim_star(ig,1)<1.e-10)) THEN
+!v1d  if ((alim_star(ig,1).lt.1.e-10).AND.(therm)) THEN
+      IF ((alim_star(ig,1)<1.e-10)) THEN
       lalim_conv(ig)=1
       wght_th(ig,1)=1.
@@ -407,8 +407,8 @@
       enddo
 
-      if (iflag_coupl>=3 .and. iflag_coupl<=5) THEN
+      IF (iflag_coupl>=3 .AND. iflag_coupl<=5) THEN
       do ig=1,ngrid
 !valeur integree de alp_bl * 0.5:
-        if (dp_int(ig)>0.) THEN
+        IF (dp_int(ig)>0.) THEN
         alp_bl(ig)=alp_int(ig)/dp_int(ig)
         endif
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_closure.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_closure.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_closure.F90	(revision 5117)
@@ -21,15 +21,15 @@
 
 ! --- arguments ------------------------------------------
-integer, intent(in) :: ngrid,nlay
-real, intent(in) :: r_aspect,ptimestep
-real, intent(in), dimension(ngrid,nlay) :: alim_star,rho,zlev
-integer, intent(in), dimension(ngrid) :: lalim
-real, intent(in), dimension(ngrid) :: zmax,wmax
+INTEGER, INTENT(IN) :: ngrid,nlay
+REAL, INTENT(IN) :: r_aspect,ptimestep
+REAL, INTENT(IN), DIMENSION(ngrid,nlay) :: alim_star,rho,zlev
+INTEGER, INTENT(IN), DIMENSION(ngrid) :: lalim
+REAL, INTENT(IN), DIMENSION(ngrid) :: zmax,wmax
 
-real, intent(out), dimension(ngrid) :: f
+REAL, INTENT(OUT), DIMENSION(ngrid) :: f
 
 
 ! --- local ------------------------------------------
-real, dimension(ngrid) :: zdenom,alim_star2,alim_star_tot
+REAL, DIMENSION(ngrid) :: zdenom,alim_star2,alim_star_tot
 INTEGER llmax
 INTEGER ig,k       
@@ -45,5 +45,5 @@
 llmax=1
 DO ig=1,ngrid
-   if (lalim(ig)>llmax) llmax=lalim(ig)
+   IF (lalim(ig)>llmax) llmax=lalim(ig)
 END DO
 
@@ -53,5 +53,5 @@
 DO k=1,llmax-1
    do ig=1,ngrid
-      if (k<lalim(ig)) THEN
+      IF (k<lalim(ig)) THEN
          alim_star2(ig)=alim_star2(ig)+alim_star(ig,k)**2  &
 &                    /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k)))
@@ -63,5 +63,5 @@
 
 DO ig=1,ngrid
-   if (alim_star2(ig)>1.e-10) THEN
+   IF (alim_star2(ig)>1.e-10) THEN
       f(ig)=wmax(ig)*alim_star_tot(ig)/  &
 &     (max(500.,zmax(ig))*r_aspect*alim_star2(ig))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_down.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_down.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_down.F90	(revision 5117)
@@ -23,24 +23,24 @@
     ! input/output
 
-    integer, intent(in) :: ngrid ! number of horizontal grid points
-    integer, intent(in) :: nlay  ! number of vertical layers
-    real, intent(in) :: ptimestep ! time step of the physics [s]
-    real, intent(in), dimension(ngrid, nlay) :: eup ! entrainment to updrafts * dz [same unit as flux]
-    real, intent(in), dimension(ngrid, nlay) :: dup ! detrainment from updrafts * dz [same unit as flux]
-    real, intent(in), dimension(ngrid, nlay) :: edn ! entrainment to downdrafts * dz [same unit as flux]
-    real, intent(in), dimension(ngrid, nlay) :: ddn ! detrainment from downdrafts * dz [same unit as flux]
-    real, intent(in), dimension(ngrid, nlay) :: masse ! mass of layers = rho dz
-    real, intent(in), dimension(ngrid, nlay) :: trac ! tracer
-    integer, intent(in), dimension(ngrid) :: lmax ! max level index at which downdraft are present
-    real, intent(out), dimension(ngrid, nlay) :: dtrac ! tendance du traceur
+    INTEGER, INTENT(IN) :: ngrid ! number of horizontal grid points
+    INTEGER, INTENT(IN) :: nlay  ! number of vertical layers
+    REAL, INTENT(IN) :: ptimestep ! time step of the physics [s]
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: eup ! entrainment to updrafts * dz [same unit as flux]
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: dup ! detrainment from updrafts * dz [same unit as flux]
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: edn ! entrainment to downdrafts * dz [same unit as flux]
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: ddn ! detrainment from downdrafts * dz [same unit as flux]
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: masse ! mass of layers = rho dz
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: trac ! tracer
+    INTEGER, INTENT(IN), DIMENSION(ngrid) :: lmax ! max level index at which downdraft are present
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: dtrac ! tendance du traceur
 
 
     ! Local
 
-    real, dimension(ngrid, nlay + 1) :: fup, fdn, fc, fthu, fthd, fthe, fthtot
-    real, dimension(ngrid, nlay) :: tracu, tracd, traci, tracold
+    REAL, DIMENSION(ngrid, nlay + 1) :: fup, fdn, fc, fthu, fthd, fthe, fthtot
+    REAL, DIMENSION(ngrid, nlay) :: tracu, tracd, traci, tracold
     REAL :: www, mstar_inv
-    integer ig, ilay
-    real, dimension(ngrid, nlay) :: s1, s2, num !coefficients pour la resolution implicite
+    INTEGER ig, ilay
+    REAL, DIMENSION(ngrid, nlay) :: s1, s2, num !coefficients pour la resolution implicite
     INTEGER :: iflag_impl = 1 ! 0 pour explicite, 1 pour implicite "classique", 2 pour implicite avec entrainement et detrainement
 
@@ -60,5 +60,5 @@
     num(:, :) = 1.
 
-    if (iflag_thermals_down < 10) THEN
+    IF (iflag_thermals_down < 10) THEN
       CALL abort_physic("thermcell_updown_dq", &
               'thermcell_down_dq = 0 or >= 10', 1)
@@ -74,7 +74,7 @@
       do ig = 1, ngrid
         !if ( lmax(ig) > nlay - 2 ) stop "les thermiques montent trop haut"
-        if (ilay<=lmax(ig) .and. lmax(ig)>1) THEN
+        IF (ilay<=lmax(ig) .AND. lmax(ig)>1) THEN
           fdn(ig, ilay) = fdn(ig, ilay + 1) + edn(ig, ilay) - ddn(ig, ilay)
-          if (fdn(ig, ilay) + ddn(ig, ilay) > 0.) THEN
+          IF (fdn(ig, ilay) + ddn(ig, ilay) > 0.) THEN
             www = fdn(ig, ilay + 1) / (fdn(ig, ilay) + ddn(ig, ilay))
           else
@@ -90,12 +90,12 @@
     do ilay = 1, nlay, 1
       do ig = 1, ngrid
-        if (ilay<lmax(ig) .and. lmax(ig)>1) THEN
+        IF (ilay<lmax(ig) .AND. lmax(ig)>1) THEN
           fup(ig, ilay + 1) = fup(ig, ilay) + eup(ig, ilay) - dup(ig, ilay)
-          if (fup(ig, ilay + 1) + dup(ig, ilay) > 0.) THEN
+          IF (fup(ig, ilay + 1) + dup(ig, ilay) > 0.) THEN
             www = fup(ig, ilay) / (fup(ig, ilay + 1) + dup(ig, ilay))
           else
             www = 0.
           endif
-          if (ilay == 1) THEN
+          IF (ilay == 1) THEN
             tracu(ig, ilay) = trac(ig, ilay)
           else
@@ -131,5 +131,5 @@
           !!!!ATTENTION HYPOTHESE de FLUX COMPENSATOIRE DESCENDANT ET DONC comme schema amont on va chercher trac au dessus!!!!!
           !!!! tentative de prise en compte d'un flux compensatoire montant  !!!!
-          if (fup(ig, ilay) - fdn(ig, ilay) < 0.) THEN
+          IF (fup(ig, ilay) - fdn(ig, ilay) < 0.) THEN
             CALL abort_physic("thermcell_updown_dq", 'flux compensatoire '&
                     // 'montant, cas non traite par thermcell_updown_dq', 1)
@@ -164,5 +164,5 @@
       do ilay = 2, nlay, 1
         do ig = 1, ngrid
-          if (fup(ig, ilay) - fdn(ig, ilay) < 0.) THEN
+          IF (fup(ig, ilay) - fdn(ig, ilay) < 0.) THEN
             CALL abort_physic("thermcell_updown_dq", 'flux compensatoire ' &
                     // 'montant, cas non traite par thermcell_updown_dq', 1)
@@ -183,5 +183,5 @@
       enddo !fin du calculer de la tendance du traceur avec la methode explicite
 
-    else if (iflag_impl==1) THEN
+    ELSE IF (iflag_impl==1) THEN
       do ilay = 1, nlay
         do ig = 1, ngrid
@@ -193,5 +193,5 @@
       do ilay = nlay - 1, 1, -1
         do ig = 1, ngrid
-          if((fup(ig, ilay) - fdn(ig, ilay)) < 0) THEN
+          IF((fup(ig, ilay) - fdn(ig, ilay)) < 0) THEN
             WRITE(*, *) 'flux compensatoire montant, cas non traite par thermcell_updown_dq dans le cas d une resolution implicite, ilay : ', ilay
             CALL abort_physic("thermcell_updown_dq", "", 1)
@@ -230,9 +230,9 @@
     ! arguments
 
-    integer, intent(in) :: ngrid, nlay
-    real, intent(in), dimension(ngrid, nlay) :: po, pt, pu, pv, pplay, eup, dup
-    real, intent(in), dimension(ngrid, nlay) :: theta
-    real, intent(in), dimension(ngrid, nlay + 1) :: pplev, fup
-    integer, intent(in), dimension(ngrid) :: lmax
+    INTEGER, INTENT(IN) :: ngrid, nlay
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: po, pt, pu, pv, pplay, eup, dup
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: theta
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay + 1) :: pplev, fup
+    INTEGER, INTENT(IN), DIMENSION(ngrid) :: lmax
 
 
@@ -240,10 +240,10 @@
     ! Local
 
-    real, dimension(ngrid, nlay) :: edn, ddn, thetad
-    real, dimension(ngrid, nlay + 1) :: fdn
-
-    integer ig, ilay
-    real dqsat_dT
-    logical mask(ngrid, nlay)
+    REAL, DIMENSION(ngrid, nlay) :: edn, ddn, thetad
+    REAL, DIMENSION(ngrid, nlay + 1) :: fdn
+
+    INTEGER ig, ilay
+    REAL dqsat_dT
+    LOGICAL mask(ngrid, nlay)
 
     edn(:, :) = 0.
@@ -271,5 +271,5 @@
     do ilay = nlay, 1, -1
       do ig = 1, ngrid
-        if (ilay<=lmax(ig).and.lmax(ig)>1) THEN
+        IF (ilay<=lmax(ig).AND.lmax(ig)>1) THEN
           edn(ig, ilay) = fact_thermals_down * dup(ig, ilay)
           ddn(ig, ilay) = fact_thermals_down * eup(ig, ilay)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dq.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dq.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dq.F90	(revision 5117)
@@ -23,20 +23,20 @@
 
     ! arguments
-    integer, intent(in) :: ngrid, nlay, impl
-    real, intent(in) :: ptimestep
-    real, intent(in), dimension(ngrid, nlay) :: masse
-    real, intent(inout), dimension(ngrid, nlay) :: entr, q
-    real, intent(in), dimension(ngrid, nlay + 1) :: fm
-    real, intent(out), dimension(ngrid, nlay) :: dq, qa
-    integer, intent(in) :: lev_out                           ! niveau pour les print
+    INTEGER, INTENT(IN) :: ngrid, nlay, impl
+    REAL, INTENT(IN) :: ptimestep
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: masse
+    REAL, INTENT(INOUT), DIMENSION(ngrid, nlay) :: entr, q
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay + 1) :: fm
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: dq, qa
+    INTEGER, INTENT(IN) :: lev_out                           ! niveau pour les print
 
     ! Local
-    real, dimension(ngrid, nlay) :: detr, qold
-    real, dimension(ngrid, nlay + 1) :: wqd, fqa
-    real zzm
-    integer ig, k
-    real cfl
-
-    integer niter, iter
+    REAL, DIMENSION(ngrid, nlay) :: detr, qold
+    REAL, DIMENSION(ngrid, nlay + 1) :: wqd, fqa
+    REAL zzm
+    INTEGER ig, k
+    REAL cfl
+
+    INTEGER niter, iter
     CHARACTER (LEN = 20) :: modname = 'thermcell_dq'
     CHARACTER (LEN = 80) :: abort_message
@@ -57,5 +57,5 @@
           zzm = masse(ig, k) / ptimestep
           cfl = max(cfl, fm(ig, k) / zzm)
-          if (entr(ig, k)>zzm) THEN
+          IF (entr(ig, k)>zzm) THEN
             PRINT*, 'entr*dt>m,1', k, entr(ig, k) * ptimestep, masse(ig, k)
             abort_message = 'entr dt > m, 1st'
@@ -67,5 +67,5 @@
       qold = q
 
-      if (prt_level>=1) PRINT*, 'Q2 THERMCEL_DQ 0'
+      IF (prt_level>=1) PRINT*, 'Q2 THERMCEL_DQ 0'
 
       !   calcul du detrainement
@@ -75,5 +75,5 @@
           !           PRINT*,'Q2 DQ ',detr(ig,k),fm(ig,k),entr(ig,k)
           !test
-          if (detr(ig, k)<0.) THEN
+          IF (detr(ig, k)<0.) THEN
             entr(ig, k) = entr(ig, k) - detr(ig, k)
             detr(ig, k) = 0.
@@ -81,8 +81,8 @@
             !     s         'f+1=',fm(ig,k+1),'e=',entr(ig,k),'d=',detr(ig,k)
           endif
-          if (fm(ig, k + 1)<0.) THEN
+          IF (fm(ig, k + 1)<0.) THEN
             !               PRINT*,'fm2<0!!!'
           endif
-          if (entr(ig, k)<0.) THEN
+          IF (entr(ig, k)<0.) THEN
             !               PRINT*,'entr2<0!!!'
           endif
@@ -97,5 +97,5 @@
       do k = 2, nlay
         do ig = 1, ngrid
-          if ((fm(ig, k + 1) + detr(ig, k)) * ptimestep>  &
+          IF ((fm(ig, k + 1) + detr(ig, k)) * ptimestep>  &
                   1.e-5 * masse(ig, k)) THEN
             qa(ig, k) = (fm(ig, k) * qa(ig, k - 1) + entr(ig, k) * q(ig, k))  &
@@ -104,8 +104,8 @@
             qa(ig, k) = q(ig, k)
           endif
-          if (qa(ig, k)<0.) THEN
+          IF (qa(ig, k)<0.) THEN
             !               PRINT*,'qa<0!!!'
           endif
-          if (q(ig, k)<0.) THEN
+          IF (q(ig, k)<0.) THEN
             !               PRINT*,'q<0!!!'
           endif
@@ -121,5 +121,5 @@
 
       ! Trace species evolution
-      if (impl==0) THEN
+      IF (impl==0) THEN
         do k = 1, nlay - 1
           q(:, k) = q(:, k) + (fqa(:, k) - fqa(:, k + 1) - fm(:, k) * q(:, k) + fm(:, k + 1) * q(:, k + 1)) &
@@ -170,23 +170,23 @@
     !=======================================================================
 
-    integer ngrid, nlay, impl
-
-    real ptimestep
-    real masse(ngrid, nlay), fm(ngrid, nlay + 1)
-    real entr(ngrid, nlay)
-    real q(ngrid, nlay)
-    real dq(ngrid, nlay)
-    integer lev_out                           ! niveau pour les print
-
-    real qa(ngrid, nlay), detr(ngrid, nlay), wqd(ngrid, nlay + 1)
-
-    real zzm
-
-    integer ig, k
-    real cfl
-
-    real qold(ngrid, nlay)
-    real ztimestep
-    integer niter, iter
+    INTEGER ngrid, nlay, impl
+
+    REAL ptimestep
+    REAL masse(ngrid, nlay), fm(ngrid, nlay + 1)
+    REAL entr(ngrid, nlay)
+    REAL q(ngrid, nlay)
+    REAL dq(ngrid, nlay)
+    INTEGER lev_out                           ! niveau pour les print
+
+    REAL qa(ngrid, nlay), detr(ngrid, nlay), wqd(ngrid, nlay + 1)
+
+    REAL zzm
+
+    INTEGER ig, k
+    REAL cfl
+
+    REAL qold(ngrid, nlay)
+    REAL ztimestep
+    INTEGER niter, iter
     CHARACTER (LEN = 20) :: modname = 'thermcell_dq'
     CHARACTER (LEN = 80) :: abort_message
@@ -200,5 +200,5 @@
         zzm = masse(ig, k) / ptimestep
         cfl = max(cfl, fm(ig, k) / zzm)
-        if (entr(ig, k)>zzm) THEN
+        IF (entr(ig, k)>zzm) THEN
           PRINT*, 'entr*dt>m,2', k, entr(ig, k) * ptimestep, masse(ig, k)
           abort_message = 'entr dt > m, 2nd'
@@ -222,5 +222,5 @@
 
     DO iter = 1, niter
-      if (prt_level>=1) PRINT*, 'Q2 THERMCEL_DQ 0'
+      IF (prt_level>=1) PRINT*, 'Q2 THERMCEL_DQ 0'
 
       !   calcul du detrainement
@@ -230,5 +230,5 @@
           !           PRINT*,'Q2 DQ ',detr(ig,k),fm(ig,k),entr(ig,k)
           !test
-          if (detr(ig, k)<0.) THEN
+          IF (detr(ig, k)<0.) THEN
             entr(ig, k) = entr(ig, k) - detr(ig, k)
             detr(ig, k) = 0.
@@ -236,8 +236,8 @@
             !     s         'f+1=',fm(ig,k+1),'e=',entr(ig,k),'d=',detr(ig,k)
           endif
-          if (fm(ig, k + 1)<0.) THEN
+          IF (fm(ig, k + 1)<0.) THEN
             !               PRINT*,'fm2<0!!!'
           endif
-          if (entr(ig, k)<0.) THEN
+          IF (entr(ig, k)<0.) THEN
             !               PRINT*,'entr2<0!!!'
           endif
@@ -252,5 +252,5 @@
       do k = 2, nlay
         do ig = 1, ngrid
-          if ((fm(ig, k + 1) + detr(ig, k)) * ztimestep>  &
+          IF ((fm(ig, k + 1) + detr(ig, k)) * ztimestep>  &
                   1.e-5 * masse(ig, k)) THEN
             qa(ig, k) = (fm(ig, k) * qa(ig, k - 1) + entr(ig, k) * q(ig, k))  &
@@ -259,8 +259,8 @@
             qa(ig, k) = q(ig, k)
           endif
-          if (qa(ig, k)<0.) THEN
+          IF (qa(ig, k)<0.) THEN
             !               PRINT*,'qa<0!!!'
           endif
-          if (q(ig, k)<0.) THEN
+          IF (q(ig, k)<0.) THEN
             !               PRINT*,'q<0!!!'
           endif
@@ -281,5 +281,5 @@
           ! Schema avec advection sur plus qu'une maille.
           zzm = masse(ig, k) / ztimestep
-          if (fm(ig, k)>zzm) THEN
+          IF (fm(ig, k)>zzm) THEN
             wqd(ig, k) = zzm * q(ig, k) + (fm(ig, k) - zzm) * q(ig, k + 1)
           else
@@ -291,5 +291,5 @@
 #endif
 
-          if (wqd(ig, k)<0.) THEN
+          IF (wqd(ig, k)<0.) THEN
             !               PRINT*,'wqd<0!!!'
           endif
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dry.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dry.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dry.F90	(revision 5117)
@@ -20,8 +20,8 @@
        IMPLICIT NONE
 
-       integer, intent(in) :: ngrid,nlay
-       real, intent(in), dimension(ngrid,nlay+1) :: zlev,pphi,ztv,alim_star
-       integer, intent(in), dimension(ngrid) :: lalim
-       real, intent(out), dimension(ngrid) :: zmax,wmax
+       INTEGER, INTENT(IN) :: ngrid,nlay
+       REAL, INTENT(IN), DIMENSION(ngrid,nlay+1) :: zlev,pphi,ztv,alim_star
+       INTEGER, INTENT(IN), DIMENSION(ngrid) :: lalim
+       REAL, INTENT(OUT), DIMENSION(ngrid) :: zmax,wmax
 
 !variables locales
@@ -73,5 +73,5 @@
        do l=1,nlay-2
          do ig=1,ngrid
-            if (l==lmin(ig).and.lalim(ig)>1) THEN
+            IF (l==lmin(ig).AND.lalim(ig)>1) THEN
 !------------------------------------------------------------------------
 !  Calcul de la vitesse en haut de la premiere couche instable.
@@ -92,5 +92,5 @@
 !------------------------------------------------------------------------
 
-            else if (zw2(ig,l)>=1e-10) THEN
+            ELSE IF (zw2(ig,l)>=1e-10) THEN
                ztva(ig,l)=(f_star(ig,l)*ztva(ig,l-1)+alim_star(ig,l)  &
                       *ztv(ig,l))/f_star(ig,l+1)
@@ -102,5 +102,5 @@
 !------------------------------------------------------------------------
 
-            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1)<1.e-10) THEN
+            IF (zw2(ig,l+1)>0. .AND. zw2(ig,l+1)<1.e-10) THEN
 !               stop 'On tombe sur le cas particulier de thermcell_dry'
 !               PRINT*,'On tombe sur le cas particulier de thermcell_dry'
@@ -110,5 +110,5 @@
             endif
 
-            if (zw2(ig,l+1)<0.) THEN
+            IF (zw2(ig,l+1)<0.) THEN
                linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
              -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
@@ -126,5 +126,5 @@
                wa_moy(ig,l+1)=sqrt(zw2(ig,l+1))
 
-            if (wa_moy(ig,l+1)>wmaxa(ig)) THEN
+            IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
 !   lmix est le niveau de la couche ou w (wa_moy) est maximum
                lmix(ig)=l+1
@@ -133,5 +133,5 @@
          enddo
       enddo
-       if (prt_level>=1) PRINT*,'fin calcul zw2'
+       IF (prt_level>=1) PRINT*,'fin calcul zw2'
 
 ! Determination de zw2 max
@@ -142,5 +142,5 @@
       do l=1,nlay
          do ig=1,ngrid
-            if (l<=lmax(ig)) THEN
+            IF (l<=lmax(ig)) THEN
                 zw2(ig,l)=sqrt(zw2(ig,l))
                 wmax(ig)=max(wmax(ig),zw2(ig,l))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dtke.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dtke.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dtke.F90	(revision 5117)
@@ -15,20 +15,20 @@
 !=======================================================================
 
-      integer, intent(in) :: ngrid,nlay,nsrf
-      real, intent(in) :: ptimestep
-      real, dimension(ngrid,nlay), intent(in) :: entr0
-      real, dimension(ngrid,nlay+1), intent(in) :: fm0,pplev
-      real, intent(in) :: rg
-      real, intent(inout) :: tke(ngrid,nlay+1,nsrf)
+      INTEGER, INTENT(IN) :: ngrid,nlay,nsrf
+      REAL, INTENT(IN) :: ptimestep
+      REAL, DIMENSION(ngrid,nlay), INTENT(IN) :: entr0
+      REAL, DIMENSION(ngrid,nlay+1), INTENT(IN) :: fm0,pplev
+      REAL, INTENT(IN) :: rg
+      REAL, INTENT(INOUT) :: tke(ngrid,nlay+1,nsrf)
 
-      real, dimension(ngrid,nlay) :: masse0,detr0, masse,entr,detr
-      real, dimension(ngrid,nlay+1) :: fm,wqd,q,qa
-      integer lev_out                           ! niveau pour les print
+      REAL, DIMENSION(ngrid,nlay) :: masse0,detr0, masse,entr,detr
+      REAL, DIMENSION(ngrid,nlay+1) :: fm,wqd,q,qa
+      INTEGER lev_out                           ! niveau pour les print
 
 
       REAL :: zzm
 
-      integer ig,k
-      integer isrf
+      INTEGER ig,k
+      INTEGER isrf
 
 
@@ -37,5 +37,5 @@
 !PRINT*,'thermcell_dtke'
 
-      if (prt_level>=1) PRINT*,'Q2 THERMCEL_DQ 0'
+      IF (prt_level>=1) PRINT*,'Q2 THERMCEL_DQ 0'
 
 !   calcul du detrainement
@@ -70,8 +70,8 @@
 
 
-    if (1==1) THEN
+    IF (1==1) THEN
       do k=2,nlay
          do ig=1,ngrid
-            if ((fm(ig,k+1)+detr(ig,k))*ptimestep>  &
+            IF ((fm(ig,k+1)+detr(ig,k))*ptimestep>  &
            1.e-5*masse(ig,k)) THEN
          qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))  &
@@ -80,8 +80,8 @@
                qa(ig,k)=q(ig,k)
             endif
-            if (qa(ig,k)<0.) THEN
+            IF (qa(ig,k)<0.) THEN
 !               PRINT*,'qa<0!!!'
             endif
-            if (q(ig,k)<0.) THEN
+            IF (q(ig,k)<0.) THEN
 !               PRINT*,'q<0!!!'
             endif
@@ -94,5 +94,5 @@
          do ig=1,ngrid
             wqd(ig,k)=fm(ig,k)*q(ig,k)
-            if (wqd(ig,k)<0.) THEN
+            IF (wqd(ig,k)<0.) THEN
 !               PRINT*,'wqd<0!!!'
             endif
@@ -114,5 +114,5 @@
       enddo
 
- endif
+ END IF
 
    tke(:,:,isrf)=q(:,:)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dv2.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dv2.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dv2.F90	(revision 5117)
@@ -19,28 +19,28 @@
 
 
-      integer ngrid,nlay
+      INTEGER ngrid,nlay
 
-      real ptimestep
-      real masse(ngrid,nlay),fm(ngrid,nlay+1)
-      real fraca(ngrid,nlay+1)
-      real larga(ngrid)
-      real entr(ngrid,nlay)
-      real u(ngrid,nlay)
-      real ua(ngrid,nlay)
-      real du(ngrid,nlay)
-      real v(ngrid,nlay)
-      real va(ngrid,nlay)
-      real dv(ngrid,nlay)
-      integer lev_out                           ! niveau pour les print
+      REAL ptimestep
+      REAL masse(ngrid,nlay),fm(ngrid,nlay+1)
+      REAL fraca(ngrid,nlay+1)
+      REAL larga(ngrid)
+      REAL entr(ngrid,nlay)
+      REAL u(ngrid,nlay)
+      REAL ua(ngrid,nlay)
+      REAL du(ngrid,nlay)
+      REAL v(ngrid,nlay)
+      REAL va(ngrid,nlay)
+      REAL dv(ngrid,nlay)
+      INTEGER lev_out                           ! niveau pour les print
 
-      real qa(ngrid,nlay),detr(ngrid,nlay),zf,zf2
-      real wvd(ngrid,nlay+1),wud(ngrid,nlay+1)
-      real gamma0(ngrid,nlay+1),gamma(ngrid,nlay+1)
-      real ue(ngrid,nlay),ve(ngrid,nlay)
+      REAL qa(ngrid,nlay),detr(ngrid,nlay),zf,zf2
+      REAL wvd(ngrid,nlay+1),wud(ngrid,nlay+1)
+      REAL gamma0(ngrid,nlay+1),gamma(ngrid,nlay+1)
+      REAL ue(ngrid,nlay),ve(ngrid,nlay)
       LOGICAL ltherm(ngrid,nlay)
-      real dua(ngrid,nlay),dva(ngrid,nlay)
-      integer iter
+      REAL dua(ngrid,nlay),dva(ngrid,nlay)
+      INTEGER iter
 
-      integer ig,k,nlarga0
+      INTEGER ig,k,nlarga0
 
 !-------------------------------------------------------------------------
@@ -73,5 +73,5 @@
          do ig=1,ngrid
             ltherm(ig,k)=(fm(ig,k+1)+detr(ig,k))*ptimestep > 1.e-5*masse(ig,k)
-            IF(ltherm(ig,k).and.larga(ig)>0.) THEN
+            IF(ltherm(ig,k).AND.larga(ig)>0.) THEN
                gamma0(ig,k)=masse(ig,k)  &
            *sqrt( 0.5*(fraca(ig,k+1)+fraca(ig,k)) )  &
@@ -81,5 +81,5 @@
                gamma0(ig,k)=0.
             endif
-            if (ltherm(ig,k).and.larga(ig)<=0.) nlarga0=nlarga0+1
+            IF (ltherm(ig,k).AND.larga(ig)<=0.) nlarga0=nlarga0+1
          enddo
       enddo
@@ -90,5 +90,5 @@
 
          do ig=1,ngrid
-            if (ltherm(ig,k)) THEN
+            IF (ltherm(ig,k)) THEN
                dua(ig,k)=ua(ig,k-1)-u(ig,k-1)
                dva(ig,k)=va(ig,k-1)-v(ig,k-1)
@@ -116,5 +116,5 @@
 !  par le module du vent dans la couche en dessous.
 !  Mais pourquoi donc ???
-               if (ltherm(ig,k)) THEN
+               IF (ltherm(ig,k)) THEN
 !   On choisit une relaxation lineaire.
 !                 gamma(ig,k)=gamma0(ig,k)
@@ -187,5 +187,5 @@
    endif
 
-     if (nlarga0>0) THEN
+     IF (nlarga0>0) THEN
           PRINT*,'WARNING !!!!!! DANS THERMCELL_DV2 '
           PRINT*,nlarga0,' points pour lesquels laraga=0. dans un thermique'
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_env.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_env.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_env.F90	(revision 5117)
@@ -17,16 +17,16 @@
 ! arguments
 
-   integer,intent(in) :: ngrid,nlay,lev_out
-   real,intent(in), dimension(ngrid,nlay) :: po,pt,pu,pv,pplay
-   real,intent(in), dimension(ngrid,nlay+1) :: pplev
-   real,intent(out), dimension(ngrid,nlay) :: zo,zl,zh,ztv,zthl
-   real,intent(out), dimension(ngrid,nlay) :: zpspsk,zu,zv,pqsat
-   real, intent(out), dimension(ngrid) :: lintercong
-   integer, intent(out), dimension(ngrid) :: lcong   
+   INTEGER,INTENT(IN) :: ngrid,nlay,lev_out
+   REAL,INTENT(IN), DIMENSION(ngrid,nlay) :: po,pt,pu,pv,pplay
+   REAL,INTENT(IN), DIMENSION(ngrid,nlay+1) :: pplev
+   REAL,INTENT(OUT), DIMENSION(ngrid,nlay) :: zo,zl,zh,ztv,zthl
+   REAL,INTENT(OUT), DIMENSION(ngrid,nlay) :: zpspsk,zu,zv,pqsat
+   REAL, INTENT(OUT), DIMENSION(ngrid) :: lintercong
+   INTEGER, INTENT(OUT), DIMENSION(ngrid) :: lcong
 ! Local
 
-   integer ig,ll
-   real dqsat_dT
-   logical mask(ngrid,nlay)
+   INTEGER ig,ll
+   REAL dqsat_dT
+   LOGICAL mask(ngrid,nlay)
 
 
@@ -60,5 +60,5 @@
 
 !-----------------------------------------------------------------------
-   if (prt_level>=1) PRINT*,'0 OK convect8'
+   IF (prt_level>=1) PRINT*,'0 OK convect8'
 
    do ll=1,nlay
@@ -85,5 +85,5 @@
    do ig=1,ngrid
       do ll=1,nlay-1
-         if ((zh(ig,ll)>273.15).and.(zh(ig,ll+1)<=273.15)) THEN
+         IF ((zh(ig,ll)>273.15).AND.(zh(ig,ll+1)<=273.15)) THEN
             lcong(ig)=ll+1
             lintercong(ig)=(ll*(zh(ig,ll+1)-zh(ig,ll))  &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_flux2.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_flux2.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_flux2.F90	(revision 5117)
@@ -21,28 +21,28 @@
 
     ! arguments
-    INTEGER, intent(in) :: ngrid, nlay
-    REAL, intent(in) :: ptimestep
-    REAL, intent(in), dimension(ngrid, nlay) :: masse
-    INTEGER, intent(in), dimension(ngrid) :: lalim, lmax
-    REAL, intent(in), dimension(ngrid, nlay) :: alim_star, entr_star, detr_star
-    REAL, intent(in), dimension(ngrid) :: f
-    REAL, intent(in), dimension(ngrid, nlay) :: rhobarz
-    REAL, intent(in), dimension(ngrid, nlay + 1) :: zw2, zlev
+    INTEGER, INTENT(IN) :: ngrid, nlay
+    REAL, INTENT(IN) :: ptimestep
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: masse
+    INTEGER, INTENT(IN), DIMENSION(ngrid) :: lalim, lmax
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: alim_star, entr_star, detr_star
+    REAL, INTENT(IN), DIMENSION(ngrid) :: f
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: rhobarz
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay + 1) :: zw2, zlev
     ! FH : laisser ca le temps de verifier qu'on a bien fait de commenter les
     !      lignes faisant apparaitre zqla, zmax ...
-    !     REAL, intent(in), dimension(ngrid) :: zmax(ngrid)
+    !     REAL, INTENT(IN), DIMENSION(ngrid) :: zmax(ngrid)
     !     enlever aussi zqla
-    REAL, intent(in), dimension(ngrid, nlay) :: zqla  ! not used
-    integer, intent(in) :: lev_out, lunout1
-
-    REAL, intent(out), dimension(ngrid, nlay) :: entr, detr
-    REAL, intent(out), dimension(ngrid, nlay + 1) :: fm
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: zqla  ! not used
+    INTEGER, INTENT(IN) :: lev_out, lunout1
+
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: entr, detr
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay + 1) :: fm
 
     ! local
     INTEGER ig, l
-    integer igout, lout
+    INTEGER igout, lout
     REAL zfm
-    integer ncorecfm1, ncorecfm2, ncorecfm3, ncorecalpha
-    integer ncorecfm4, ncorecfm5, ncorecfm6, ncorecfm7, ncorecfm8
+    INTEGER ncorecfm1, ncorecfm2, ncorecfm3, ncorecalpha
+    INTEGER ncorecfm4, ncorecfm5, ncorecfm6, ncorecfm7, ncorecfm8
 
     REAL f_old, ddd0, eee0, ddd, eee, zzz
@@ -52,8 +52,8 @@
     !$OMP THREADPRIVATE(fomass_max,alphamax)
 
-    logical check_debug, labort_physic
-
-    character (len = 20) :: modname = 'thermcell_flux2'
-    character (len = 80) :: abort_message
+    LOGICAL check_debug, labort_physic
+
+    CHARACTER (LEN = 20) :: modname = 'thermcell_flux2'
+    CHARACTER (LEN = 80) :: abort_message
 
     ncorecfm1 = 0
@@ -70,5 +70,5 @@
     fm(:, :) = 0.
 
-    if (prt_level>=10) THEN
+    IF (prt_level>=10) THEN
       WRITE(lunout1, *) 'Dans thermcell_flux 0'
       WRITE(lunout1, *) 'flux base ', f(igout)
@@ -90,9 +90,9 @@
     check_debug = .false..or.prt_level>=10
 
-    if (check_debug) THEN
+    IF (check_debug) THEN
       do l = 1, nlay
         do ig = 1, ngrid
-          if (l<=lmax(ig)) THEN
-            if (entr_star(ig, l)>1.) THEN
+          IF (l<=lmax(ig)) THEN
+            IF (entr_star(ig, l)>1.) THEN
               PRINT*, 'WARNING thermcell_flux 1 ig,l,lmax(ig)', ig, l, lmax(ig)
               PRINT*, 'entr_star(ig,l)', entr_star(ig, l)
@@ -101,5 +101,5 @@
             endif
           else
-            if (abs(entr_star(ig, l)) + abs(alim_star(ig, l)) + abs(detr_star(ig, l))>0.) THEN
+            IF (abs(entr_star(ig, l)) + abs(alim_star(ig, l)) + abs(detr_star(ig, l))>0.) THEN
               PRINT*, 'cas 1 : ig,l,lmax(ig)', ig, l, lmax(ig)
               PRINT*, 'entr_star(ig,l)', entr_star(ig, l)
@@ -124,5 +124,5 @@
     enddo
 
-    if (prt_level>=10) THEN
+    IF (prt_level>=10) THEN
       WRITE(lunout1, *) 'Dans thermcell_flux 1'
       WRITE(lunout1, *) 'flux base ', f(igout)
@@ -138,5 +138,5 @@
     do l = 1, nlay
       do ig = 1, ngrid
-        if (l<lmax(ig)) THEN
+        IF (l<lmax(ig)) THEN
           fm(ig, l + 1) = fm(ig, l) + entr(ig, l) - detr(ig, l)
         elseif(l==lmax(ig)) THEN
@@ -157,5 +157,5 @@
     do l = 1, nlay
       do ig = 1, ngrid
-        if (detr(ig, l)>fm(ig, l)) THEN
+        IF (detr(ig, l)>fm(ig, l)) THEN
           ncorecfm8 = ncorecfm8 + 1
           !              igout=ig
@@ -182,5 +182,5 @@
 
       do ig = 1, ngrid
-        if (l<lmax(ig)) THEN
+        IF (l<lmax(ig)) THEN
           fm(ig, l + 1) = fm(ig, l) + entr(ig, l) - detr(ig, l)
         elseif(l==lmax(ig)) THEN
@@ -199,5 +199,5 @@
       !     do l=1,nlay
       do ig = 1, ngrid
-        if (fm(ig, l + 1)<0.) THEN
+        IF (fm(ig, l + 1)<0.) THEN
           !              PRINT*,'fm1<0',l+1,lmax(ig),fm(ig,l+1)
           ncorecfm1 = ncorecfm1 + 1
@@ -208,5 +208,5 @@
       !     enddo
 
-      if (prt_level>=10) &
+      IF (prt_level>=10) &
               WRITE(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &
                       entr(igout, l), detr(igout, l), fm(igout, l + 1)
@@ -215,13 +215,13 @@
       !Test sur fraca croissant
       !-------------------------------------------------------------------------
-      if (iflag_thermals_optflux==0) THEN
+      IF (iflag_thermals_optflux==0) THEN
         !     do l=1,nlay
         do ig = 1, ngrid
-          if (l>=lalim(ig).and.l<=lmax(ig) &
-                  .and.(zw2(ig, l + 1)>1.e-10).and.(zw2(ig, l)>1.e-10)) THEN
+          IF (l>=lalim(ig).AND.l<=lmax(ig) &
+                  .AND.(zw2(ig, l + 1)>1.e-10).AND.(zw2(ig, l)>1.e-10)) THEN
             !  zzz est le flux en l+1 a frac constant
             zzz = fm(ig, l) * rhobarz(ig, l + 1) * zw2(ig, l + 1)  &
                     / (rhobarz(ig, l) * zw2(ig, l))
-            if (fm(ig, l + 1)>zzz) THEN
+            IF (fm(ig, l + 1)>zzz) THEN
               detr(ig, l) = detr(ig, l) + fm(ig, l + 1) - zzz
               fm(ig, l + 1) = zzz
@@ -233,5 +233,5 @@
       endif
 
-      if (prt_level>=10) &
+      IF (prt_level>=10) &
               WRITE(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &
                       entr(igout, l), detr(igout, l), fm(igout, l + 1)
@@ -241,8 +241,8 @@
       !test sur flux de masse croissant
       !-------------------------------------------------------------------------
-      if (iflag_thermals_optflux==0) THEN
+      IF (iflag_thermals_optflux==0) THEN
         !     do l=1,nlay
         do ig = 1, ngrid
-          if ((fm(ig, l + 1)>fm(ig, l)).and.(l>lalim(ig))) THEN
+          IF ((fm(ig, l + 1)>fm(ig, l)).AND.(l>lalim(ig))) THEN
             f_old = fm(ig, l + 1)
             fm(ig, l + 1) = fm(ig, l)
@@ -254,9 +254,9 @@
       endif
 
-      if (prt_level>=10) &
+      IF (prt_level>=10) &
               WRITE(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &
                       entr(igout, l), detr(igout, l), fm(igout, l + 1)
 
-      !fin 1.eq.0
+      !fin 1.EQ.0
       !-------------------------------------------------------------------------
       !detr ne peut pas etre superieur a fm
@@ -268,5 +268,5 @@
         labort_physic = .FALSE.
         do ig = 1, ngrid
-          if (entr(ig, l)<0.) THEN
+          IF (entr(ig, l)<0.) THEN
             labort_physic = .TRUE.
             igout = ig
@@ -275,5 +275,5 @@
         enddo
 
-        if (labort_physic) THEN
+        IF (labort_physic) THEN
           PRINT*, 'N1 ig,l,entr', igout, lout, entr(igout, lout)
           abort_message = 'entr negatif'
@@ -282,5 +282,5 @@
 
         do ig = 1, ngrid
-          if (detr(ig, l)>fm(ig, l)) THEN
+          IF (detr(ig, l)>fm(ig, l)) THEN
             ncorecfm6 = ncorecfm6 + 1
             detr(ig, l) = fm(ig, l)
@@ -308,10 +308,10 @@
         labort_physic = .FALSE.
         do ig = 1, ngrid
-          if (entr(ig, l)<0.) THEN
+          IF (entr(ig, l)<0.) THEN
             labort_physic = .TRUE.
             igout = ig
           endif
         enddo
-        if (labort_physic) THEN
+        IF (labort_physic) THEN
           ig = igout
           PRINT*, 'ig,l,lmax(ig)', ig, l, lmax(ig)
@@ -326,5 +326,5 @@
       endif
 
-      if (prt_level>=10) &
+      IF (prt_level>=10) &
               WRITE(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &
                       entr(igout, l), detr(igout, l), fm(igout, l + 1)
@@ -336,5 +336,5 @@
       !     do l=1,nlay
       do ig = 1, ngrid
-        if (fm(ig, l + 1)<0.) THEN
+        IF (fm(ig, l + 1)<0.) THEN
           detr(ig, l) = detr(ig, l) + fm(ig, l + 1)
           fm(ig, l + 1) = 0.
@@ -345,10 +345,10 @@
       labort_physic = .FALSE.
       do ig = 1, ngrid
-        if (detr(ig, l)<0.) THEN
+        IF (detr(ig, l)<0.) THEN
           labort_physic = .TRUE.
           igout = ig
         endif
       enddo
-      if (labort_physic) THEN
+      IF (labort_physic) THEN
         ig = igout
         PRINT*, 'cas 2 : ig,l,lmax(ig)', ig, l, lmax(ig)
@@ -360,5 +360,5 @@
       !    enddo
 
-      if (prt_level>=10) &
+      IF (prt_level>=10) &
               WRITE(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &
                       entr(igout, l), detr(igout, l), fm(igout, l + 1)
@@ -385,7 +385,7 @@
       !    do l=1,nlay
       do ig = 1, ngrid
-        if (zw2(ig, l + 1)>1.e-10) THEN
+        IF (zw2(ig, l + 1)>1.e-10) THEN
           zfm = rhobarz(ig, l + 1) * zw2(ig, l + 1) * alphamax
-          if (fm(ig, l + 1) > zfm) THEN
+          IF (fm(ig, l + 1) > zfm) THEN
             f_old = fm(ig, l + 1)
             fm(ig, l + 1) = zfm
@@ -400,5 +400,5 @@
       !    enddo
 
-      if (prt_level>=10) &
+      IF (prt_level>=10) &
               WRITE(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &
                       entr(igout, l), detr(igout, l), fm(igout, l + 1)
@@ -417,5 +417,5 @@
     !-----------------------------------------------------------------------
 
-    if (1==1) THEN
+    IF (1==1) THEN
       labort_physic = .FALSE.
       do l = 1, nlay - 1
@@ -425,8 +425,8 @@
           eee = entr(ig, l) - masse(ig, l) * fomass_max / ptimestep
           ddd = detr(ig, l) - eee
-          if (eee>0.) THEN
+          IF (eee>0.) THEN
             ncorecfm3 = ncorecfm3 + 1
             entr(ig, l) = entr(ig, l) - eee
-            if (ddd>0.) THEN
+            IF (ddd>0.) THEN
               !   l'entrainement est trop fort mais l'exces peut etre compense par une
               !   diminution du detrainement)
@@ -438,5 +438,5 @@
                 detr(ig, l) = fm(ig, l) + entr(ig, l)
               else
-                IF(l>=lmax(ig).and.0==1) THEN
+                IF(l>=lmax(ig).AND.0==1) THEN
                   igout = ig
                   lout = l
@@ -452,5 +452,5 @@
         enddo
       enddo
-      if (labort_physic) THEN
+      IF (labort_physic) THEN
         ig = igout
         l = lout
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_height.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_height.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_height.F90	(revision 5117)
@@ -13,17 +13,17 @@
 
 ! Entree
-      integer, intent(in) :: ngrid,nlay
-      real, intent(in), dimension(ngrid) :: linter,lintercong
-      real, intent(in), dimension(ngrid,nlay+1) :: zlev
+      INTEGER, INTENT(IN) :: ngrid,nlay
+      REAL, INTENT(IN), DIMENSION(ngrid) :: linter,lintercong
+      REAL, INTENT(IN), DIMENSION(ngrid,nlay+1) :: zlev
 ! Sortie
-      real, intent(out), dimension(ngrid) :: wmax,zmax,zmax0,zmix,zcong
-      integer, intent(out), dimension(ngrid) :: lmax,lcong
+      REAL, INTENT(OUT), DIMENSION(ngrid) :: wmax,zmax,zmax0,zmix,zcong
+      INTEGER, INTENT(OUT), DIMENSION(ngrid) :: lmax,lcong
 ! Les deux
-     integer, intent(inout), dimension(ngrid) :: lmix,lalim,lmin
-     real, intent(inout), dimension(ngrid,nlay+1) :: zw2
+     INTEGER, INTENT(INOUT), DIMENSION(ngrid) :: lmix,lalim,lmin
+     REAL, INTENT(INOUT), DIMENSION(ngrid,nlay+1) :: zw2
 
 ! local
-     real, dimension(ngrid) :: num,denom,zlevinter,zlevintercong
-     integer ig,l
+     REAL, DIMENSION(ngrid) :: num,denom,zlevinter,zlevintercong
+     INTEGER ig,l
 
 !calcul de la hauteur max du thermique
@@ -33,5 +33,5 @@
       do ig=1,ngrid
          do l=nlay,lalim(ig)+1,-1
-            if (zw2(ig,l)<=1.e-10) THEN
+            IF (zw2(ig,l)<=1.e-10) THEN
                lmax(ig)=l-1
             endif
@@ -42,5 +42,5 @@
 ! atteind le haut du modele ...
       do ig=1,ngrid
-      if ( zw2(ig,nlay) > 1.e-10 ) THEN
+      IF ( zw2(ig,nlay) > 1.e-10 ) THEN
           PRINT*,'WARNING !!!!! W2 thermiques non nul derniere couche '
           lmax(ig)=nlay
@@ -50,5 +50,5 @@
 ! pas de thermique si couche 1 stable
       do ig=1,ngrid
-         if (lmin(ig)>1) THEN
+         IF (lmin(ig)>1) THEN
              lmax(ig)=1
              lmin(ig)=1
@@ -64,6 +64,6 @@
       do l=1,nlay
          do ig=1,ngrid
-            if (l<=lmax(ig)) THEN
-                if (zw2(ig,l)<0.)THEN
+            IF (l<=lmax(ig)) THEN
+                IF (zw2(ig,l)<0.)THEN
                   PRINT*,'pb2 zw2<0'
                 endif
@@ -83,5 +83,5 @@
 
 !     if (iflag_thermals_ed.ge.1) THEN
-      if (1==0) THEN
+      IF (1==0) THEN
 !CR:date de quand le calcul du zmax continu etait buggue 
          num(:)=0.
@@ -94,5 +94,5 @@
        enddo
        do ig=1,ngrid
-       if (denom(ig)>1.e-10) THEN
+       IF (denom(ig)>1.e-10) THEN
           zmax(ig)=2.*num(ig)/denom(ig)
           zmax0(ig)=zmax(ig)
@@ -128,7 +128,7 @@
 ! def de  zmix continu (profil parabolique des vitesses)
       do ig=1,ngrid
-           if (lmix(ig)>1) THEN
+           IF (lmix(ig)>1) THEN
 ! test 
-              if (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))  &
+              IF (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))  &
           *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))  &
           -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))  &
@@ -151,5 +151,5 @@
           endif
 !test
-         if ((zmax(ig)-zmix(ig))<=0.) THEN
+         IF ((zmax(ig)-zmix(ig))<=0.) THEN
             zmix(ig)=0.9*zmax(ig)
 !            PRINT*,'pb zmix>zmax'
@@ -160,5 +160,5 @@
       do ig=1,ngrid
          do l=1,nlay
-            if (zmix(ig)>=zlev(ig,l).and.  &
+            IF (zmix(ig)>=zlev(ig,l).AND.  &
             zmix(ig)<zlev(ig,l+1)) THEN
               lmix(ig)=l
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_ini.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_ini.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_ini.F90	(revision 5117)
@@ -3,5 +3,5 @@
 IMPLICIT NONE
 
-integer, protected :: dvdq=1,dqimpl=-1,prt_level=0,lunout
+INTEGER, protected :: dvdq=1,dqimpl=-1,prt_level=0,lunout
 real   , protected :: RG,RD,RCPD,RKAPPA,RLVTT,RLvCp,RETV
 
@@ -11,22 +11,22 @@
 
 ! Parameters that can be modified directly by a getin call
-real,    protected :: r_aspect_thermals=2.       ! Aspect ratio for thermal celles
-real,    protected :: tau_thermals = 0.          ! relaxation time constant
-real,    protected :: fact_thermals_ed_dz = 0.1  ! bouyancy computed with a delta
-real,    protected :: betalpha=0.9               !
-real,    protected :: afact=2./3.                !
-real,    protected :: fact_shell=1.              !
-real,    protected :: detr_min=1.e-5             !
-real,    protected :: entr_min=1.e-5             !
-real,    protected :: detr_q_coef=0.012          !
-real,    protected :: detr_q_power=0.5           !
-real,    protected :: mix0=0.                    !
-integer, protected :: iflag_thermals_ed = 0      !
-integer, protected :: iflag_thermals_optflux = 0 !
-integer, protected :: iflag_thermals_closure = 1 !
-integer, protected :: iflag_thermals_down = 0    !
-real, protected    :: fact_thermals_down = 0.5   !
-integer, protected :: thermals_flag_alim=0       !
-integer, protected :: iflag_thermals_tenv=0      ! 
+REAL,    protected :: r_aspect_thermals=2.       ! Aspect ratio for thermal celles
+REAL,    protected :: tau_thermals = 0.          ! relaxation time constant
+REAL,    protected :: fact_thermals_ed_dz = 0.1  ! bouyancy computed with a delta
+REAL,    protected :: betalpha=0.9               !
+REAL,    protected :: afact=2./3.                !
+REAL,    protected :: fact_shell=1.              !
+REAL,    protected :: detr_min=1.e-5             !
+REAL,    protected :: entr_min=1.e-5             !
+REAL,    protected :: detr_q_coef=0.012          !
+REAL,    protected :: detr_q_power=0.5           !
+REAL,    protected :: mix0=0.                    !
+INTEGER, protected :: iflag_thermals_ed = 0      !
+INTEGER, protected :: iflag_thermals_optflux = 0 !
+INTEGER, protected :: iflag_thermals_closure = 1 !
+INTEGER, protected :: iflag_thermals_down = 0    !
+REAL, protected    :: fact_thermals_down = 0.5   !
+INTEGER, protected :: thermals_flag_alim=0       !
+INTEGER, protected :: iflag_thermals_tenv=0      !
 
    ! WARNING !!! fact_epsilon is not protected. It can be modified in thermcell_plume*
@@ -52,9 +52,9 @@
    USE lmdz_ioipsl_getin_p, ONLY: getin_p
 
-integer, intent(in) :: iflag_thermals,prt_level_in,lunout_in
-real, intent(in) :: RG_in,RD_in,RCPD_in,RKAPPA_in,RLVTT_in,RETV_in,tau_thermals_in
+INTEGER, INTENT(IN) :: iflag_thermals,prt_level_in,lunout_in
+REAL, INTENT(IN) :: RG_in,RD_in,RCPD_in,RKAPPA_in,RLVTT_in,RETV_in,tau_thermals_in
 
 PRINT*,'thermcell_ini'
-      if (iflag_thermals==15.or.iflag_thermals==16) THEN
+      IF (iflag_thermals==15.OR.iflag_thermals==16) THEN
          dvdq=0
          dqimpl=-1
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_main.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_main.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_main.F90	(revision 5117)
@@ -114,59 +114,59 @@
     !   arguments:
     !   ----------
-    integer, intent(in) :: itap, ngrid, nlay
-    real, intent(in) :: ptimestep
-    real, intent(in), dimension(ngrid, nlay) :: ptemp, puwind, pvwind, pplay, pphi, ptemp_env, po_env
+    INTEGER, INTENT(IN) :: itap, ngrid, nlay
+    REAL, INTENT(IN) :: ptimestep
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: ptemp, puwind, pvwind, pplay, pphi, ptemp_env, po_env
     ! ATTENTION : zpspsk est inout et out mais c'est pas forcement pour de bonnes raisons (FH, 2023)
-    real, intent(in), dimension(ngrid, nlay) :: p_o
-    real, intent(out), dimension(ngrid, nlay) :: zpspsk
-    real, intent(in), dimension(ngrid, nlay + 1) :: pplev
-    integer, intent(out), dimension(ngrid) :: lmax
-    real, intent(out), dimension(ngrid, nlay) :: pdtadj, pduadj, pdvadj, pdoadj, entr0, detr0
-    real, intent(out), dimension(ngrid, nlay) :: ztla, zqla, zqta, zqsatth, zthl
-    real, intent(out), dimension(ngrid, nlay + 1) :: fm0, zw2, fraca
-    real, intent(inout), dimension(ngrid) :: zmax0, f0
-    real, intent(out), dimension(ngrid, nlay) :: ztva, ztv
-    logical, intent(in) :: debut
-    real, intent(out), dimension(ngrid, nlay) :: ratqscth, ratqsdiff
-
-    real, intent(out), dimension(ngrid) :: pcon
-    real, intent(out), dimension(ngrid, nlay) :: rhobarz, wth3
-    real, intent(out), dimension(ngrid) :: wmax_sec
-    integer, intent(out), dimension(ngrid) :: lalim
-    real, intent(out), dimension(ngrid, nlay + 1) :: fm
-    real, intent(out), dimension(ngrid, nlay) :: alim_star
-    real, intent(out), dimension(ngrid) :: zmax, zcong
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: p_o
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: zpspsk
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay + 1) :: pplev
+    INTEGER, INTENT(OUT), DIMENSION(ngrid) :: lmax
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: pdtadj, pduadj, pdvadj, pdoadj, entr0, detr0
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: ztla, zqla, zqta, zqsatth, zthl
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay + 1) :: fm0, zw2, fraca
+    REAL, INTENT(INOUT), DIMENSION(ngrid) :: zmax0, f0
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: ztva, ztv
+    logical, INTENT(IN) :: debut
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: ratqscth, ratqsdiff
+
+    REAL, INTENT(OUT), DIMENSION(ngrid) :: pcon
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: rhobarz, wth3
+    REAL, INTENT(OUT), DIMENSION(ngrid) :: wmax_sec
+    INTEGER, INTENT(OUT), DIMENSION(ngrid) :: lalim
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay + 1) :: fm
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: alim_star
+    REAL, INTENT(OUT), DIMENSION(ngrid) :: zmax, zcong
 
     !   local:
     !   ------
 
-    integer, save :: igout = 1
+    INTEGER, save :: igout = 1
     !$OMP THREADPRIVATE(igout)
-    integer, save :: lunout1 = 6
+    INTEGER, save :: lunout1 = 6
     !$OMP THREADPRIVATE(lunout1)
-    integer, save :: lev_out = 10
+    INTEGER, save :: lev_out = 10
     !$OMP THREADPRIVATE(lev_out)
 
-    real lambda, zf, zf2, var, vardiff, CHI
-    integer ig, k, l, ierr, ll
-    logical sorties
-    real, dimension(ngrid) :: linter, zmix, zmax_sec, lintercong
-    integer, dimension(ngrid) :: lmin, lmix, lmix_bis, nivcon, lcong
-    real, dimension(ngrid, nlay) :: ztva_est
-    real, dimension(ngrid, nlay) :: deltaz, zlay, zdthladj, zu, zv, z_o, zl, zva, zua, z_oa
-    real, dimension(ngrid, nlay) :: ztemp_env ! temperarure liquide de l'environnement
-    real, dimension(ngrid, nlay) :: zta, zha, q2, wq, wthl, wthv, thetath2, wth2
-    real, dimension(ngrid, nlay) :: rho, masse
-    real, dimension(ngrid, nlay + 1) :: zw_est, zlev
-    real, dimension(ngrid) :: wmax, wmax_tmp
-    real, dimension(ngrid, nlay + 1) :: f_star
-    real, dimension(ngrid, nlay) :: entr, detr, entr_star, detr_star, alim_star_clos
-    real, dimension(ngrid, nlay) :: zqsat, csc
-    real, dimension(ngrid) :: zcon, zcon2, alim_star_tot, f
-    real, dimension(ngrid, nlay) :: entrdn, detrdn
-    logical, dimension(ngrid, nlay) :: mask
-
-    character (len = 20) :: modname = 'thermcell_main'
-    character (len = 80) :: abort_message
+    REAL lambda, zf, zf2, var, vardiff, CHI
+    INTEGER ig, k, l, ierr, ll
+    LOGICAL sorties
+    REAL, DIMENSION(ngrid) :: linter, zmix, zmax_sec, lintercong
+    INTEGER, DIMENSION(ngrid) :: lmin, lmix, lmix_bis, nivcon, lcong
+    REAL, DIMENSION(ngrid, nlay) :: ztva_est
+    REAL, DIMENSION(ngrid, nlay) :: deltaz, zlay, zdthladj, zu, zv, z_o, zl, zva, zua, z_oa
+    REAL, DIMENSION(ngrid, nlay) :: ztemp_env ! temperarure liquide de l'environnement
+    REAL, DIMENSION(ngrid, nlay) :: zta, zha, q2, wq, wthl, wthv, thetath2, wth2
+    REAL, DIMENSION(ngrid, nlay) :: rho, masse
+    REAL, DIMENSION(ngrid, nlay + 1) :: zw_est, zlev
+    REAL, DIMENSION(ngrid) :: wmax, wmax_tmp
+    REAL, DIMENSION(ngrid, nlay + 1) :: f_star
+    REAL, DIMENSION(ngrid, nlay) :: entr, detr, entr_star, detr_star, alim_star_clos
+    REAL, DIMENSION(ngrid, nlay) :: zqsat, csc
+    REAL, DIMENSION(ngrid) :: zcon, zcon2, alim_star_tot, f
+    REAL, DIMENSION(ngrid, nlay) :: entrdn, detrdn
+    logical, DIMENSION(ngrid, nlay) :: mask
+
+    CHARACTER (LEN = 20) :: modname = 'thermcell_main'
+    CHARACTER (LEN = 80) :: abort_message
 
 
@@ -177,5 +177,5 @@
       REAL xtpo_tmp(ngrid,nlay)
       REAL xtzo_tmp(ngrid,nlay)
-      integer ixt
+      INTEGER ixt
 #endif
 
@@ -186,5 +186,5 @@
     fm = 0. ; entr = 0. ; detr = 0.
 
-    if (prt_level>=1) PRINT*, 'thermcell_main V4'
+    IF (prt_level>=1) PRINT*, 'thermcell_main V4'
 
     sorties = .TRUE.
@@ -204,5 +204,5 @@
     enddo
 
-    if (prt_level>=20) THEN
+    IF (prt_level>=20) THEN
       do ig = 1, ngrid
         PRINT*, 'th_main ig f0', ig, f0(ig)
@@ -223,5 +223,5 @@
     ! avec le theta_v effectif de l'environnement.
 
-    if (iflag_thermals_tenv - 10 * (iflag_thermals_tenv / 10) == 0) THEN
+    IF (iflag_thermals_tenv - 10 * (iflag_thermals_tenv / 10) == 0) THEN
       CALL thermcell_env(ngrid, nlay, p_o, ptemp_env, puwind, pvwind, pplay, &
               pplev, z_o, ztemp_env, zl, ztv, zthl, zu, zv, zpspsk, zqsat, lcong, lintercong, lev_out)
@@ -274,5 +274,5 @@
     endif
 
-    if (prt_level>=1) PRINT*, 'thermcell_main apres thermcell_env'
+    IF (prt_level>=1) PRINT*, 'thermcell_main apres thermcell_env'
 
     !------------------------------------------------------------------------
@@ -314,5 +314,5 @@
 
     rho(:, :) = pplay(:, :) / (zpspsk(:, :) * RD * ztv(:, :))
-    if (prt_level>=10) WRITE(lunout, *) 'WARNING thermcell_main rhobarz(:,1)=rho(:,1)'
+    IF (prt_level>=10) WRITE(lunout, *) 'WARNING thermcell_main rhobarz(:,1)=rho(:,1)'
     rhobarz(:, 1) = rho(:, 1)
     do l = 2, nlay
@@ -322,5 +322,5 @@
       masse(:, l) = (pplev(:, l) - pplev(:, l + 1)) / RG
     enddo
-    if (prt_level>=1) PRINT*, 'thermcell_main apres initialisation'
+    IF (prt_level>=1) PRINT*, 'thermcell_main apres initialisation'
 
     !------------------------------------------------------------------
@@ -395,5 +395,5 @@
     !--------------------------------------------------------------------------------
 
-    if (prt_level>=1) PRINT*, 'avant thermcell_plume ', lev_out
+    IF (prt_level>=1) PRINT*, 'avant thermcell_plume ', lev_out
 
     !=====================================================================
@@ -411,5 +411,5 @@
     !=====================================================================
 
-    if (iflag_thermals_ed<=9) THEN
+    IF (iflag_thermals_ed<=9) THEN
       !         PRINT*,'THERM NOUVELLE/NOUVELLE Arnaud'
       CALL thermcell_plume_6A(itap, ngrid, nlay, ptimestep, ztv, zthl, p_o, zl, rhobarz, &
@@ -434,11 +434,11 @@
     endif
 
-    if (prt_level>=1) PRINT*, 'apres thermcell_plume ', lev_out
+    IF (prt_level>=1) PRINT*, 'apres thermcell_plume ', lev_out
 
     CALL test_ltherm(ngrid, nlay, pplay, lalim, ztv, p_o, ztva, zqla, f_star, zw2, 'thermcell_plum lalim ')
     CALL test_ltherm(ngrid, nlay, pplay, lmix, ztv, p_o, ztva, zqla, f_star, zw2, 'thermcell_plum lmix  ')
 
-    if (prt_level>=1) PRINT*, 'thermcell_main apres thermcell_plume'
-    if (prt_level>=10) THEN
+    IF (prt_level>=1) PRINT*, 'thermcell_main apres thermcell_plume'
+    IF (prt_level>=10) THEN
       WRITE(lunout1, *) 'Dans thermcell_main 2'
       WRITE(lunout1, *) 'lmin ', lmin(igout)
@@ -468,5 +468,5 @@
     CALL test_ltherm(ngrid, nlay, pplay, lmax, ztv, p_o, ztva, zqla, f_star, zw2, 'thermcell_heig lmax  ')
 
-    if (prt_level>=1) PRINT*, 'thermcell_main apres thermcell_height'
+    IF (prt_level>=1) PRINT*, 'thermcell_main apres thermcell_height'
 
     !-------------------------------------------------------------------------------
@@ -480,6 +480,6 @@
     CALL test_ltherm(ngrid, nlay, pplay, lalim, ztv, p_o, ztva, zqla, f_star, zw2, 'thermcell_dry  lalim ')
 
-    if (prt_level>=1) PRINT*, 'thermcell_main apres thermcell_dry'
-    if (prt_level>=10) THEN
+    IF (prt_level>=1) PRINT*, 'thermcell_main apres thermcell_dry'
+    IF (prt_level>=10) THEN
       WRITE(lunout1, *) 'Dans thermcell_main 1b'
       WRITE(lunout1, *) 'lmin ', lmin(igout)
@@ -499,5 +499,5 @@
 
     !CR Appel de la fermeture seche
-    if (iflag_thermals_closure==1) THEN
+    IF (iflag_thermals_closure==1) THEN
       CALL thermcell_closure(ngrid, nlay, r_aspect_thermals, ptimestep, rho, &
               zlev, lalim, alim_star_clos, zmax_sec, wmax_sec, f)
@@ -506,5 +506,5 @@
       ! Appel avec les zmax et wmax tenant compte de la condensation
       ! Semble moins bien marcher
-    else if (iflag_thermals_closure==2) THEN
+    ELSE IF (iflag_thermals_closure==2) THEN
       CALL thermcell_closure(ngrid, nlay, r_aspect_thermals, ptimestep, rho, &
               zlev, lalim, alim_star, zmax, wmax, f)
@@ -516,5 +516,5 @@
     IF(prt_level>=1)PRINT*, 'thermcell_closure apres thermcell_closure'
 
-    if (tau_thermals>1.) THEN
+    IF (tau_thermals>1.) THEN
       lambda = exp(-ptimestep / tau_thermals)
       f0 = (1. - lambda) * f + lambda * f0
@@ -524,6 +524,6 @@
 
     ! Test valable seulement en 1D mais pas genant
-    if (.not. (f0(1)>=0.)) THEN
-      abort_message = '.not. (f0(1).ge.0.)'
+    IF (.NOT. (f0(1)>=0.)) THEN
+      abort_message = '.NOT. (f0(1).ge.0.)'
       CALL abort_physic (modname, abort_message, 1)
     endif
@@ -539,5 +539,5 @@
     !IM 060508    &       detr,zqla,zmax,lev_out,lunout,igout)
 
-    if (prt_level>=1) PRINT*, 'thermcell_main apres thermcell_flux'
+    IF (prt_level>=1) PRINT*, 'thermcell_main apres thermcell_flux'
     CALL test_ltherm(ngrid, nlay, pplay, lalim, ztv, p_o, ztva, zqla, f_star, zw2, 'thermcell_flux lalim ')
     CALL test_ltherm(ngrid, nlay, pplay, lmax, ztv, p_o, ztva, zqla, f_star, zw2, 'thermcell_flux lmax  ')
@@ -549,5 +549,5 @@
     !------------------------------------------------------------------
 
-    if (tau_thermals>1.) THEN
+    IF (tau_thermals>1.) THEN
       lambda = exp(-ptimestep / tau_thermals)
       fm0 = (1. - lambda) * fm + lambda * fm0
@@ -569,5 +569,5 @@
     do l = 2, nlay
       do ig = 1, ngrid
-        if (zw2(ig, l)>1.e-10) THEN
+        IF (zw2(ig, l)>1.e-10) THEN
           fraca(ig, l) = fm(ig, l) / (rhobarz(ig, l) * zw2(ig, l))
         else
@@ -581,5 +581,5 @@
     !------------------------------------------------------------------
     IF (iflag_thermals_down > 0) THEN
-      if (debut) PRINT*, 'WARNING !!! routine thermcell_down en cours de developpement'
+      IF (debut) PRINT*, 'WARNING !!! routine thermcell_down en cours de developpement'
       entrdn = fact_thermals_down * detr0
       detrdn = fact_thermals_down * entr0
@@ -632,5 +632,5 @@
       DO  ll=1,nlay
         DO ig=1,ngrid
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite(xtpo(iso_eau,ig,ll), &
             p_o(ig,ll),'thermcell_main 594')
@@ -638,5 +638,5 @@
             pdoadj(ig,ll),'thermcell_main 596')
           endif
-          if (iso_HDO.gt.0) THEN
+          IF (iso_HDO.gt.0) THEN
               CALL iso_verif_aberrant_encadre(xtpo(iso_hdo,ig,ll) &
              /p_o(ig,ll),'thermcell_main 610')
@@ -654,5 +654,5 @@
 
       !IM 090508
-      if (dvdq == 0) THEN
+      IF (dvdq == 0) THEN
         ! Calcul du transport de V tenant compte d'echange par gradient
         ! de pression horizontal avec l'environnement
@@ -681,5 +681,5 @@
     enddo
 
-    if (prt_level>=1) PRINT*, '14 OK convect8'
+    IF (prt_level>=1) PRINT*, '14 OK convect8'
     !------------------------------------------------------------------
     !   Calculs de diagnostiques pour les sorties
@@ -687,6 +687,6 @@
     !calcul de fraca pour les sorties
 
-    if (sorties) THEN
-      if (prt_level>=1) PRINT*, '14a OK convect8'
+    IF (sorties) THEN
+      IF (prt_level>=1) PRINT*, '14a OK convect8'
       ! calcul du niveau de condensation
       ! initialisation
@@ -704,6 +704,6 @@
       do k = 1, nlay - 1
         do ig = 1, ngrid
-          if ((pcon(ig)<=pplay(ig, k))  &
-                  .and.(pcon(ig)>pplay(ig, k + 1))) THEN
+          IF ((pcon(ig)<=pplay(ig, k))  &
+                  .AND.(pcon(ig)>pplay(ig, k + 1))) THEN
             zcon2(ig) = zlay(ig, k) - (pcon(ig) - pplay(ig, k)) / (RG * rho(ig, k)) / 100.
           endif
@@ -713,5 +713,5 @@
       ierr = 0
       do ig = 1, ngrid
-        if (pcon(ig)<=pplay(ig, nlay)) THEN
+        IF (pcon(ig)<=pplay(ig, nlay)) THEN
           zcon2(ig) = zlay(ig, nlay) - (pcon(ig) - pplay(ig, nlay)) / (RG * rho(ig, nlay)) / 100.
           ierr = 1
@@ -723,8 +723,8 @@
       !      endif
 
-      if (prt_level>=1) PRINT*, '14b OK convect8'
+      IF (prt_level>=1) PRINT*, '14b OK convect8'
       do k = nlay, 1, -1
         do ig = 1, ngrid
-          if (zqla(ig, k)>1e-10) THEN
+          IF (zqla(ig, k)>1e-10) THEN
             nivcon(ig) = k
             zcon(ig) = zlev(ig, k)
@@ -732,5 +732,5 @@
         enddo
       enddo
-      if (prt_level>=1) PRINT*, '14c OK convect8'
+      IF (prt_level>=1) PRINT*, '14c OK convect8'
       !calcul des moments
       !initialisation
@@ -744,6 +744,6 @@
         enddo
       enddo
-      if (prt_level>=1) PRINT*, '14d OK convect8'
-      if (prt_level>=10)WRITE(lunout, *)                                &
+      IF (prt_level>=1) PRINT*, '14d OK convect8'
+      IF (prt_level>=10)WRITE(lunout, *)                                &
               'WARNING thermcell_main wth2=0. si zw2 > 1.e-10'
       do l = 1, nlay
@@ -775,5 +775,5 @@
 
       !calcul du ratqscdiff
-      if (prt_level>=1) PRINT*, '14e OK convect8'
+      IF (prt_level>=1) PRINT*, '14e OK convect8'
       var = 0.
       vardiff = 0.
@@ -782,5 +782,5 @@
       do l = 1, nlay
         do ig = 1, ngrid
-          if (l<=lalim(ig)) THEN
+          IF (l<=lalim(ig)) THEN
             var = var + alim_star(ig, l) * zqta(ig, l) * 1000.
           endif
@@ -788,9 +788,9 @@
       enddo
 
-      if (prt_level>=1) PRINT*, '14f OK convect8'
+      IF (prt_level>=1) PRINT*, '14f OK convect8'
 
       do l = 1, nlay
         do ig = 1, ngrid
-          if (l<=lalim(ig)) THEN
+          IF (l<=lalim(ig)) THEN
             zf = fraca(ig, l)
             zf2 = zf / (1. - zf)
@@ -800,5 +800,5 @@
       enddo
 
-      if (prt_level>=1) PRINT*, '14g OK convect8'
+      IF (prt_level>=1) PRINT*, '14g OK convect8'
       do l = 1, nlay
         do ig = 1, ngrid
@@ -808,5 +808,5 @@
     endif
 
-    if (prt_level>=1) PRINT*, 'thermcell_main FIN  OK'
+    IF (prt_level>=1) PRINT*, 'thermcell_main FIN  OK'
 
     !PRINT*,'thermcell_main fin'
@@ -823,14 +823,14 @@
     IMPLICIT NONE
 
-    integer i, k, ngrid, nlay
-    real, intent(in), dimension(ngrid, nlay) :: pplay, ztv, p_o, ztva, zqla
-    real, intent(in), dimension(ngrid, nlay) :: f_star, zw2
-    integer, intent(in), dimension(ngrid) :: long
-    real seuil
+    INTEGER i, k, ngrid, nlay
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: pplay, ztv, p_o, ztva, zqla
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: f_star, zw2
+    INTEGER, INTENT(IN), DIMENSION(ngrid) :: long
+    REAL seuil
     character*21 comment
 
     seuil = 0.25
 
-    if (prt_level>=1) THEN
+    IF (prt_level>=1) THEN
       PRINT*, 'WARNING !!! TEST ', comment
     endif
@@ -840,5 +840,5 @@
     do i = 1, ngrid
       !IMtemp           if (pplay(i,long(i)).lt.seuil*pplev(i,1)) THEN
-      if (prt_level>=10) THEN
+      IF (prt_level>=10) THEN
         PRINT*, 'WARNING ', comment, ' au point ', i, ' K= ', long(i)
         PRINT*, '  K  P(MB)  THV(K)     Qenv(g/kg)THVA        QLA(g/kg)   F*        W2'
@@ -874,25 +874,25 @@
     !=======================================================================
 
-    integer ngrid, nlay
-
-    real, intent(in) :: ptimestep
-    real, intent(in), dimension(ngrid, nlay + 1) :: fm0, pplev
-    real, intent(in), dimension(ngrid, nlay) :: entr0
-    real, intent(in) :: rg
-    real, intent(out), dimension(ngrid, nlay) :: therm_tke_max
-
-    real detr0(ngrid, nlay)
-    real masse0(ngrid, nlay)
-    real masse(ngrid, nlay), fm(ngrid, nlay + 1)
-    real entr(ngrid, nlay)
-    real q(ngrid, nlay)
-    integer lev_out                           ! niveau pour les print
-
-    real qa(ngrid, nlay), detr(ngrid, nlay), wqd(ngrid, nlay + 1)
-    integer ig, k
+    INTEGER ngrid, nlay
+
+    REAL, INTENT(IN) :: ptimestep
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay + 1) :: fm0, pplev
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: entr0
+    REAL, INTENT(IN) :: rg
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: therm_tke_max
+
+    REAL detr0(ngrid, nlay)
+    REAL masse0(ngrid, nlay)
+    REAL masse(ngrid, nlay), fm(ngrid, nlay + 1)
+    REAL entr(ngrid, nlay)
+    REAL q(ngrid, nlay)
+    INTEGER lev_out                           ! niveau pour les print
+
+    REAL qa(ngrid, nlay), detr(ngrid, nlay), wqd(ngrid, nlay + 1)
+    INTEGER ig, k
 
     lev_out = 0
 
-    if (prt_level>=1) PRINT*, 'Q2 THERMCEL_DQ 0'
+    IF (prt_level>=1) PRINT*, 'Q2 THERMCEL_DQ 0'
 
     !   calcul du detrainement
@@ -923,8 +923,8 @@
     !!!
 
-    if (1==1) THEN
+    IF (1==1) THEN
       do k = 2, nlay
         do ig = 1, ngrid
-          if ((fm(ig, k + 1) + detr(ig, k)) * ptimestep>  &
+          IF ((fm(ig, k + 1) + detr(ig, k)) * ptimestep>  &
                   1.e-5 * masse(ig, k)) THEN
             qa(ig, k) = (fm(ig, k) * qa(ig, k - 1) + entr(ig, k) * q(ig, k))  &
@@ -933,8 +933,8 @@
             qa(ig, k) = q(ig, k)
           endif
-          if (qa(ig, k)<0.) THEN
+          IF (qa(ig, k)<0.) THEN
             !               PRINT*,'qa<0!!!'
           endif
-          if (q(ig, k)<0.) THEN
+          IF (q(ig, k)<0.) THEN
             !               PRINT*,'q<0!!!'
           endif
@@ -947,5 +947,5 @@
         do ig = 1, ngrid
           wqd(ig, k) = fm(ig, k) * q(ig, k)
-          if (wqd(ig, k)<0.) THEN
+          IF (wqd(ig, k)<0.) THEN
             !               PRINT*,'wqd<0!!!'
           endif
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_old.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_old.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_old.F90	(revision 5117)
@@ -377,5 +377,5 @@
   DO l = 1, nlay - 2
     DO ig = 1, ngrid
-      ! if (zw2(ig,l).lt.1.e-10.and.ztv(ig,l).gt.ztv(ig,l+1)) THEN
+      ! if (zw2(ig,l).lt.1.e-10.AND.ztv(ig,l).gt.ztv(ig,l+1)) THEN
       ! PRINT*,'COUCOU ',l,zw2(ig,l),ztv(ig,l),ztv(ig,l+1)
       IF (zw2(ig,l)<1.E-10 .AND. ztv(ig,l)>ztv(ig,l+1) .AND. &
@@ -388,8 +388,8 @@
         fmc(ig, l+1) = entr(ig, l)
         zw2(ig, l) = 0.
-        ! if (.not.ztv(ig,l+1).gt.150.) THEN
+        ! if (.NOT.ztv(ig,l+1).gt.150.) THEN
         ! PRINT*,'ig,l+1,ztv(ig,l+1)'
         ! PRINT*, ig,l+1,ztv(ig,l+1)
-        ! endif
+        ! END IF
         zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
           (zlev(ig,l+1)-zlev(ig,l))
@@ -398,5 +398,5 @@
         ! Incrementation...
         fmc(ig, l+1) = fmc(ig, l) + entr(ig, l)
-        ! if (.not.fmc(ig,l+1).gt.1.e-15) THEN
+        ! if (.NOT.fmc(ig,l+1).gt.1.e-15) THEN
         ! PRINT*,'ig,l+1,fmc(ig,l+1)'
         ! PRINT*, ig,l+1,fmc(ig,l+1)
@@ -405,5 +405,5 @@
         ! PRINT*,'Tv ',(ztv(ig,ll),ll=1,klev)
         ! PRINT*,'Entr ',(entr(ig,ll),ll=1,klev)
-        ! endif
+        ! END IF
         ztva(ig, l) = (fmc(ig,l)*ztva(ig,l-1)+entr(ig,l)*ztv(ig,l))/ &
           fmc(ig, l+1)
@@ -452,17 +452,17 @@
     DO ig = 1, ngrid
       IF (l<=lmaxa(ig)) THEN
-        ! if (idetr.eq.0) THEN
+        ! if (idetr.EQ.0) THEN
         ! cette option est finalement en dur.
         larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
-        ! else if (idetr.eq.1) THEN
+        ! ELSE IF (idetr.EQ.1) THEN
         ! larg_detr(ig,l)=larg_cons(ig,l)
         ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) THEN
+        ! ELSE IF (idetr.EQ.2) THEN
         ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
         ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) THEN
+        ! ELSE IF (idetr.EQ.4) THEN
         ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
         ! s            *wa_moy(ig,l)
-        ! endif
+        ! END IF
       END IF
     END DO
@@ -670,9 +670,9 @@
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
+  ! END IF
   ! IF(abs(pdoadj(ig,l))*86400..gt.1.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
+  ! END IF
   ! enddo
   ! enddo
@@ -1431,5 +1431,5 @@
         ! entr_star(ig,l)=0.
         ! detr_star(ig,l)=f_star(ig,l)+alim_star(ig,l)
-        ! endif
+        ! END IF
         ! test sur le signe de f_star
         IF (f_star(ig,l+1)>1.E-10) THEN
@@ -1448,5 +1448,5 @@
             l)+entr_star(ig,l))*zthl(ig,l))/(f_star(ig,l+1)+detr_star(ig,l))
           ! s                    /(f_star(ig,l+1))
-          ! endif
+          ! END IF
           ! on rajoute un excès de q dans la couche alim
           ! if (l.lt.lentr(ig)) THEN
@@ -1458,5 +1458,5 @@
             l)+entr_star(ig,l))*po(ig,l))/(f_star(ig,l+1)+detr_star(ig,l))
           ! s                   /(f_star(ig,l+1))
-          ! endif
+          ! END IF
           ! AM on en deduit thetav et ql du thermique
           ! CR test
@@ -1515,5 +1515,5 @@
           ztva(ig, l) = ztva(ig, l)*(1.+retv*(zqta(ig,l)-zqla(ig, &
             l))-zqla(ig,l))
-          ! endif
+          ! END IF
           ! ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
           ! s                 /(1.-retv*zqla(ig,l))
@@ -1528,5 +1528,5 @@
           ! enddo
           ! DO ig=1,ngrid
-          ! if (zw2(ig,l).ge.1.e-10.and.
+          ! if (zw2(ig,l).ge.1.e-10.AND.
           ! s               f_star(ig,l)+entr_star(ig,l).gt.1.e-10) THEN
           ! mise a jour de la vitesse ascendante (l'air entraine de la couche
@@ -1550,5 +1550,5 @@
         zw2(ig, l+1) = 0.
         ! PRINT*,'linter=',linter(ig)
-        ! else if ((zw2(ig,l+1).lt.1.e-10).and.(zw2(ig,l+1).ge.0.)) THEN
+        ! ELSE IF ((zw2(ig,l+1).lt.1.e-10).AND.(zw2(ig,l+1).ge.0.)) THEN
         ! linter(ig)=l+1
         ! PRINT*,'linter=l',zw2(ig,l),zw2(ig,l+1)
@@ -1687,5 +1687,5 @@
   ! s                       -0.9*masse(ig,l)/ptimestep
   ! alim(ig,l)=0.9*masse(ig,l)/ptimestep
-  ! endif
+  ! END IF
   ! enddo
   ! enddo
@@ -1712,5 +1712,5 @@
   ! PRINT*,'d2+e2+a2>m2','ig=',ig,'l=',l,'lmax(ig)=',lmax(ig),'d+e+a='
   ! s,(detr(ig,l)+entr(ig,l)+alim(ig,l))*ptimestep,'m=',masse(ig,l)
-  ! endif
+  ! END IF
   ! enddo
   ! enddo
@@ -1732,18 +1732,18 @@
         ! PRINT*,'fmc1<0',l+1,lmax(ig),fmc(ig,l+1)
       END IF
-      ! if ((fmc(ig,l+1).gt.fmc(ig,l)).and.(l.gt.lentr(ig))) THEN
+      ! if ((fmc(ig,l+1).gt.fmc(ig,l)).AND.(l.gt.lentr(ig))) THEN
       ! f_old=fmc(ig,l+1)
       ! fmc(ig,l+1)=fmc(ig,l)
       ! detr(ig,l)=detr(ig,l)+f_old-fmc(ig,l+1)
-      ! endif
-
-      ! if ((fmc(ig,l+1).gt.fmc(ig,l)).and.(l.gt.lentr(ig))) THEN
+      ! END IF
+
+      ! if ((fmc(ig,l+1).gt.fmc(ig,l)).AND.(l.gt.lentr(ig))) THEN
       ! f_old=fmc(ig,l+1)
       ! fmc(ig,l+1)=fmc(ig,l)
       ! detr(ig,l)=detr(ig,l)+f_old-fmc(ig,l)
-      ! endif
+      ! END IF
       ! rajout du test sur alpha croissant
       ! if test
-      ! if (1.eq.0) THEN
+      ! if (1.EQ.0) THEN
       IF (l==klev) THEN
         PRINT *, 'THERMCELL PB ig=', ig, '   l=', l
@@ -1751,6 +1751,6 @@
         CALL abort_physic(modname, abort_message, 1)
       END IF
-      ! if ((zw2(ig,l+1).gt.1.e-10).and.(zw2(ig,l).gt.1.e-10).and.
-      ! s     (l.ge.lentr(ig)).and.
+      ! if ((zw2(ig,l+1).gt.1.e-10).AND.(zw2(ig,l).gt.1.e-10).AND.
+      ! s     (l.ge.lentr(ig)).AND.
       IF ((zw2(ig,l+1)>1.E-10) .AND. (zw2(ig,l)>1.E-10) .AND. (l>=lentr(ig))) &
           THEN
@@ -1789,5 +1789,5 @@
       ! lmax(ig)=l+1
       ! zmax(ig)=zlev(ig,lmax(ig))
-      ! endif
+      ! END IF
       IF (zw2(ig,l+1)>1.E-10) THEN
         IF ((((fmc(ig,l+1))/(rhobarz(ig,l+1)*zw2(ig,l+1)))>1.)) THEN
@@ -1803,15 +1803,15 @@
       END IF
       ! WRITE(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
-      ! endif test
-      ! endif
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    ! if (fmc(ig,lmax(ig)+1).ne.0.) THEN
+      ! END IF test
+      ! END IF
+    END DO
+  END DO
+  DO ig = 1, ngrid
+    ! if (fmc(ig,lmax(ig)+1).NE.0.) THEN
     fmc(ig, lmax(ig)+1) = 0.
     entr(ig, lmax(ig)) = 0.
     detr(ig, lmax(ig)) = fmc(ig, lmax(ig)) + entr(ig, lmax(ig)) + &
       alim(ig, lmax(ig))
-    ! endif
+    ! END IF
   END DO
   ! test sur le signe de fmc
@@ -1932,5 +1932,5 @@
     DO ig = 1, ngrid
       IF (l<=lmax(ig) .AND. (test(ig)==1)) THEN
-        ! if (idetr.eq.0) THEN
+        ! if (idetr.EQ.0) THEN
         ! cette option est finalement en dur.
         IF ((l_mix*zlev(ig,l))<0.) THEN
@@ -1944,14 +1944,14 @@
           larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
         END IF
-        ! else if (idetr.eq.1) THEN
+        ! ELSE IF (idetr.EQ.1) THEN
         ! larg_detr(ig,l)=larg_cons(ig,l)
         ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) THEN
+        ! ELSE IF (idetr.EQ.2) THEN
         ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
         ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) THEN
+        ! ELSE IF (idetr.EQ.4) THEN
         ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
         ! s            *wa_moy(ig,l)
-        ! endif
+        ! END IF
       END IF
     END DO
@@ -2215,9 +2215,9 @@
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
+  ! END IF
   ! IF(abs(pdoadj(ig,l))*86400..gt.1.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
+  ! END IF
   ! enddo
   ! enddo
@@ -2262,5 +2262,5 @@
         ! else
         ! nuage=.FALSE.
-        ! endif
+        ! END IF
       END DO
     END DO
@@ -2281,5 +2281,5 @@
         ! else
         ! ratqscth(ig,l)=0.
-        ! endif
+        ! END IF
       END DO
     END DO
@@ -2979,17 +2979,17 @@
     DO ig = 1, ngrid
       IF (l<=lmaxa(ig)) THEN
-        ! if (idetr.eq.0) THEN
+        ! if (idetr.EQ.0) THEN
         ! cette option est finalement en dur.
         larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
-        ! else if (idetr.eq.1) THEN
+        ! ELSE IF (idetr.EQ.1) THEN
         ! larg_detr(ig,l)=larg_cons(ig,l)
         ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) THEN
+        ! ELSE IF (idetr.EQ.2) THEN
         ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
         ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) THEN
+        ! ELSE IF (idetr.EQ.4) THEN
         ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
         ! s            *wa_moy(ig,l)
-        ! endif
+        ! END IF
       END IF
     END DO
@@ -3230,9 +3230,9 @@
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
+  ! END IF
   ! IF(abs(pdoadj(ig,l))*86400..gt.1.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
+  ! END IF
   ! enddo
   ! enddo
@@ -3711,5 +3711,5 @@
       ! f(ig)=f(ig)+(f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)
       ! s             *wmax(ig))
-      ! endif
+      ! END IF
     END IF
     ! f0(ig)=f(ig)
@@ -3757,5 +3757,5 @@
     DO ig = 1, ngrid
       IF (l<=lmaxa(ig)) THEN
-        ! if (idetr.eq.0) THEN
+        ! if (idetr.EQ.0) THEN
         ! cette option est finalement en dur.
         IF ((l_mix*zlev(ig,l))<0.) THEN
@@ -3763,14 +3763,14 @@
         END IF
         larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
-        ! else if (idetr.eq.1) THEN
+        ! ELSE IF (idetr.EQ.1) THEN
         ! larg_detr(ig,l)=larg_cons(ig,l)
         ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) THEN
+        ! ELSE IF (idetr.EQ.2) THEN
         ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
         ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) THEN
+        ! ELSE IF (idetr.EQ.4) THEN
         ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
         ! s            *wa_moy(ig,l)
-        ! endif
+        ! END IF
       END IF
     END DO
@@ -4040,9 +4040,9 @@
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
+  ! END IF
   ! IF(abs(pdoadj(ig,l))*86400..gt.1.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
+  ! END IF
   ! enddo
   ! enddo
@@ -4071,5 +4071,5 @@
     ! detr(ig,l)=0.
     ! PRINT*,'WARNING !!! detrainement negatif ',ig,l
-    ! endif
+    ! END IF
     ! enddo
     ! enddo
@@ -4212,5 +4212,5 @@
       ! if (dq(ig,k).lt.0.) THEN
       ! PRINT*,'dq<0!!!'
-      ! endif
+      ! END IF
     END DO
   END DO
@@ -4982,5 +4982,5 @@
       ! f(ig)=f(ig)+(f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)
       ! s             *wmax(ig))
-      ! endif
+      ! END IF
     END IF
     ! f0(ig)=f(ig)
@@ -5039,5 +5039,5 @@
     DO ig = 1, ngrid
       IF (l<=lmaxa(ig)) THEN
-        ! if (idetr.eq.0) THEN
+        ! if (idetr.EQ.0) THEN
         ! cette option est finalement en dur.
         IF ((l_mix*zlev(ig,l))<0.) THEN
@@ -5052,14 +5052,14 @@
         END IF
         ! RC
-        ! else if (idetr.eq.1) THEN
+        ! ELSE IF (idetr.EQ.1) THEN
         ! larg_detr(ig,l)=larg_cons(ig,l)
         ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) THEN
+        ! ELSE IF (idetr.EQ.2) THEN
         ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
         ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) THEN
+        ! ELSE IF (idetr.EQ.4) THEN
         ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
         ! s            *wa_moy(ig,l)
-        ! endif
+        ! END IF
       END IF
     END DO
@@ -5329,9 +5329,9 @@
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
+  ! END IF
   ! IF(abs(pdoadj(ig,l))*86400..gt.1.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
+  ! END IF
   ! enddo
   ! enddo
@@ -5712,5 +5712,5 @@
     END DO
   END DO
-  ! endif
+  ! END IF
   ! pas de thermique si couche 1 stable
   DO ig = 1, ngrid
@@ -5893,5 +5893,5 @@
       ! if (first) THEN
       f(ig) = f(ig) + (f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)*wmax(ig))
-      ! endif
+      ! END IF
     END IF
     f0(ig) = f(ig)
@@ -5916,5 +5916,5 @@
   ! s                       -0.9*masse(ig,l)/ptimestep
   ! entr(ig,l)=0.9*masse(ig,l)/ptimestep
-  ! endif
+  ! END IF
   ! enddo
   ! enddo
@@ -5953,5 +5953,5 @@
     DO ig = 1, ngrid
       IF (l<=lmaxa(ig)) THEN
-        ! if (idetr.eq.0) THEN
+        ! if (idetr.EQ.0) THEN
         ! cette option est finalement en dur.
         IF ((l_mix*zlev(ig,l))<0.) THEN
@@ -5966,14 +5966,14 @@
         END IF
         ! RC
-        ! else if (idetr.eq.1) THEN
+        ! ELSE IF (idetr.EQ.1) THEN
         ! larg_detr(ig,l)=larg_cons(ig,l)
         ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) THEN
+        ! ELSE IF (idetr.EQ.2) THEN
         ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
         ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) THEN
+        ! ELSE IF (idetr.EQ.4) THEN
         ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
         ! s            *wa_moy(ig,l)
-        ! endif
+        ! END IF
       END IF
     END DO
@@ -6245,9 +6245,9 @@
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
+  ! END IF
   ! IF(abs(pdoadj(ig,l))*86400..gt.1.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
+  ! END IF
   ! enddo
   ! enddo
@@ -6276,5 +6276,5 @@
     ! detr(ig,l)=0.
     ! PRINT*,'WARNING !!! detrainement negatif ',ig,l
-    ! endif
+    ! END IF
     ! enddo
     ! enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume.f90	(revision 5117)
@@ -34,71 +34,71 @@
     IMPLICIT NONE
 
-    integer, intent(in) :: itap, lev_out, lunout1, igout, ngrid, nlay
-    real, intent(in) :: ptimestep
-    real, intent(in), dimension(ngrid, nlay) :: ztv
-    real, intent(in), dimension(ngrid, nlay) :: zthl
-    real, intent(in), dimension(ngrid, nlay) :: po
-    real, intent(in), dimension(ngrid, nlay) :: zl
-    real, intent(in), dimension(ngrid, nlay) :: rhobarz
-    real, intent(in), dimension(ngrid, nlay + 1) :: zlev
-    real, intent(in), dimension(ngrid, nlay + 1) :: pplev
-    real, intent(in), dimension(ngrid, nlay) :: pphi
-    real, intent(in), dimension(ngrid, nlay) :: zpspsk
-    real, intent(in), dimension(ngrid) :: f0
-
-    integer, intent(out) :: lalim(ngrid)
-    real, intent(out), dimension(ngrid, nlay) :: alim_star
-    real, intent(out), dimension(ngrid) :: alim_star_tot
-    real, intent(out), dimension(ngrid, nlay) :: detr_star
-    real, intent(out), dimension(ngrid, nlay) :: entr_star
-    real, intent(out), dimension(ngrid, nlay + 1) :: f_star
-    real, intent(out), dimension(ngrid, nlay) :: csc
-    real, intent(out), dimension(ngrid, nlay) :: ztva
-    real, intent(out), dimension(ngrid, nlay) :: ztla
-    real, intent(out), dimension(ngrid, nlay) :: zqla
-    real, intent(out), dimension(ngrid, nlay) :: zqta
-    real, intent(out), dimension(ngrid, nlay) :: zha
-    real, intent(out), dimension(ngrid, nlay + 1) :: zw2
-    real, intent(out), dimension(ngrid, nlay + 1) :: w_est
-    real, intent(out), dimension(ngrid, nlay) :: ztva_est
-    real, intent(out), dimension(ngrid, nlay) :: zqsatth
-    integer, intent(out), dimension(ngrid) :: lmix(ngrid)
-    integer, intent(out), dimension(ngrid) :: lmix_bis(ngrid)
-    real, intent(out), dimension(ngrid) :: linter(ngrid)
-
-    REAL, dimension(ngrid, nlay + 1) :: wa_moy
-    REAL, dimension(ngrid, nlay) :: entr, detr
-    REAL, dimension(ngrid, nlay) :: ztv_est
-    REAL, dimension(ngrid, nlay) :: zqla_est
-    REAL, dimension(ngrid, nlay) :: zta_est
-    REAL, dimension(ngrid) :: ztemp, zqsat
+    INTEGER, INTENT(IN) :: itap, lev_out, lunout1, igout, ngrid, nlay
+    REAL, INTENT(IN) :: ptimestep
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: ztv
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: zthl
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: po
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: zl
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: rhobarz
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay + 1) :: zlev
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay + 1) :: pplev
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: pphi
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: zpspsk
+    REAL, INTENT(IN), DIMENSION(ngrid) :: f0
+
+    INTEGER, INTENT(OUT) :: lalim(ngrid)
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: alim_star
+    REAL, INTENT(OUT), DIMENSION(ngrid) :: alim_star_tot
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: detr_star
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: entr_star
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay + 1) :: f_star
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: csc
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: ztva
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: ztla
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: zqla
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: zqta
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: zha
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay + 1) :: zw2
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay + 1) :: w_est
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: ztva_est
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: zqsatth
+    INTEGER, INTENT(OUT), DIMENSION(ngrid) :: lmix(ngrid)
+    INTEGER, INTENT(OUT), DIMENSION(ngrid) :: lmix_bis(ngrid)
+    REAL, INTENT(OUT), DIMENSION(ngrid) :: linter(ngrid)
+
+    REAL, DIMENSION(ngrid, nlay + 1) :: wa_moy
+    REAL, DIMENSION(ngrid, nlay) :: entr, detr
+    REAL, DIMENSION(ngrid, nlay) :: ztv_est
+    REAL, DIMENSION(ngrid, nlay) :: zqla_est
+    REAL, DIMENSION(ngrid, nlay) :: zta_est
+    REAL, DIMENSION(ngrid) :: ztemp, zqsat
     REAL zdw2, zdw2bis
     REAL zw2modif
     REAL zw2fact, zw2factbis
-    REAL, dimension(ngrid, nlay) :: zeps
-
-    REAL, dimension(ngrid) :: wmaxa
+    REAL, DIMENSION(ngrid, nlay) :: zeps
+
+    REAL, DIMENSION(ngrid) :: wmaxa
 
     INTEGER ig, l, k, lt, it, lm, nbpb
 
-    real, dimension(ngrid, nlay) :: zbuoy, gamma, zdqt
-    real zdz, zalpha, zw2m
-    real, dimension(ngrid, nlay) :: zbuoyjam, zdqtjam
-    real zdz2, zdz3, lmel, entrbis, zdzbis
-    real, dimension(ngrid) :: d_temp
-    real ztv1, ztv2, factinv, zinv, zlmel
-    real zlmelup, zlmeldwn, zlt, zltdwn, zltup
-    real atv1, atv2, btv1, btv2
-    real ztv_est1, ztv_est2
-    real zcor, zdelta, zcvm5, qlbef
-    real zbetalpha, coefzlmel
-    real eps
-    logical Zsat
-    LOGICAL, dimension(ngrid) :: active, activetmp
+    REAL, DIMENSION(ngrid, nlay) :: zbuoy, gamma, zdqt
+    REAL zdz, zalpha, zw2m
+    REAL, DIMENSION(ngrid, nlay) :: zbuoyjam, zdqtjam
+    REAL zdz2, zdz3, lmel, entrbis, zdzbis
+    REAL, DIMENSION(ngrid) :: d_temp
+    REAL ztv1, ztv2, factinv, zinv, zlmel
+    REAL zlmelup, zlmeldwn, zlt, zltdwn, zltup
+    REAL atv1, atv2, btv1, btv2
+    REAL ztv_est1, ztv_est2
+    REAL zcor, zdelta, zcvm5, qlbef
+    REAL zbetalpha, coefzlmel
+    REAL eps
+    LOGICAL Zsat
+    LOGICAL, DIMENSION(ngrid) :: active, activetmp
     REAL fact_gamma, fact_gamma2, fact_epsilon2
 
-    REAL, dimension(ngrid, nlay) :: c2
-
-    if (ngrid==1) PRINT*, 'THERMCELL PLUME MODIFIE 2014/07/11'
+    REAL, DIMENSION(ngrid, nlay) :: c2
+
+    IF (ngrid==1) PRINT*, 'THERMCELL PLUME MODIFIE 2014/07/11'
     Zsat = .FALSE.
     ! Initialisation
@@ -108,5 +108,5 @@
 
     ! Initialisations des variables r?elles
-    if (1==1) THEN
+    IF (1==1) THEN
       ztva(:, :) = ztv(:, :)
       ztva_est(:, :) = ztva(:, :)
@@ -172,5 +172,5 @@
       ! Le panache va prendre au debut les caracteristiques de l'air contenu
       ! dans cette couche.
-      if (active(ig)) THEN
+      IF (active(ig)) THEN
         ztla(ig, 1) = zthl(ig, 1)
         zqta(ig, 1) = po(ig, 1)
@@ -196,6 +196,6 @@
       do ig = 1, ngrid
         active(ig) = active(ig) &
-                &                 .and. zw2(ig, l)>1.e-10 &
-                &                 .and. f_star(ig, l) + alim_star(ig, l)>1.e-10
+                &                 .AND. zw2(ig, l)>1.e-10 &
+                &                 .AND. f_star(ig, l) + alim_star(ig, l)>1.e-10
       enddo
 
@@ -284,5 +284,5 @@
 
       do ig = 1, ngrid
-        if (active(ig)) THEN
+        IF (active(ig)) THEN
           !          zw2m=max(0.5*(w_est(ig,l)+w_est(ig,l+1)),0.1)
           zw2m = w_est(ig, l + 1)
@@ -301,5 +301,5 @@
                                   + detr_q_coef * (zdqt(ig, l) / zw2m)**detr_q_power))
 
-          if (iflag_thermals_ed == 20) THEN
+          IF (iflag_thermals_ed == 20) THEN
             entr_star(ig, l) = f_star(ig, l) * zdz * (&
                     mix0 * 0.1 / (zalpha + 0.001)               &
@@ -315,5 +315,5 @@
           ! En dessous de lalim, on prend le max de alim_star et entr_star pour
           ! alim_star et 0 sinon
-          if (l<lalim(ig)) THEN
+          IF (l<lalim(ig)) THEN
             alim_star(ig, l) = max(alim_star(ig, l), entr_star(ig, l))
             entr_star(ig, l) = 0.
@@ -330,7 +330,7 @@
       !===========================================================================
 
-      activetmp(:) = active(:) .and. f_star(:, l + 1)>1.e-10
-      do ig = 1, ngrid
-        if (activetmp(ig)) THEN
+      activetmp(:) = active(:) .AND. f_star(:, l + 1)>1.e-10
+      do ig = 1, ngrid
+        IF (activetmp(ig)) THEN
           Zsat = .FALSE.
           ztla(ig, l) = (f_star(ig, l) * ztla(ig, l - 1) + &
@@ -347,5 +347,5 @@
       CALL thermcell_qsat(ngrid, activetmp, pplev(:, l), ztemp, zqta(:, l), zqsatth(:, l))
       do ig = 1, ngrid
-        if (activetmp(ig)) THEN
+        IF (activetmp(ig)) THEN
           ! on ecrit de maniere conservative (sat ou non)
           !          T = Tl +Lv/Cp ql
@@ -369,5 +369,5 @@
       enddo
 
-      if (prt_level>=20) PRINT*, 'coucou calcul detr 460: ig, l', ig, l
+      IF (prt_level>=20) PRINT*, 'coucou calcul detr 460: ig, l', ig, l
 
       !===========================================================================
@@ -377,5 +377,5 @@
       nbpb = 0
       do ig = 1, ngrid
-        if (zw2(ig, l + 1)>0. .and. zw2(ig, l + 1)<1.e-10) THEN
+        IF (zw2(ig, l + 1)>0. .AND. zw2(ig, l + 1)<1.e-10) THEN
           !               stop 'On tombe sur le cas particulier de thermcell_dry'
           !               PRINT*,'On tombe sur le cas particulier de thermcell_plume'
@@ -385,5 +385,5 @@
         endif
 
-        if (zw2(ig, l + 1)<0.) THEN
+        IF (zw2(ig, l + 1)<0.) THEN
           linter(ig) = (l * (zw2(ig, l + 1) - zw2(ig, l))  &
                   - zw2(ig, l)) / (zw2(ig, l + 1) - zw2(ig, l))
@@ -399,8 +399,8 @@
         wa_moy(ig, l + 1) = sqrt(zw2(ig, l + 1))
 
-        if (wa_moy(ig, l + 1)>wmaxa(ig)) THEN
+        IF (wa_moy(ig, l + 1)>wmaxa(ig)) THEN
           !   lmix est le niveau de la couche ou w (wa_moy) est maximum
           !on rajoute le calcul de lmix_bis
-          if (zqla(ig, l)<1.e-10) THEN
+          IF (zqla(ig, l)<1.e-10) THEN
             lmix_bis(ig) = l + 1
           endif
@@ -410,5 +410,5 @@
       enddo
 
-      if (nbpb>0) THEN
+      IF (nbpb>0) THEN
         PRINT*, 'WARNING on tombe ', nbpb, ' x sur un pb pour l=', l, ' dans thermcell_plume'
       endif
@@ -429,5 +429,5 @@
     enddo
 
-    if (prt_level>=20) PRINT*, 'coucou calcul detr 470: ig, l', ig, l
+    IF (prt_level>=20) PRINT*, 'coucou calcul detr 470: ig, l', ig, l
     RETURN
   end
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume_6A.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume_6A.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume_6A.f90	(revision 5117)
@@ -25,74 +25,74 @@
     IMPLICIT NONE
 
-    integer, intent(in) :: itap, lev_out, lunout1, igout, ngrid, nlay
-    real, intent(in) :: ptimestep
-    real, intent(in), dimension(ngrid, nlay) :: ztv
-    real, intent(in), dimension(ngrid, nlay) :: zthl
-    real, intent(in), dimension(ngrid, nlay) :: po
-    real, intent(in), dimension(ngrid, nlay) :: zl
-    real, intent(in), dimension(ngrid, nlay) :: rhobarz
-    real, intent(in), dimension(ngrid, nlay + 1) :: zlev
-    real, intent(in), dimension(ngrid, nlay + 1) :: pplev
-    real, intent(in), dimension(ngrid, nlay) :: pphi
-    real, intent(in), dimension(ngrid, nlay) :: zpspsk
-    real, intent(in), dimension(ngrid) :: f0
-
-    integer, intent(out) :: lalim(ngrid)
-    real, intent(out), dimension(ngrid, nlay) :: alim_star
-    real, intent(out), dimension(ngrid) :: alim_star_tot
-    real, intent(out), dimension(ngrid, nlay) :: detr_star
-    real, intent(out), dimension(ngrid, nlay) :: entr_star
-    real, intent(out), dimension(ngrid, nlay + 1) :: f_star
-    real, intent(out), dimension(ngrid, nlay) :: csc
-    real, intent(out), dimension(ngrid, nlay) :: ztva
-    real, intent(out), dimension(ngrid, nlay) :: ztla
-    real, intent(out), dimension(ngrid, nlay) :: zqla
-    real, intent(out), dimension(ngrid, nlay) :: zqta
-    real, intent(out), dimension(ngrid, nlay) :: zha
-    real, intent(out), dimension(ngrid, nlay + 1) :: zw2
-    real, intent(out), dimension(ngrid, nlay + 1) :: w_est
-    real, intent(out), dimension(ngrid, nlay) :: ztva_est
-    real, intent(out), dimension(ngrid, nlay) :: zqsatth
-    integer, intent(out), dimension(ngrid) :: lmix
-    integer, intent(out), dimension(ngrid) :: lmix_bis
-    real, intent(out), dimension(ngrid) :: linter
+    INTEGER, INTENT(IN) :: itap, lev_out, lunout1, igout, ngrid, nlay
+    REAL, INTENT(IN) :: ptimestep
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: ztv
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: zthl
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: po
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: zl
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: rhobarz
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay + 1) :: zlev
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay + 1) :: pplev
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: pphi
+    REAL, INTENT(IN), DIMENSION(ngrid, nlay) :: zpspsk
+    REAL, INTENT(IN), DIMENSION(ngrid) :: f0
+
+    INTEGER, INTENT(OUT) :: lalim(ngrid)
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: alim_star
+    REAL, INTENT(OUT), DIMENSION(ngrid) :: alim_star_tot
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: detr_star
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: entr_star
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay + 1) :: f_star
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: csc
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: ztva
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: ztla
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: zqla
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: zqta
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: zha
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay + 1) :: zw2
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay + 1) :: w_est
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: ztva_est
+    REAL, INTENT(OUT), DIMENSION(ngrid, nlay) :: zqsatth
+    INTEGER, INTENT(OUT), DIMENSION(ngrid) :: lmix
+    INTEGER, INTENT(OUT), DIMENSION(ngrid) :: lmix_bis
+    REAL, INTENT(OUT), DIMENSION(ngrid) :: linter
 
     REAL zdw2, zdw2bis
     REAL zw2modif
     REAL zw2fact, zw2factbis
-    REAL, dimension(ngrid, nlay) :: zeps
-
-    REAL, dimension(ngrid) :: wmaxa
+    REAL, DIMENSION(ngrid, nlay) :: zeps
+
+    REAL, DIMENSION(ngrid) :: wmaxa
 
     INTEGER ig, l, k, lt, it, lm
-    integer nbpb
-
-    real, dimension(ngrid, nlay) :: detr
-    real, dimension(ngrid, nlay) :: entr
-    real, dimension(ngrid, nlay + 1) :: wa_moy
-    real, dimension(ngrid, nlay) :: ztv_est
-    real, dimension(ngrid) :: ztemp, zqsat
-    real, dimension(ngrid, nlay) :: zqla_est
-    real, dimension(ngrid, nlay) :: zta_est
-
-    real, dimension(ngrid, nlay) :: zbuoy, gamma, zdqt
-    real zdz, zalpha, zw2m
-    real, dimension(ngrid, nlay) :: zbuoyjam, zdqtjam
-    real zbuoybis, zdz2, zdz3, lmel, entrbis, zdzbis
-    real, dimension(ngrid) :: d_temp
-    real ztv1, ztv2, factinv, zinv, zlmel
-    real zlmelup, zlmeldwn, zlt, zltdwn, zltup
-    real atv1, atv2, btv1, btv2
-    real ztv_est1, ztv_est2
-    real zcor, zdelta, zcvm5, qlbef
-    real zbetalpha, coefzlmel
-    real eps
-    logical Zsat
-    LOGICAL, dimension(ngrid) :: active, activetmp
+    INTEGER nbpb
+
+    REAL, DIMENSION(ngrid, nlay) :: detr
+    REAL, DIMENSION(ngrid, nlay) :: entr
+    REAL, DIMENSION(ngrid, nlay + 1) :: wa_moy
+    REAL, DIMENSION(ngrid, nlay) :: ztv_est
+    REAL, DIMENSION(ngrid) :: ztemp, zqsat
+    REAL, DIMENSION(ngrid, nlay) :: zqla_est
+    REAL, DIMENSION(ngrid, nlay) :: zta_est
+
+    REAL, DIMENSION(ngrid, nlay) :: zbuoy, gamma, zdqt
+    REAL zdz, zalpha, zw2m
+    REAL, DIMENSION(ngrid, nlay) :: zbuoyjam, zdqtjam
+    REAL zbuoybis, zdz2, zdz3, lmel, entrbis, zdzbis
+    REAL, DIMENSION(ngrid) :: d_temp
+    REAL ztv1, ztv2, factinv, zinv, zlmel
+    REAL zlmelup, zlmeldwn, zlt, zltdwn, zltup
+    REAL atv1, atv2, btv1, btv2
+    REAL ztv_est1, ztv_est2
+    REAL zcor, zdelta, zcvm5, qlbef
+    REAL zbetalpha, coefzlmel
+    REAL eps
+    LOGICAL Zsat
+    LOGICAL, DIMENSION(ngrid) :: active, activetmp
     REAL fact_gamma, fact_gamma2, fact_epsilon2
     REAL coefc
-    REAL, dimension(ngrid, nlay) :: c2
-
-    if (ngrid==1) PRINT*, 'THERMCELL PLUME MODIFIE 2014/07/11'
+    REAL, DIMENSION(ngrid, nlay) :: c2
+
+    IF (ngrid==1) PRINT*, 'THERMCELL PLUME MODIFIE 2014/07/11'
     Zsat = .FALSE.
     ! Initialisation
@@ -102,5 +102,5 @@
 
     ! Initialisations des variables r?elles
-    if (1==1) THEN
+    IF (1==1) THEN
       ztva(:, :) = ztv(:, :)
       ztva_est(:, :) = ztva(:, :)
@@ -173,5 +173,5 @@
       ! Le panache va prendre au debut les caracteristiques de l'air contenu
       ! dans cette couche.
-      if (active(ig)) THEN
+      IF (active(ig)) THEN
         ztla(ig, 1) = zthl(ig, 1)
         zqta(ig, 1) = po(ig, 1)
@@ -197,6 +197,6 @@
       do ig = 1, ngrid
         active(ig) = active(ig) &
-                &                 .and. zw2(ig, l)>1.e-10 &
-                &                 .and. f_star(ig, l) + alim_star(ig, l)>1.e-10
+                &                 .AND. zw2(ig, l)>1.e-10 &
+                &                 .AND. f_star(ig, l) + alim_star(ig, l)>1.e-10
       enddo
 
@@ -247,5 +247,5 @@
 
           !--------------------------------------------------
-          if (iflag_thermals_ed<8) THEN
+          IF (iflag_thermals_ed<8) THEN
             !--------------------------------------------------
             !AJ052014: J'ai remplac?? la boucle do par un do while
@@ -284,5 +284,5 @@
             ztv2 = atv2 * zlt + btv2
 
-            if (ztv(ig, lt)>ztv1.and.ztv(ig, lt)<ztv2) THEN
+            IF (ztv(ig, lt)>ztv1.AND.ztv(ig, lt)<ztv2) THEN
               !--------------------------------------------------
               !AJ052014: D??calage de zinv qui est entre le haut
@@ -292,5 +292,5 @@
               zinv = zltdwn + zdz3 * factinv
 
-              if (zlmeldwn>=zinv) THEN
+              IF (zlmeldwn>=zinv) THEN
                 ztv_est(ig, l) = atv2 * zlmel + btv2
                 zbuoyjam(ig, l) = fact_shell * RG * (ztva_est(ig, l) - ztv_est(ig, l)) / ztv_est(ig, l) &
@@ -311,6 +311,6 @@
               endif
 
-            else ! if (ztv(ig,lt).gt.ztv1.and.ztv(ig,lt).lt.ztv2) THEN
-              if (zlmeldwn>zltdwn) THEN
+            else ! if (ztv(ig,lt).gt.ztv1.AND.ztv(ig,lt).lt.ztv2) THEN
+              IF (zlmeldwn>zltdwn) THEN
                 zbuoyjam(ig, l) = fact_shell * RG * ((ztva_est(ig, l) - &
                         ztv(ig, lt)) / ztv(ig, lt)) + (1. - fact_shell) * zbuoy(ig, l)
@@ -328,5 +328,5 @@
               !    &          po(ig,lt))/po(ig,lt)+((zdz2-lmel)/zdz3)*(zqta(ig,l-1)- &
               !     &          po(ig,lt-1))/po(ig,lt-1))
-            endif ! if (ztv(ig,lt).gt.ztv1.and.ztv(ig,lt).lt.ztv2) THEN
+            endif ! if (ztv(ig,lt).gt.ztv1.AND.ztv(ig,lt).lt.ztv2) THEN
           else  !   if (iflag_thermals_ed.lt.8) THEN
             lt = l + 1
@@ -373,5 +373,5 @@
           !AJ052014: J'ai remplac? w_est(ig,l) par zw2(ig,l)
           !--------------------------------------------------
-          if (iflag_thermals_ed==8) THEN
+          IF (iflag_thermals_ed==8) THEN
             ! Ancienne version
             !             w_est(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
@@ -404,5 +404,5 @@
           endif
 
-          if (iflag_thermals_ed<6) THEN
+          IF (iflag_thermals_ed<6) THEN
             zalpha = f0(ig) * f_star(ig, l) / sqrt(w_est(ig, l + 1)) / rhobarz(ig, l)
             !              fact_epsilon=0.0005/(zalpha+0.025)**0.5
@@ -441,5 +441,5 @@
 
       do ig = 1, ngrid
-        if (active(ig)) THEN
+        IF (active(ig)) THEN
           !          zw2m=max(0.5*(w_est(ig,l)+w_est(ig,l+1)),0.1)
           zw2m = w_est(ig, l + 1)
@@ -471,5 +471,5 @@
           !          entrbis=entr_star(ig,l)
 
-          if (iflag_thermals_ed<6) THEN
+          IF (iflag_thermals_ed<6) THEN
             fact_epsilon = 0.0002 / (zalpha + 0.1)
           endif
@@ -508,9 +508,9 @@
           ! En dessous de lalim, on prend le max de alim_star et entr_star pour
           ! alim_star et 0 sinon
-          if (l<lalim(ig)) THEN
+          IF (l<lalim(ig)) THEN
             alim_star(ig, l) = max(alim_star(ig, l), entr_star(ig, l))
             entr_star(ig, l) = 0.
           endif
-          !        if (l.lt.lalim(ig).and.alim_star(ig,l)>alim_star(ig,l-1)) THEN
+          !        if (l.lt.lalim(ig).AND.alim_star(ig,l)>alim_star(ig,l-1)) THEN
           !          alim_star(ig,l)=entrbis
           !        endif
@@ -529,7 +529,7 @@
       !===========================================================================
 
-      activetmp(:) = active(:) .and. f_star(:, l + 1)>1.e-10
-      do ig = 1, ngrid
-        if (activetmp(ig)) THEN
+      activetmp(:) = active(:) .AND. f_star(:, l + 1)>1.e-10
+      do ig = 1, ngrid
+        IF (activetmp(ig)) THEN
           Zsat = .FALSE.
           ztla(ig, l) = (f_star(ig, l) * ztla(ig, l - 1) + &
@@ -546,5 +546,5 @@
       CALL thermcell_qsat(ngrid, activetmp, pplev(:, l), ztemp, zqta(:, l), zqsatth(:, l))
       do ig = 1, ngrid
-        if (activetmp(ig)) THEN
+        IF (activetmp(ig)) THEN
           ! on ecrit de maniere conservative (sat ou non)
           !          T = Tl +Lv/Cp ql
@@ -577,5 +577,5 @@
           !    &                     (zw2(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
           !    &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2))
-          if (iflag_thermals_ed==8) THEN
+          IF (iflag_thermals_ed==8) THEN
             zw2(ig, l + 1) = Max(0.0001, exp(-zw2fact) * (zw2(ig, l) - zdw2) + zdw2)
           else
@@ -586,5 +586,5 @@
           !    &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2bis))
 
-          if (iflag_thermals_ed<6) THEN
+          IF (iflag_thermals_ed<6) THEN
             zalpha = f0(ig) * f_star(ig, l) / sqrt(zw2(ig, l + 1)) / rhobarz(ig, l)
             !           fact_epsilon=0.0005/(zalpha+0.025)**0.5
@@ -607,5 +607,5 @@
       enddo
 
-      if (prt_level>=20) PRINT*, 'coucou calcul detr 460: ig, l', ig, l
+      IF (prt_level>=20) PRINT*, 'coucou calcul detr 460: ig, l', ig, l
 
       !===========================================================================
@@ -615,5 +615,5 @@
       nbpb = 0
       do ig = 1, ngrid
-        if (zw2(ig, l + 1)>0. .and. zw2(ig, l + 1)<1.e-10) THEN
+        IF (zw2(ig, l + 1)>0. .AND. zw2(ig, l + 1)<1.e-10) THEN
           !               stop 'On tombe sur le cas particulier de thermcell_dry'
           !               PRINT*,'On tombe sur le cas particulier de thermcell_plume'
@@ -623,5 +623,5 @@
         endif
 
-        if (zw2(ig, l + 1)<0.) THEN
+        IF (zw2(ig, l + 1)<0.) THEN
           linter(ig) = (l * (zw2(ig, l + 1) - zw2(ig, l))  &
                   - zw2(ig, l)) / (zw2(ig, l + 1) - zw2(ig, l))
@@ -637,8 +637,8 @@
         wa_moy(ig, l + 1) = sqrt(zw2(ig, l + 1))
 
-        if (wa_moy(ig, l + 1)>wmaxa(ig)) THEN
+        IF (wa_moy(ig, l + 1)>wmaxa(ig)) THEN
           !   lmix est le niveau de la couche ou w (wa_moy) est maximum
           !on rajoute le calcul de lmix_bis
-          if (zqla(ig, l)<1.e-10) THEN
+          IF (zqla(ig, l)<1.e-10) THEN
             lmix_bis(ig) = l + 1
           endif
@@ -648,5 +648,5 @@
       enddo
 
-      if (nbpb>0) THEN
+      IF (nbpb>0) THEN
         PRINT*, 'WARNING on tombe ', nbpb, ' x sur un pb pour l=', l, ' dans thermcell_plume'
       endif
@@ -667,5 +667,5 @@
     enddo
 
-    if (prt_level>=20) PRINT*, 'coucou calcul detr 470: ig, l', ig, l
+    IF (prt_level>=20) PRINT*, 'coucou calcul detr 470: ig, l', ig, l
     RETURN
   end
@@ -705,8 +705,8 @@
     REAL f0(ngrid)
     INTEGER lalim(ngrid)
-    integer lev_out                           ! niveau pour les print
-    integer nbpb
-
-    real alim_star_tot(ngrid)
+    INTEGER lev_out                           ! niveau pour les print
+    INTEGER nbpb
+
+    REAL alim_star_tot(ngrid)
 
     REAL ztva(ngrid, nlay)
@@ -747,10 +747,10 @@
     INTEGER ig, l, k
 
-    real zdz, zbuoy(ngrid, nlay), zalpha, gamma(ngrid, nlay), zdqt(ngrid, nlay), zw2m
-    real zbuoybis
-    real zcor, zdelta, zcvm5, qlbef, zdz2
-    real betalpha, zbetalpha
-    real eps, afact
-    logical Zsat
+    REAL zdz, zbuoy(ngrid, nlay), zalpha, gamma(ngrid, nlay), zdqt(ngrid, nlay), zw2m
+    REAL zbuoybis
+    REAL zcor, zdelta, zcvm5, qlbef, zdz2
+    REAL betalpha, zbetalpha
+    REAL eps, afact
+    LOGICAL Zsat
     LOGICAL active(ngrid), activetmp(ngrid)
     REAL fact_gamma, fact_epsilon, fact_gamma2, fact_epsilon2
@@ -767,5 +767,5 @@
 
     ! Initialisations des variables reeles
-    if (1==1) THEN
+    IF (1==1) THEN
       ztva(:, :) = ztv(:, :)
       ztva_est(:, :) = ztva(:, :)
@@ -819,5 +819,5 @@
     do l = 1, nlay - 1
       do ig = 1, ngrid
-        if (ztv(ig, l)> ztv(ig, l + 1) .and. ztv(ig, 1)>=ztv(ig, l)) THEN
+        IF (ztv(ig, l)> ztv(ig, l + 1) .AND. ztv(ig, 1)>=ztv(ig, l)) THEN
           alim_star(ig, l) = MAX((ztv(ig, l) - ztv(ig, l + 1)), 0.)  &
                   * sqrt(zlev(ig, l + 1))
@@ -829,5 +829,5 @@
     do l = 1, nlay
       do ig = 1, ngrid
-        if (alim_star_tot(ig) > 1.e-10) THEN
+        IF (alim_star_tot(ig) > 1.e-10) THEN
           alim_star(ig, l) = alim_star(ig, l) / alim_star_tot(ig)
         endif
@@ -848,5 +848,5 @@
       ! Le panache va prendre au debut les caracteristiques de l'air contenu
       ! dans cette couche.
-      if (active(ig)) THEN
+      IF (active(ig)) THEN
         ztla(ig, 1) = zthl(ig, 1)
         zqta(ig, 1) = po(ig, 1)
@@ -872,6 +872,6 @@
       do ig = 1, ngrid
         active(ig) = active(ig) &
-                &                 .and. zw2(ig, l)>1.e-10 &
-                &                 .and. f_star(ig, l) + alim_star(ig, l)>1.e-10
+                &                 .AND. zw2(ig, l)>1.e-10 &
+                &                 .AND. f_star(ig, l) + alim_star(ig, l)>1.e-10
       enddo
 
@@ -911,5 +911,5 @@
           w_est(ig, l + 1) = Max(0.0001, exp(-zw2fact) * (w_est(ig, l) - zdw2) + zdw2)
 
-          if (w_est(ig, l + 1)<0.) THEN
+          IF (w_est(ig, l + 1)<0.) THEN
             w_est(ig, l + 1) = zw2(ig, l)
           endif
@@ -923,5 +923,5 @@
 
       do ig = 1, ngrid
-        if (active(ig)) THEN
+        IF (active(ig)) THEN
           zw2m = max(0.5 * (w_est(ig, l) + w_est(ig, l + 1)), 0.1)
           zw2m = w_est(ig, l + 1)
@@ -942,5 +942,5 @@
           ! En dessous de lalim, on prend le max de alim_star et entr_star pour
           ! alim_star et 0 sinon
-          if (l<lalim(ig)) THEN
+          IF (l<lalim(ig)) THEN
             alim_star(ig, l) = max(alim_star(ig, l), entr_star(ig, l))
             entr_star(ig, l) = 0.
@@ -958,7 +958,7 @@
       !calcul de la vitesse verticale en melangeant Tl et qt du thermique
       !---------------------------------------------------------------------------
-      activetmp(:) = active(:) .and. f_star(:, l + 1)>1.e-10
-      do ig = 1, ngrid
-        if (activetmp(ig)) THEN
+      activetmp(:) = active(:) .AND. f_star(:, l + 1)>1.e-10
+      do ig = 1, ngrid
+        IF (activetmp(ig)) THEN
           Zsat = .FALSE.
           ztla(ig, l) = (f_star(ig, l) * ztla(ig, l - 1) + &
@@ -976,5 +976,5 @@
 
       do ig = 1, ngrid
-        if (activetmp(ig)) THEN
+        IF (activetmp(ig)) THEN
           ! on ecrit de maniere conservative (sat ou non)
           !          T = Tl +Lv/Cp ql
@@ -996,5 +996,5 @@
       enddo
 
-      if (prt_level>=20) PRINT*, 'coucou calcul detr 460: ig, l', ig, l
+      IF (prt_level>=20) PRINT*, 'coucou calcul detr 460: ig, l', ig, l
 
       !---------------------------------------------------------------------------
@@ -1004,5 +1004,5 @@
       nbpb = 0
       do ig = 1, ngrid
-        if (zw2(ig, l + 1)>0. .and. zw2(ig, l + 1)<1.e-10) THEN
+        IF (zw2(ig, l + 1)>0. .AND. zw2(ig, l + 1)<1.e-10) THEN
           !               stop 'On tombe sur le cas particulier de thermcell_dry'
           !               PRINT*,'On tombe sur le cas particulier de thermcell_plume'
@@ -1012,5 +1012,5 @@
         endif
 
-        if (zw2(ig, l + 1)<0.) THEN
+        IF (zw2(ig, l + 1)<0.) THEN
           linter(ig) = (l * (zw2(ig, l + 1) - zw2(ig, l))  &
                   - zw2(ig, l)) / (zw2(ig, l + 1) - zw2(ig, l))
@@ -1025,8 +1025,8 @@
         wa_moy(ig, l + 1) = sqrt(zw2(ig, l + 1))
 
-        if (wa_moy(ig, l + 1)>wmaxa(ig)) THEN
+        IF (wa_moy(ig, l + 1)>wmaxa(ig)) THEN
           !   lmix est le niveau de la couche ou w (wa_moy) est maximum
           !on rajoute le calcul de lmix_bis
-          if (zqla(ig, l)<1.e-10) THEN
+          IF (zqla(ig, l)<1.e-10) THEN
             lmix_bis(ig) = l + 1
           endif
@@ -1036,5 +1036,5 @@
       enddo
 
-      if (nbpb>0) THEN
+      IF (nbpb>0) THEN
         PRINT*, 'WARNING on tombe ', nbpb, ' x sur un pb pour l=', l, ' dans thermcell_plume'
       endif
@@ -1055,5 +1055,5 @@
     enddo
 
-    if (prt_level>=20) PRINT*, 'coucou calcul detr 470: ig, l', ig, l
+    IF (prt_level>=20) PRINT*, 'coucou calcul detr 470: ig, l', ig, l
   end
 END MODULE lmdz_thermcell_plume_6A
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_qsat.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_qsat.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_qsat.F90	(revision 5117)
@@ -24,5 +24,5 @@
 REAL Tbef(klon),DT(klon)
 REAL tdelta,qsatbef,zcor,qlbef,zdelta,zcvm5,dqsat,num,denom,dqsat_dT
-logical Zsat
+LOGICAL Zsat
 REAL RLvCp
 
@@ -49,5 +49,5 @@
 
 DO ig=1,klon
-   if (active(ig)) THEN
+   IF (active(ig)) THEN
                Tbef(ig)=ztemp(ig)
                zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
@@ -65,6 +65,6 @@
 ! On ne condense pas mais on dit que le qsat est le qta
 DO ig=1,klon
-   if (active(ig)) THEN
-      if (0.<abs(DT(ig)).and.abs(DT(ig))<=DDT0) THEN
+   IF (active(ig)) THEN
+      IF (0.<abs(DT(ig)).AND.abs(DT(ig))<=DDT0) THEN
          zqsat(ig)=zqta(ig)
       endif
@@ -75,5 +75,5 @@
     afaire(:)=abs(DT(:))>DDT0
     do ig=1,klon
-               if (afaire(ig)) THEN
+               IF (afaire(ig)) THEN
                  Tbef(ig)=Tbef(ig)+DT(ig)
                  zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_wake.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_wake.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_wake.F90	(revision 5117)
@@ -771,5 +771,5 @@
   END DO
 #ifdef IOPHYS_WK
-  IF (.not.phys_sub) CALL iophys_ecrit('wape_a',1,'wape_a','J/kg',wape)
+  IF (.NOT.phys_sub) CALL iophys_ecrit('wape_a',1,'wape_a','J/kg',wape)
 #endif
 
@@ -870,5 +870,5 @@
 
   ! ------------------------------------------------------------------------
-    ! wk_adv is the logical flag enabling wake evolution in the time advance
+    ! wk_adv is the LOGICAL flag enabling wake evolution in the time advance
     ! loop
     DO i = 1, klon
@@ -1293,5 +1293,5 @@
 
 !!    IF (prt_level>=10) THEN
-    IF (prt_level>=10 .and. wk_adv(igout)) THEN
+    IF (prt_level>=10 .AND. wk_adv(igout)) THEN
       PRINT *, 'wake-4.3, th1(igout,k) ', (k,th1(igout,k), k=1,kupper(igout))
       PRINT *, 'wake-4.3, th2(igout,k) ', (k,th2(igout,k), k=1,kupper(igout))
@@ -1862,5 +1862,5 @@
 
 #ifdef IOPHYS_WK
-    IF (.not.phys_sub) CALL iophys_ecrit('wape_b',1,'wape_b','J/kg',wape)
+    IF (.NOT.phys_sub) CALL iophys_ecrit('wape_b',1,'wape_b','J/kg',wape)
 #endif
   IF (prt_level>=10) THEN
@@ -2005,5 +2005,5 @@
   END DO
 #ifdef IOPHYS_WK
-  IF (.not.phys_sub) CALL iophys_ecrit('wape2_a',1,'wape2_a','J/kg',wape2)
+  IF (.NOT.phys_sub) CALL iophys_ecrit('wape2_a',1,'wape2_a','J/kg',wape2)
 #endif
 
@@ -2023,5 +2023,5 @@
         !! print *,'wake, sum_half_dth(i), sum_dth(i) ', &
         !!                sum_half_dth(i), sum_dth(i)
-        IF ((hw0(i) < 1.) .or. (dthmin(i) >= -delta_t_min) ) THEN
+        IF ((hw0(i) < 1.) .OR. (dthmin(i) >= -delta_t_min) ) THEN
           wape2(i) = -1.
           !! print *,'wake, rej 1'
@@ -2037,5 +2037,5 @@
   END IF
 #ifdef IOPHYS_WK
-  IF (.not.phys_sub) CALL iophys_ecrit('wape2_b',1,'wape2_b','J/kg',wape2)
+  IF (.NOT.phys_sub) CALL iophys_ecrit('wape2_b',1,'wape2_b','J/kg',wape2)
 #endif
 
@@ -2083,5 +2083,5 @@
       END IF
 #ifdef IOPHYS_WK
-  IF (.not.phys_sub) CALL iophys_ecrit('cstar2',1,'cstar2','J/kg',cstar2)
+  IF (.NOT.phys_sub) CALL iophys_ecrit('cstar2',1,'cstar2','J/kg',cstar2)
 #endif
     END IF  ! (ok_qx_qw(i))
@@ -2119,5 +2119,5 @@
     IF (iflag_wk_pop_dyn >= 3) THEN
 #ifdef IOPHYS_WK
-      IF (.not.phys_sub) THEN
+      IF (.NOT.phys_sub) THEN
        CALL iophys_ecrit('fip',1,'fip','J/kg',fip)
        CALL iophys_ecrit('hw',1,'hw','J/kg',hw)
@@ -2157,5 +2157,5 @@
        CALL iophys_ecrit('d_asig_death2',1,'d_asig_death2','m',d_asig_death2)
        CALL iophys_ecrit('d_asig_bnd2',1,'d_asig_bnd2','m',d_asig_bnd2)
-      ENDIF  ! (.not.phys_sub)
+      ENDIF  ! (.NOT.phys_sub)
 #endif
     ENDIF  ! (iflag_wk_pop_dyn >= 3)
@@ -2264,5 +2264,5 @@
   ENDIF
 #ifdef IOPHYS_WK
-  IF (.not.phys_sub) CALL iophys_ecrit('wape_c',1,'wape_c','J/kg',wape)
+  IF (.NOT.phys_sub) CALL iophys_ecrit('wape_c',1,'wape_c','J/kg',wape)
 #endif
 
@@ -2610,9 +2610,9 @@
     END DO
     
-    if (abs(iflag_wk_new_ptop) == 1 ) THEN
+    IF (abs(iflag_wk_new_ptop) == 1 ) THEN
         DO k = 2, klev+1
            Do i = 1, klon
               IF (wk_adv(i)) THEN
-                 if (k<=k_ptop_provis(i)) THEN
+                 IF (k<=k_ptop_provis(i)) THEN
                       ddd=dth(i,k-1)*(ph(i,k-1) - max(ptop_provis(i),ph(i,k)))
                       !ddd=dth(i,k-1)*(ph(i,k-1) - ph(i,k))
@@ -2636,8 +2636,8 @@
               dthmin(i)=min(dthmin(i),dth(i,k))
               ddd=dth(i,k)*(ph(i,k)-ph(i,k+1))
-              if (dthmin(i)<0.) THEN
-                  if (k>=k_ptop_provis(i)) THEN
+              IF (dthmin(i)<0.) THEN
+                  IF (k>=k_ptop_provis(i)) THEN
                       ddd=0.
-                  else if (dth(i,k)>=0.) THEN
+                  ELSE IF (dth(i,k)>=0.) THEN
                       ddd=0.
                       k_ptop_provis(i)=k+1
@@ -2649,5 +2649,5 @@
 
         DO i = 1, klon
-           if ( k_ptop_provis(i)==klev+1 .or. .not. wk_adv(i)) THEN
+           IF ( k_ptop_provis(i)==klev+1 .OR. .NOT. wk_adv(i)) THEN
                 k_ptop_provis(i)=1
            endif
@@ -2661,5 +2661,5 @@
     ! On se limite ?? des poches avec integrale dT * dp < -wk_int_delta_t_min
     do i=1,klon
-          if (int_dth(i,k_ptop_provis(i)) > -wk_int_delta_t_min .or. k_ptop_provis(i)==1) THEN
+          IF (int_dth(i,k_ptop_provis(i)) > -wk_int_delta_t_min .OR. k_ptop_provis(i)==1) THEN
           !if (1==0) THEN
              wk_active(i)=.FALSE.
@@ -2695,5 +2695,5 @@
            !PRINT*, ipas,'xxx1, int_dth(i,ktop1(i)), frac_int_dth(i), int_dth(i,ktop1(i)+1) ',ktop1
            ddd=int_dth(i,ktop1(i)+1)-int_dth(i,ktop1(i))
-           if (ddd==0.) THEN
+           IF (ddd==0.) THEN
               omega(i)=0.
            else
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_wake_ini.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_wake_ini.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_wake_ini.F90	(revision 5117)
@@ -103,7 +103,7 @@
 
   USE lmdz_ioipsl_getin_p, ONLY: getin_p
-  real eps
-  integer, intent(in) :: prt_lev
-  real, intent(in) :: rg_in,rd_in,rv_in
+  REAL eps
+  INTEGER, INTENT(IN) :: prt_lev
+  REAL, INTENT(IN) :: rg_in,rd_in,rv_in
 
   smallestreal=tiny(smallestreal)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lsc_scav.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lsc_scav.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lsc_scav.F90	(revision 5117)
@@ -187,5 +187,5 @@
         beta=beta/zmass(i,k)/oliq
         beta=MAX(0.,beta)
-      ENDIF ! (iflag_lscav .eq. 4)
+      ENDIF ! (iflag_lscav .EQ. 4)
       beta_v1(i,k)=beta    !! for output
 
@@ -253,5 +253,5 @@
 !                +d_tr_bcscav(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG  &
 !                +d_tr_evap(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG
-!      IF(it.eq.3) WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)'),&
+!      IF(it.EQ.3) WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)'),&
 !      k,'lsc conserv ',conserv,'insc',d_tr_insc(i,k,it),'bc',d_tr_bcscav(i,k,it),'ev',d_tr_evap(i,k,it)
 !       ENDDO
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/minmaxqfi.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/minmaxqfi.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/minmaxqfi.F90	(revision 5117)
@@ -26,5 +26,5 @@
      IF (jbad>0) THEN
         WRITE(*,*)comment, "  k = ", k, "jbad > 0"
-        if (prt_level >= 1) THEN
+        IF (prt_level >= 1) THEN
            DO i = 1, jbad
               WRITE(*,*) "i,q=", jadrs(i), zq(jadrs(i),k)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/moy_undefSTD.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/moy_undefSTD.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/moy_undefSTD.F90	(revision 5117)
@@ -6,5 +6,5 @@
   USE dimphy
   USE phys_state_var_mod
-  USE wxios, ONLY: missing_val_xios => missing_val, using_xios
+  USE lmdz_wxios, ONLY: missing_val_xios => missing_val, using_xios
  
   USE phys_cal_mod, ONLY: mth_len
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/o3_chem_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/o3_chem_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/o3_chem_m.F90	(revision 5117)
@@ -17,51 +17,51 @@
     ! Index "(i, :)" is for longitude "rlon(i)", latitude "rlat(i)".
 
-    use lmdz_assert, ONLY: assert
-    use dimphy, ONLY: klon
-    use regr_pr_comb_coefoz_m, ONLY: c_Mob, a4_mass, a2, r_het_interm
-    use lmdz_grid_phy, ONLY: nbp_lev
-    use nrtype, ONLY: pi
+    USE lmdz_assert, ONLY: assert
+    USE dimphy, ONLY: klon
+    USE regr_pr_comb_coefoz_m, ONLY: c_Mob, a4_mass, a2, r_het_interm
+    USE lmdz_grid_phy, ONLY: nbp_lev
+    USE lmdz_physical_constants, ONLY: pi
 
-    integer, intent(in):: julien ! jour julien, 1 <= julien <= 360
-    real, intent(in):: gmtime ! heure de la journée en fraction de jour
-    real, intent(in):: t_seri(:, :) ! (klon, nbp_lev) temperature, in K
+    INTEGER, INTENT(IN):: julien ! jour julien, 1 <= julien <= 360
+    REAL, INTENT(IN):: gmtime ! heure de la journée en fraction de jour
+    REAL, INTENT(IN):: t_seri(:, :) ! (klon, nbp_lev) temperature, in K
 
-    real, intent(in):: zmasse(:, :) ! (klon, nbp_lev)
+    REAL, INTENT(IN):: zmasse(:, :) ! (klon, nbp_lev)
     ! (column-density of mass of air in a cell, in kg m-2)
     ! "zmasse(:, k)" is for layer "k".)
 
-    real, intent(in):: pdtphys ! time step for physics, in s
+    REAL, INTENT(IN):: pdtphys ! time step for physics, in s
 
-    REAL, intent(in):: rlat(:), rlon(:)
+    REAL, INTENT(IN):: rlat(:), rlon(:)
     ! (longitude and latitude of each horizontal position, in degrees)
 
-    real, intent(inout):: q(:, :) ! (klon, nbp_lev) mass fraction of ozone
+    REAL, INTENT(INOUT):: q(:, :) ! (klon, nbp_lev) mass fraction of ozone
     ! "q(:, k)" is at middle of layer "k".)
 
     ! Variables local to the procedure:
     ! (for "pi")
-    integer k
+    INTEGER k
 
-    real c(klon, nbp_lev)
+    REAL c(klon, nbp_lev)
     ! (constant term during a time step in the net mass production
     ! rate of ozone by chemistry, per unit mass of air, in s-1)
     ! "c(:, k)" is at middle of layer "k".)
 
-    real b(klon, nbp_lev)
+    REAL b(klon, nbp_lev)
     ! (coefficient of "q" in the net mass production
     ! rate of ozone by chemistry, per unit mass of air, in s-1)
     ! "b(:, k)" is at middle of layer "k".)
 
-    real dq_o3_chem(klon, nbp_lev)
+    REAL dq_o3_chem(klon, nbp_lev)
     ! (variation of ozone mass fraction due to chemistry during a time step)
     ! "dq_o3_chem(:, k)" is at middle of layer "k".)
 
-    real earth_long
+    REAL earth_long
     ! (longitude vraie de la Terre dans son orbite solaire, par
     ! rapport au point vernal (21 mars), en degrés)
 
-    real pmu0(klon) ! mean of cosine of solar zenith angle during "pdtphys"
-    real trash1
-    real trash2(klon)
+    REAL pmu0(klon) ! mean of cosine of solar zenith angle during "pdtphys"
+    REAL trash1
+    REAL trash2(klon)
 
     !-------------------------------------------------------------
@@ -115,27 +115,27 @@
     ! Index "(i, :)" is for longitude "rlon(i)", latitude "rlat(i)".
 
-    use regr_pr_comb_coefoz_m, ONLY: a6_mass
-    use lmdz_assert, ONLY: assert
-    use dimphy, ONLY: klon
-    use lmdz_grid_phy, ONLY: nbp_lev
+    USE regr_pr_comb_coefoz_m, ONLY: a6_mass
+    USE lmdz_assert, ONLY: assert
+    USE dimphy, ONLY: klon
+    USE lmdz_grid_phy, ONLY: nbp_lev
 
-    real, intent(in):: q(:, :) ! mass fraction of ozone
+    REAL, INTENT(IN):: q(:, :) ! mass fraction of ozone
     ! "q(:, k)" is at middle of layer "k".)
 
-    real, intent(in):: zmasse(:, :)
+    REAL, INTENT(IN):: zmasse(:, :)
     ! (column-density of mass of air in a layer, in kg m-2)
     ! ("zmasse(:, k)" is for layer "k".)
 
-    real, intent(in):: c(:, :)
+    REAL, INTENT(IN):: c(:, :)
     ! (constant term during a time step in the net mass production
     ! rate of ozone by chemistry, per unit mass of air, in s-1)
     ! "c(:, k)" is at middle of layer "k".)
 
-    real, intent(in):: b(:, :)
+    REAL, INTENT(IN):: b(:, :)
     ! (coefficient of "q" in the net mass production rate of ozone by
     ! chemistry, per unit mass of air, in s-1)
     ! ("b(:, k)" is at middle of layer "k".)
 
-    real o3_prod(klon, nbp_lev)
+    REAL o3_prod(klon, nbp_lev)
     ! (net mass production rate of ozone by chemistry, per unit mass
     ! of air, in s-1)
@@ -144,9 +144,9 @@
     ! Variables local to the procedure:
 
-    real sigma_mass(klon, nbp_lev)
+    REAL sigma_mass(klon, nbp_lev)
     ! (mass column-density of ozone above point, in kg m-2)
     ! ("sigma_mass(:, k)" is at middle of layer "k".)
 
-    integer k
+    INTEGER k
 
     !-------------------------------------------------------------------
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/oasis.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/oasis.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/oasis.F90	(revision 5117)
@@ -112,5 +112,5 @@
     USE surface_data, ONLY: version_ocean
     USE carbon_cycle_mod, ONLY: carbon_cycle_cpl
-    USE wxios, ONLY: wxios_context_init
+    USE lmdz_wxios, ONLY: wxios_context_init
     USE chemistry_cycle_mod, ONLY: dms_cycle_cpl, n2o_cycle_cpl
     USE lmdz_xios  
@@ -197,5 +197,5 @@
     infosend(ids_calvin)%action = .TRUE. ; infosend(ids_calvin)%name = 'COCALVIN'
     
-    if (activate_ocean_skin == 2) THEN
+    IF (activate_ocean_skin == 2) THEN
        infosend(ids_delta_sst)%action = .TRUE.
        infosend(ids_delta_sst)%name = 'CODELSST'
@@ -247,5 +247,5 @@
    inforecv(idr_icetem)%action = .TRUE. ; inforecv(idr_icetem)%name = 'SIICTEMW'
 
-   if (activate_ocean_skin >= 1) THEN
+   IF (activate_ocean_skin >= 1) THEN
       inforecv(idr_sss)%action = .TRUE.
       inforecv(idr_sss)%name = 'SISUSALW'
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_cpl_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_cpl_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_cpl_mod.F90	(revision 5117)
@@ -67,5 +67,5 @@
     USE cpl_mod, ONLY: gath2cpl, cpl_receive_ocean_fields, &
          cpl_send_ocean_fields
-    use config_ocean_skin_m, ONLY: activate_ocean_skin
+    USE config_ocean_skin_m, ONLY: activate_ocean_skin
 
     INCLUDE "YOMCST.h"
@@ -92,23 +92,23 @@
     REAL, INTENT(IN) :: tsurf_in(:) ! (klon)
 
-    real, intent(in):: delta_sal(:) ! (knon)
+    REAL, INTENT(IN):: delta_sal(:) ! (knon)
     ! ocean-air interface salinity minus bulk salinity, in ppt
 
-    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
-
-    REAL, intent(in):: delta_sst(:) ! (knon)
+    REAL, INTENT(IN):: rhoa(:) ! (knon) density of moist air  (kg / m3)
+
+    REAL, INTENT(IN):: delta_sst(:) ! (knon)
     ! Ocean-air interface temperature minus bulk SST, in K. Defined
     ! only if activate_ocean_skin >= 1.
 
-    REAL, intent(in):: dter(:) ! (knon)
+    REAL, INTENT(IN):: dter(:) ! (knon)
     ! Temperature variation in the diffusive microlayer, that is
     ! ocean-air interface temperature minus subskin temperature. In
     ! K.
 
-    REAL, intent(in):: dser(:) ! (knon)
+    REAL, INTENT(IN):: dser(:) ! (knon)
     ! Salinity variation in the diffusive microlayer, that is
     ! ocean-air interface salinity minus subskin salinity. In ppt.
 
-    real, intent(in):: dt_ds(:) ! (knon)
+    REAL, INTENT(IN):: dt_ds(:) ! (knon)
     ! (tks / tkt) * dTer, in K
 
@@ -126,5 +126,5 @@
     REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
     REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l      
-    REAL, intent(out):: sens_prec_liq(:) ! (knon)
+    REAL, INTENT(OUT):: sens_prec_liq(:) ! (knon)
 
     REAL, INTENT(OUT):: sss(:) ! (klon)
@@ -182,5 +182,5 @@
          sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
 
-    if (activate_ocean_skin == 2) THEN
+    IF (activate_ocean_skin == 2) THEN
        ! tsurf_new was set to tsurf_in in calcul_flux, correct it to
        ! the new bulk SST tsurf_cpl:
@@ -281,5 +281,5 @@
     REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
     REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
-    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
+    REAL, INTENT(IN):: rhoa(:) ! (knon) density of moist air  (kg / m3)
 
 ! In/output arguments
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_forced_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_forced_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_forced_mod.F90	(revision 5117)
@@ -40,5 +40,5 @@
     USE indice_sol_mod
     USE phys_output_var_mod, ONLY: sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
-    use config_ocean_skin_m, ONLY: activate_ocean_skin
+    USE config_ocean_skin_m, ONLY: activate_ocean_skin
 #ifdef ISO
     USE infotrac_phy, ONLY: ntiso,niso
@@ -69,5 +69,5 @@
     REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
     REAL, DIMENSION(klon), INTENT(IN)        :: tsurf_in
-    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
+    REAL, INTENT(IN):: rhoa(:) ! (knon) density of moist air  (kg / m3)
 
 #ifdef ISO
@@ -94,5 +94,5 @@
     REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
     REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l
-    REAL, intent(out):: sens_prec_liq(:) ! (knon)
+    REAL, INTENT(OUT):: sens_prec_liq(:) ! (knon)
 
 #ifdef ISO     
@@ -142,6 +142,6 @@
 !****************************************************************************************
 !--sb:
-!!jyg    if (knon.eq.1) then ! single-column model
-    if (klon_glo==1) then ! single-column model
+!!jyg    if (knon.EQ.1) then ! single-column model
+    IF (klon_glo==1) then ! single-column model
       ! EV: now surface Tin flux_arp.h
       !CALL read_tsurf1d(knon,tsurf_lim) ! new
@@ -195,5 +195,5 @@
          tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
          sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
-    if (activate_ocean_skin == 2) tsurf_new = tsurf_lim
+    IF (activate_ocean_skin == 2) tsurf_new = tsurf_lim
 
     do j = 1, knon
@@ -297,5 +297,5 @@
     REAL, DIMENSION(klon), INTENT(IN)    :: ps
     REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1, gustiness
-    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
+    REAL, INTENT(IN):: rhoa(:) ! (knon) density of moist air  (kg / m3)
 #ifdef ISO
     REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/open_climoz_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/open_climoz_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/open_climoz_m.F90	(revision 5117)
@@ -28,7 +28,7 @@
     ! Arguments (OpenMP shared):
     INTEGER, INTENT(OUT) :: ncid      !--- "climoz_LMDZ.nc" identifier
-    REAL, allocatable, intent(out) :: press_in_cen(:) !--- at cells centers
-    REAL, allocatable, INTENT(OUT) :: press_in_edg(:) !--- at the interfaces (pressure intervals)
-    REAL, allocatable, intent(out) :: time_in(:)      !--- records times, in days since Jan. 1st
+    REAL, ALLOCATABLE, INTENT(OUT) :: press_in_cen(:) !--- at cells centers
+    REAL, ALLOCATABLE, INTENT(OUT) :: press_in_edg(:) !--- at the interfaces (pressure intervals)
+    REAL, ALLOCATABLE, INTENT(OUT) :: time_in(:)      !--- records times, in days since Jan. 1st
     LOGICAL, INTENT(IN) :: daily     !--- daily files (calendar dependent days nb)
     LOGICAL, INTENT(IN) :: adjust    !--- tropopause adjustement required
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/orografi.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/orografi.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/orografi.F90	(revision 5117)
@@ -146,5 +146,5 @@
   ! --------------------
 
-  ! implicit logical (l)
+  ! implicit LOGICAL (l)
 
   ! method.
@@ -214,5 +214,5 @@
 
   ! ztmst=twodt
-  ! IF(nstep.eq.nstart) ztmst=0.5*twodt
+  ! IF(nstep.EQ.nstart) ztmst=0.5*twodt
   ! ym      klevm1=klev-1
   ztmst = ptsphy
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/orografi_strato.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/orografi_strato.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/orografi_strato.F90	(revision 5117)
@@ -287,5 +287,5 @@
 
   ! ztmst=twodt
-  ! IF(nstep.eq.nstart) ztmst=0.5*twodt
+  ! IF(nstep.EQ.nstart) ztmst=0.5*twodt
   ztmst = ptsphy
 
@@ -1034,6 +1034,6 @@
       ! or low level flow:  gravity wave stress nul.
 
-      ! lo=(ptau(jl,klev+1).lt.gtsec).or.(kcrit(jl).ge.kknu(jl))
-      ! *      .or.(pvph(jl,klev+1).lt.gvcrit)
+      ! lo=(ptau(jl,klev+1).lt.gtsec).OR.(kcrit(jl).ge.kknu(jl))
+      ! *      .OR.(pvph(jl,klev+1).lt.gvcrit)
       ! IF(lo) ptau(jl,klev+1)=0.0
 
@@ -1858,5 +1858,5 @@
   PRINT *, ' DANS SUGWD nktopg=', nktopg
   PRINT *, ' DANS SUGWD nstra=', nstra
-  if (nstra == 0) CALL abort_physic("sugwd_strato", "no level in stratosphere", 1)
+  IF (nstra == 0) CALL abort_physic("sugwd_strato", "no level in stratosphere", 1)
 
   !  Valeurs lues dans les .def, ou attribues dans conf_phys
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/output_physiqex_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/output_physiqex_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/output_physiqex_mod.F90	(revision 5117)
@@ -20,18 +20,18 @@
 
 IMPLICIT NONE
-logical, intent(in) :: debut
-real, intent(in) :: pdtphys,zjulian
-real,intent(in) :: presnivs(klev) ! pseudo-pressure (Pa) of mid-layers
-real,intent(in) :: u(klon,klev) ! eastward zonal wind (m/s)
-real,intent(in) :: v(klon,klev) ! northward meridional wind (m/s)
-real,intent(in) :: t(klon,klev) ! temperature (K)
-real,intent(in) :: theta(klon,klev) ! temperature (K)
-real,intent(in) :: paprs(klon,klev+1) ! interlayer pressure (Pa)
-real,intent(in) :: qx(klon,klev,nqtot) !tracers
-real,intent(in) :: cf(klon,klev) !cloud fraction
-real,intent(in) :: zqr(klon,klev) !rain specifiq content
-real,intent(in) :: zqs(klon,klev) !snow specifiq content
-real,intent(in) :: zqg(klon,klev) !graupel specifiq content
-real,intent(in) :: ptke(klon,klev) !tke
+logical, INTENT(IN) :: debut
+REAL, INTENT(IN) :: pdtphys,zjulian
+REAL,INTENT(IN) :: presnivs(klev) ! pseudo-pressure (Pa) of mid-layers
+REAL,INTENT(IN) :: u(klon,klev) ! eastward zonal wind (m/s)
+REAL,INTENT(IN) :: v(klon,klev) ! northward meridional wind (m/s)
+REAL,INTENT(IN) :: t(klon,klev) ! temperature (K)
+REAL,INTENT(IN) :: theta(klon,klev) ! temperature (K)
+REAL,INTENT(IN) :: paprs(klon,klev+1) ! interlayer pressure (Pa)
+REAL,INTENT(IN) :: qx(klon,klev,nqtot) !tracers
+REAL,INTENT(IN) :: cf(klon,klev) !cloud fraction
+REAL,INTENT(IN) :: zqr(klon,klev) !rain specifiq content
+REAL,INTENT(IN) :: zqs(klon,klev) !snow specifiq content
+REAL,INTENT(IN) :: zqg(klon,klev) !graupel specifiq content
+REAL,INTENT(IN) :: ptke(klon,klev) !tke
 
 REAL :: t_ops ! frequency of the IOIPSL operations (eg average over...)
@@ -40,13 +40,13 @@
 REAL :: dtime
 
-integer,save :: iwrite_phys=1 ! output every iwrite_phys physics step
+INTEGER,save :: iwrite_phys=1 ! output every iwrite_phys physics step
 !$OMP THREADPRIVATE(iwrite_phys)
 INTEGER :: nhori ! horizontal coordinate ID
-integer,save :: nid_hist ! output file ID
+INTEGER,save :: nid_hist ! output file ID
 !$OMP THREADPRIVATE(nid_hist)
-integer, save :: itau=0
+INTEGER, save :: itau=0
 !$OMP THREADPRIVATE(itau)
 
-integer, save :: ioex=1
+INTEGER, save :: ioex=1
 
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ozonecm_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ozonecm_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ozonecm_m.F90	(revision 5117)
@@ -22,5 +22,5 @@
 
     USE dimphy, ONLY: klon, klev
-    use lmdz_assert, ONLY: assert
+    USE lmdz_assert, ONLY: assert
 
     REAL, INTENT (IN) :: rlat(:) ! (klon)
@@ -36,5 +36,5 @@
 
     REAL tozon ! equivalent pressure of ozone above interface "k", in Pa
-    real pi, pl
+    REAL pi, pl
     INTEGER i, k
 
@@ -43,5 +43,5 @@
     ! "k" and the top of the atmosphere (interface "llm + 1"), in kDU.
 
-    real, PARAMETER:: ps=101325.
+    REAL, PARAMETER:: ps=101325.
     REAL, parameter:: an = 360., zo3q3 = 4E-8
     REAL, parameter:: dobson_unit = 2.1415E-5 ! in kg m-2
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/pbl_surface_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/pbl_surface_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/pbl_surface_mod.F90	(revision 5117)
@@ -30,5 +30,5 @@
   USE wx_pbl_mod, ONLY: wx_pbl0_merge, wx_pbl_split, wx_pbl_dts_merge, &
           wx_pbl_check, wx_pbl_dts_check, wx_evappot
-  use config_ocean_skin_m, ONLY: activate_ocean_skin
+  USE config_ocean_skin_m, ONLY: activate_ocean_skin
   USE lmdz_abort_physic, ONLY: abort_physic
 #ifdef ISO
@@ -68,5 +68,5 @@
 
   !FC
-  !  integer, save :: iflag_frein
+  !  INTEGER, save :: iflag_frein
   !  !$OMP THREADPRIVATE(iflag_frein)
 
@@ -217,5 +217,5 @@
     CHARACTER(len=80)             :: abort_message
     CHARACTER(len = 20)           :: modname = 'pbl_surface_init'
-    integer i,ixt
+    INTEGER i,ixt
 
 !****************************************************************************************
@@ -393,5 +393,5 @@
     USE carbon_cycle_mod, ONLY: carbon_cycle_cpl, carbon_cycle_tr, level_coupling_esm
     USE carbon_cycle_mod, ONLY: co2_send, nbcf_out, fields_out, yfields_out, cfname_out
-    use hbtm_mod, ONLY: hbtm
+    USE hbtm_mod, ONLY: hbtm
     USE indice_sol_mod
     USE time_phylmdz_mod, ONLY: day_ini, annee_ref, itau_phy
@@ -408,9 +408,9 @@
 #endif
     USE lmdz_ioipsl_getin_p, ONLY:getin_p
-    use phys_state_var_mod, ONLY: ds_ns, dt_ns, delta_sst, delta_sal, dter, &
+    USE phys_state_var_mod, ONLY: ds_ns, dt_ns, delta_sst, delta_sal, dter, &
             dser, dt_ds, zsig, zmea
-    use phys_output_var_mod, ONLY: tkt, tks, taur, sss
-    use lmdz_blowing_snow_ini, ONLY: zeta_bs
-    USE wxios, ONLY: missing_val_xios => missing_val, using_xios
+    USE phys_output_var_mod, ONLY: tkt, tks, taur, sss
+    USE lmdz_blowing_snow_ini, ONLY: zeta_bs
+    USE lmdz_wxios, ONLY: missing_val_xios => missing_val, using_xios
     USE netcdf, ONLY: missing_val_netcdf => nf90_fill_real
 
@@ -487,5 +487,5 @@
     !wake and off-wake regions
     !albedo SB >>>
-    REAL, DIMENSIOn(6), intent(in) :: SFRWL
+    REAL, DIMENSIOn(6), INTENT(IN) :: SFRWL
     REAL, DIMENSION(klon, nsw, nbsrf), INTENT(INOUT) :: alb_dir, alb_dif
     !albedo SB <<<
@@ -1254,5 +1254,5 @@
  xtevap(:,:,:)=0.
 #endif
-    IF (iflag_pbl<20.or.iflag_pbl>=30) THEN
+    IF (iflag_pbl<20.OR.iflag_pbl>=30) THEN
       zcoefh(:, :, :) = 0.0
       zcoefh(:, 1, :) = 999999. ! zcoefh(:,k=1) should never be used
@@ -1844,6 +1844,6 @@
       ENDIF
 
-      if (nsrf == is_oce .and. activate_ocean_skin >= 1) THEN
-        if (activate_ocean_skin == 2 .and. type_ocean == "couple") THEN
+      IF (nsrf == is_oce .AND. activate_ocean_skin >= 1) THEN
+        IF (activate_ocean_skin == 2 .AND. type_ocean == "couple") THEN
           ydelta_sal(:knon) = delta_sal(ni(:knon))
           ydelta_sst(:knon) = delta_sst(ni(:knon))
@@ -1899,5 +1899,5 @@
 
         IF (prt_level >=10) print *, 'cdrag -> ycdragh ', ycdragh(1:knon)
-      ELSE  !(iflag_split .eq.0)
+      ELSE  !(iflag_split .EQ.0)
 
         ! Faire disparaitre les lignes commentees fin 2015 (le temps des tests)
@@ -1962,5 +1962,5 @@
         IF (prt_level >=10) print *, 'clcdrag -> ycdragh_w ', ycdragh_w(1:knon)
         !!!
-      ENDIF  ! (iflag_split .eq.0)
+      ENDIF  ! (iflag_split .EQ.0)
       !!!
 
@@ -2014,5 +2014,5 @@
         IF (prt_level >=10) print *, 'coef_diff_turb -> ycoefh ', ycoefh(1:knon, :)
 
-      ELSE  !(iflag_split .eq.0)
+      ELSE  !(iflag_split .EQ.0)
 
         IF (prt_level >=10) THEN
@@ -2105,5 +2105,5 @@
         ENDDO
 
-      ENDIF  ! (iflag_split .eq.0)
+      ENDIF  ! (iflag_split .EQ.0)
 
 
@@ -2134,5 +2134,5 @@
 #endif
         )
-      ELSE  !(iflag_split .eq.0)
+      ELSE  !(iflag_split .EQ.0)
         CALL climb_hq_down(knon, ycoefh_x, ypaprs, ypplay, &
         ydelp, yt_x, yq_x, dtime, &
@@ -2173,5 +2173,5 @@
         ENDIF
         !!!
-      ENDIF  ! (iflag_split .eq.0)
+      ENDIF  ! (iflag_split .EQ.0)
       !!!
 
@@ -2186,5 +2186,5 @@
                 !!!
                 AcoefU, AcoefV, BcoefU, BcoefV)
-      ELSE  ! (iflag_split .eq.0)
+      ELSE  ! (iflag_split .EQ.0)
         CALL climb_wind_down(knon, dtime, ycoefm_x, ypplay, ypaprs, yt_x, ydelp, yu_x, yv_x, &
                 !!! nrlmd le 02/05/2011
@@ -2201,5 +2201,5 @@
                 AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w)
         !!!
-      ENDIF  ! (iflag_split .eq.0)
+      ENDIF  ! (iflag_split .EQ.0)
       !!!
 
@@ -2265,5 +2265,5 @@
         !******************************************************************************
 
-        IF (f_z0qh_oce /= 1. .and. nsrf ==is_oce) THEN
+        IF (f_z0qh_oce /= 1. .AND. nsrf ==is_oce) THEN
           ! Si on suit les formulations par exemple de Tessel, on
           ! a z0h=0.4*nu/u*, z0q=0.62*nu/u*, d'ou f_z0qh_oce=0.62/0.4=1.55
@@ -2286,5 +2286,5 @@
           ycdragq_x(1:knon) = ycdragh_x(1:knon)
           ycdragq_w(1:knon) = ycdragh_w(1:knon)
-        ENDIF  ! ( f_z0qh_oce .ne. 1. .and. nsrf .eq.is_oce)
+        ENDIF  ! ( f_z0qh_oce .NE. 1. .AND. nsrf .EQ.is_oce)
 
         CALL wx_pbl_prelim_0(knon, nsrf, dtime, ypplay, ypaprs, ywake_s, &
@@ -2342,6 +2342,6 @@
           ydTs_ins(:) = 0.
           ydqs_ins(:) = 0.
-        ENDIF   ! (iflag_split .eq. 2)
-      ENDIF  ! (iflag_split .eq.0)
+        ENDIF   ! (iflag_split .EQ. 2)
+      ENDIF  ! (iflag_split .EQ.0)
       !!!
       IF (prt_level >=10) THEN
@@ -2691,10 +2691,10 @@
 
         !!  Test sur iflag_split retire le 2/02/2018, sans vraiment comprendre la raison de ce test. (jyg)
-        !!          IF (iflag_split .eq.0) THEN
+        !!          IF (iflag_split .EQ.0) THEN
         DO j = 1, knon
           Kech_h(j) = ycdragh(j) * (1.0 + SQRT(yu(j, 1)**2 + yv(j, 1)**2)) * &
                   ypplay(j, 1) / (RD * yt(j, 1))
         ENDDO
-        !!          ENDIF ! (iflag_split .eq.0)
+        !!          ENDIF ! (iflag_split .EQ.0)
 
         DO j = 1, knon
@@ -2800,7 +2800,7 @@
             ydTs_ins(:) = 0.
             ydqs_ins(:) = 0.
-          ENDIF   ! (iflag_split .eq. 2)
-
-        ELSE    ! (nsrf .ne. is_oce)
+          ENDIF   ! (iflag_split .EQ. 2)
+
+        ELSE    ! (nsrf .NE. is_oce)
           ybeta(1:knon) = 1.
           yevap_pot(1:knon) = yevap(1:knon)
@@ -2815,5 +2815,5 @@
           ydTs_ins(:) = 0.
           ydqs_ins(:) = 0.
-        ENDIF   ! (nsrf .ne. is_oce)
+        ENDIF   ! (nsrf .NE. is_oce)
 
         CALL wx_pbl_split(knon, nsrf, dtime, ywake_s, ybeta, iflag_split, &
@@ -2862,5 +2862,5 @@
                   y_flux_t1_x, y_flux_t1_w, &
                   y_flux_q1_x, y_flux_q1_w)
-        ENDIF   ! (nsrf .ne. is_oce)
+        ENDIF   ! (nsrf .NE. is_oce)
 
       ELSE  ! (iflag_split .ge. 1)
@@ -2882,5 +2882,5 @@
       !!jyg!!
       !!jyg!!!----Diffusion dans le sol dans le cas continental seulement
-      !!jyg!!       IF (nsrf.eq.is_ter) THEN
+      !!jyg!!       IF (nsrf.EQ.is_ter) THEN
       !!jyg!!!----Calcul du coefficient delta_coeff
       !!jyg!!          tau_eq(j)=(ywake_s(j)/2.)*(1./max(wake_cstar(j),0.01))*sqrt(0.4/(3.14*max(wake_dens(j),8e-12)))
@@ -2956,5 +2956,5 @@
 #endif
         )
-      ELSE  !(iflag_split .eq.0)
+      ELSE  !(iflag_split .EQ.0)
         CALL climb_hq_up(knon, dtime, yt_x, yq_x, &
         y_flux_q1_x, y_flux_t1_x, ypaprs, ypplay, &
@@ -2987,5 +2987,5 @@
         )
         !!!
-      ENDIF  ! (iflag_split .eq.0)
+      ENDIF  ! (iflag_split .EQ.0)
       !!!
 
@@ -3002,5 +3002,5 @@
                 y_flux_u, y_flux_v, y_d_u, y_d_v)
         y_d_t_diss(:, :) = 0.
-        IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
+        IF (iflag_pbl>=20 .AND. iflag_pbl<30) THEN
           CALL yamada_c(knon, dtime, ypaprs, ypplay &
                   , yu, yv, yt, y_d_u, y_d_v, y_d_t, ycdragm, ytke, ycoefm, ycoefh, ycoefq, y_d_t_diss, yustar &
@@ -3009,5 +3009,5 @@
         !     PRINT*,'yamada_c OK'
 
-      ELSE  !(iflag_split .eq.0)
+      ELSE  !(iflag_split .EQ.0)
         CALL climb_wind_up(knon, dtime, yu_x, yv_x, y_flux_u1_x, y_flux_v1_x, &
                 !!! nrlmd le 02/05/2011
@@ -3019,5 +3019,5 @@
 
         y_d_t_diss_x(:, :) = 0.
-        IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
+        IF (iflag_pbl>=20 .AND. iflag_pbl<30) THEN
           CALL yamada_c(knon, dtime, ypaprs, ypplay &
                   , yu_x, yv_x, yt_x, y_d_u_x, y_d_v_x, y_d_t_x, ycdragm_x, ytke_x, ycoefm_x, ycoefh_x &
@@ -3036,5 +3036,5 @@
         !!!
         y_d_t_diss_w(:, :) = 0.
-        IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
+        IF (iflag_pbl>=20 .AND. iflag_pbl<30) THEN
           CALL yamada_c(knon, dtime, ypaprs, ypplay &
                   , yu_w, yv_w, yt_w, y_d_u_w, y_d_v_w, y_d_t_w, ycdragm_w, ytke_w, ycoefm_w, ycoefh_w &
@@ -3049,5 +3049,5 @@
         ENDIF
 
-      ENDIF  ! (iflag_split .eq.0)
+      ENDIF  ! (iflag_split .EQ.0)
 
       IF (ok_bs) THEN
@@ -3088,6 +3088,6 @@
             y_d_v(j, k) = y_d_v(j, k) * ypct(j)
             !FC
-            IF  (nsrf == is_ter .and. ifl_pbltree >= 1) THEN
-              !            if (y_d_u_frein(j,k).ne.0. ) THEN
+            IF  (nsrf == is_ter .AND. ifl_pbltree >= 1) THEN
+              !            if (y_d_u_frein(j,k).NE.0. ) THEN
               !        PRINT*, nsrf,'IS_TER ++', y_d_u_frein(j,k)*ypct(j),y_d_u(j,k),j,k
               !            ENDIF
@@ -3117,5 +3117,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
          CALL iso_verif_egalite_vect2D( &
                 y_d_xt,y_d_q, &
@@ -3125,5 +3125,5 @@
 #endif
 
-      ELSE  !(iflag_split .eq.0)
+      ELSE  !(iflag_split .EQ.0)
 
         ! Tendances hors poches
@@ -3209,5 +3209,5 @@
         ENDDO
 
-      ENDIF  ! (iflag_split .eq.0)
+      ENDIF  ! (iflag_split .EQ.0)
       !!!
 
@@ -3226,5 +3226,5 @@
         i = ni(j)
         evap(i, nsrf) = - flux_q(i, 1, nsrf)                  !jyg
-        if (ok_bs) then ; snowerosion(i, nsrf) = flux_qbs(i, 1, nsrf);
+        IF (ok_bs) then ; snowerosion(i, nsrf) = flux_qbs(i, 1, nsrf);
         endif
         beta(i, nsrf) = ybeta(j)                             !jyg
@@ -3334,5 +3334,5 @@
         ENDDO
 
-      ELSE  ! (iflag_split .eq.0)
+      ELSE  ! (iflag_split .EQ.0)
         DO k = 1, klev + 1
           DO j = 1, knon
@@ -3352,5 +3352,5 @@
           ENDDO
         ENDDO
-      ENDIF  ! (iflag_split .eq.0)
+      ENDIF  ! (iflag_split .EQ.0)
       !!!
       DO k = 2, klev
@@ -3492,5 +3492,5 @@
       ENDIF
 
-      if (nsrf == is_oce .and. activate_ocean_skin >= 1) THEN
+      IF (nsrf == is_oce .AND. activate_ocean_skin >= 1) THEN
         delta_sal = missing_val
         ds_ns = missing_val
@@ -3515,5 +3515,5 @@
         sss(ni(:knon)) = ysss(:knon)
 
-        if (activate_ocean_skin == 2 .and. type_ocean == "couple") THEN
+        IF (activate_ocean_skin == 2 .AND. type_ocean == "couple") THEN
           dt_ds = missing_val
           dt_ds(ni(:knon)) = ydt_ds(:knon)
@@ -3549,5 +3549,5 @@
           qairsol(j) = yqsurf(j)
         ENDDO
-      ELSE  ! (iflag_split .eq.0)
+      ELSE  ! (iflag_split .EQ.0)
         DO j = 1, knon
           uzon_x(j) = yu_x(j, 1) + y_d_u_x(j, 1)
@@ -3573,5 +3573,5 @@
         ENDDO
         !!!
-      ENDIF  ! (iflag_split .eq.0)
+      ENDIF  ! (iflag_split .EQ.0)
       !!!
       DO j = 1, knon
@@ -3610,5 +3610,5 @@
                   yt2m, yq2m, yt10m, yq10m, yu10m, yustar, ypblh, rain_f, zxtsol)
         ENDIF
-      ELSE  !(iflag_split .eq.0)
+      ELSE  !(iflag_split .EQ.0)
         IF (iflag_new_t2mq2m==1) THEN
           CALL stdlevvarn(klon, knon, nsrf, zxli, &
@@ -3633,5 +3633,5 @@
         ENDIF
         !!!
-      ENDIF  ! (iflag_split .eq.0)
+      ENDIF  ! (iflag_split .EQ.0)
       !!!
       !!! jyg le 07/02/2012
@@ -3651,5 +3651,5 @@
 
         ENDDO
-      ELSE  !(iflag_split .eq.0)
+      ELSE  !(iflag_split .EQ.0)
         DO j = 1, knon
           i = ni(j)
@@ -3685,5 +3685,5 @@
         ENDDO
         !!!
-      ENDIF  ! (iflag_split .eq.0)
+      ENDIF  ! (iflag_split .EQ.0)
       !!!
 
@@ -3705,5 +3705,5 @@
             qsat2m(i) = qsat2m(i) + zx_qs1 * pctsrf(i, nsrf)
           ENDDO
-        ELSE  ! (iflag_split .eq.0)
+        ELSE  ! (iflag_split .EQ.0)
           DO j = 1, knon
             i = ni(j)
@@ -3729,5 +3729,5 @@
           ENDDO
           !!!
-        ENDIF  ! (iflag_split .eq.0)
+        ENDIF  ! (iflag_split .EQ.0)
         !!!
       ENDIF
@@ -3760,5 +3760,5 @@
           print *, ' Arg. de HBTM: yq ', yq(1:knon, :)
         ENDIF
-      ELSE  ! (iflag_split .eq.0)
+      ELSE  ! (iflag_split .EQ.0)
         CALL HBTM(knon, ypaprs, ypplay, &
                 yt2m_x, yt10m_x, yq2m_x, yq10m_x, yustar_x, ywstar_x, &
@@ -3785,5 +3785,5 @@
                 ytherm_w, ytrmb1_w, ytrmb2_w, ytrmb3_w, ylcl_w)
         !!!
-      ENDIF  ! (iflag_split .eq.0)
+      ENDIF  ! (iflag_split .EQ.0)
       !!!
 
@@ -3810,5 +3810,5 @@
           print *, 'After HBTM: cteiCL ', cteiCL(1:knon, :)
         ENDIF
-      ELSE  !(iflag_split .eq.0)
+      ELSE  !(iflag_split .EQ.0)
         DO j = 1, knon
           i = ni(j)
@@ -3850,5 +3850,5 @@
         ENDIF
         !!!
-      ENDIF  ! (iflag_split .eq.0)
+      ENDIF  ! (iflag_split .EQ.0)
       !!!
 
@@ -3968,5 +3968,5 @@
 
     ! if blowing snow
-    if (ok_bs) THEN
+    IF (ok_bs) THEN
       DO nsrf = 1, nbsrf
         DO k = 1, klev
@@ -4068,5 +4068,5 @@
         ENDDO
       ENDDO
-    ELSE  !(iflag_split .eq.0)
+    ELSE  !(iflag_split .EQ.0)
       DO nsrf = 1, nbsrf
         DO i = 1, klon
@@ -4114,5 +4114,5 @@
       ENDDO
       !!!
-    ENDIF  ! (iflag_split .eq.0)
+    ENDIF  ! (iflag_split .EQ.0)
     !!!
 
@@ -4271,7 +4271,7 @@
 
     USE indice_sol_mod
-    use phys_state_var_mod, ONLY: delta_sal, ds_ns, dt_ns, delta_sst, dter, &
+    USE phys_state_var_mod, ONLY: delta_sal, ds_ns, dt_ns, delta_sst, dter, &
             dser, dt_ds
-    use config_ocean_skin_m, ONLY: activate_ocean_skin
+    USE config_ocean_skin_m, ONLY: activate_ocean_skin
 
     INCLUDE "dimsoil.h"
@@ -4371,7 +4371,7 @@
                 alb_dif(i, k, nsrf) = 0.06
               ENDDO
-              if (activate_ocean_skin >= 1) THEN
-                if (activate_ocean_skin == 2 &
-                        .and. type_ocean == "couple") THEN
+              IF (activate_ocean_skin >= 1) THEN
+                IF (activate_ocean_skin == 2 &
+                        .AND. type_ocean == "couple") THEN
                   delta_sal(i) = 0.
                   delta_sst(i) = 0.
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/perturb_radlwsw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/perturb_radlwsw.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/perturb_radlwsw.F90	(revision 5117)
@@ -3,5 +3,5 @@
 !Case-specific radiative setup
 
-      use dimphy
+      USE dimphy
       IMPLICIT none
       INCLUDE "flux_arp.h"     
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/phyaqua_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/phyaqua_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/phyaqua_mod.F90	(revision 5117)
@@ -31,5 +31,5 @@
             day_ini, day_end
     USE indice_sol_mod
-    USE nrtype, ONLY: pi
+    USE lmdz_physical_constants, ONLY: pi
     !    USE ioipsl
     USE lmdz_phys_para, ONLY: is_master
@@ -133,5 +133,5 @@
     !END IF
 
-    if (year_len/=360) THEN
+    IF (year_len/=360) THEN
       write (*, *) year_len
       CALL abort_physic("iniaqua", 'iniaqua: 360 day calendar is required !', 1)
@@ -232,5 +232,5 @@
     ! else
     phy_alb(:, :) = albedo ! albedo land only (old value condsurf_jyg=0.3)
-    ! endif !alb_ocean
+    ! END IF !alb_ocean
 
     DO i = 1, year_len
@@ -929,5 +929,5 @@
       END IF
 
-      if (type_profil==20) THEN
+      IF (type_profil==20) THEN
         PRINT*, 'Profile SST 20'
         !     Méthode 13 "Qmax2K" plateau réel é|  l'Equateur augmenté +2K
@@ -938,5 +938,5 @@
       endif
 
-      if (type_profil==21) THEN
+      IF (type_profil==21) THEN
         PRINT*, 'Profile SST 21'
         !     Méthode 13 "Qmax2K" plateau réel é|  l'Equateur augmenté +2K
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/phyetat0_get_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/phyetat0_get_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/phyetat0_get_mod.F90	(revision 5117)
@@ -122,5 +122,5 @@
     USE iostart, ONLY: get_field
     USE lmdz_print_control, ONLY: lunout
-    USE strings_mod, ONLY: int2str, maxlen
+    USE lmdz_strings, ONLY: int2str, maxlen
     USE lmdz_abort_physic, ONLY: abort_physic
     IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/phyetat0_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/phyetat0_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/phyetat0_mod.F90	(revision 5117)
@@ -33,5 +33,5 @@
     USE iostart, ONLY: close_startphy, get_field, get_var, open_startphy
     USE infotrac_phy, ONLY: nqtot, nbtr, type_trac, tracers
-    USE readTracFiles_mod, ONLY: maxlen, new2oldH2O
+    USE lmdz_readTracFiles, ONLY: maxlen, new2oldH2O
     USE traclmdz_mod, ONLY: traclmdz_from_restart
     USE carbon_cycle_mod, ONLY: carbon_cycle_init, carbon_cycle_cpl, carbon_cycle_tr, carbon_cycle_rad, co2_send, RCO2_glo
@@ -39,7 +39,7 @@
     USE ocean_slab_mod, ONLY: nslay, tslab, seaice, tice, ocean_slab_init
     USE time_phylmdz_mod, ONLY: init_iteration, pdtphys, itau_phy
-    USE wxios, ONLY: missing_val_xios => missing_val, using_xios
-    use netcdf, ONLY: missing_val_netcdf => nf90_fill_real
-    use config_ocean_skin_m, ONLY: activate_ocean_skin
+    USE lmdz_wxios, ONLY: missing_val_xios => missing_val, using_xios
+    USE netcdf, ONLY: missing_val_netcdf => nf90_fill_real
+    USE config_ocean_skin_m, ONLY: activate_ocean_skin
 
     IMPLICIT none
@@ -61,5 +61,5 @@
     REAL qsurf(klon, nbsrf)
     REAL snow(klon, nbsrf)
-    real fder(klon)
+    REAL fder(klon)
     REAL run_off_lic_0(klon)
     REAL fractint(klon)
@@ -307,5 +307,5 @@
     !===================================================================
 
-    if (iflag_physiq <= 1) THEN
+    IF (iflag_physiq <= 1) THEN
       !===================================================================
       ! Lecture des temperatures du sol profond:
@@ -376,5 +376,5 @@
         !  found=phyetat0_srf(treedrg,"treedrg","drag from vegetation" , 0.)
         !lecture du profile de freinage des arbres
-        IF (.not. found) THEN
+        IF (.NOT. found) THEN
           treedrg(:, 1:klev, 1:nbsrf) = 0.0
         ELSE
@@ -585,6 +585,6 @@
     ENDIF ! Slab
 
-    if (activate_ocean_skin >= 1) THEN
-      if (activate_ocean_skin == 2 .and. type_ocean == 'couple') THEN
+    IF (activate_ocean_skin >= 1) THEN
+      IF (activate_ocean_skin == 2 .AND. type_ocean == 'couple') THEN
         found = phyetat0_get(delta_sal, "delta_sal", &
                 "ocean-air interface salinity minus bulk salinity", 0.)
@@ -623,5 +623,5 @@
     ! Initialize module pbl_surface_mod
 
-    if (iflag_physiq <= 1) THEN
+    IF (iflag_physiq <= 1) THEN
       CALL pbl_surface_init(fder, snow, qsurf, tsoil)
     endif
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/phyredem.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/phyredem.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/phyredem.F90	(revision 5117)
@@ -40,5 +40,5 @@
   USE ocean_slab_mod, ONLY: nslay, tslab, seaice, tice, fsic
   USE time_phylmdz_mod, ONLY: annee_ref, day_end, itau_phy, pdtphys
-  use config_ocean_skin_m, ONLY: activate_ocean_skin
+  USE config_ocean_skin_m, ONLY: activate_ocean_skin
   USE lmdz_abort_physic, ONLY: abort_physic
 
@@ -57,5 +57,5 @@
   REAL qsurf(klon, nbsrf)
   REAL snow(klon, nbsrf)
-  real fder(klon)
+  REAL fder(klon)
   REAL run_off_lic_0(klon)
   REAL trs(klon, nbtr)
@@ -76,7 +76,7 @@
   ! Get variables which will be written to restart file from module 
   ! pbl_surface_mod
-  if (iflag_physiq <= 1) THEN
+  IF (iflag_physiq <= 1) THEN
     CALL pbl_surface_final(fder, snow, qsurf, tsoil)
-  endif
+  ENDIF
 
   ! Get a variable calculated in module fonte_neige_mod
@@ -373,12 +373,12 @@
     END IF
 
-    if (ok_gwd_rando) CALL put_field(pass, "du_gwd_rando", &
+    IF (ok_gwd_rando) CALL put_field(pass, "du_gwd_rando", &
             "tendency on zonal wind due to flott gravity waves", du_gwd_rando)
 
-    IF (.not. ok_hines .and. ok_gwd_rando) CALL put_field(pass, "du_gwd_front", &
+    IF (.NOT. ok_hines .AND. ok_gwd_rando) CALL put_field(pass, "du_gwd_front", &
             "tendency on zonal wind due to acama gravity waves", du_gwd_front)
 
-    if (activate_ocean_skin >= 1) THEN
-      if (activate_ocean_skin == 2 .and. type_ocean == 'couple') THEN
+    IF (activate_ocean_skin >= 1) THEN
+      IF (activate_ocean_skin == 2 .AND. type_ocean == 'couple') THEN
         CALL put_field(pass, "delta_sal", &
                 "ocean-air interface salinity minus bulk salinity", delta_sal)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_ctrlout_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_ctrlout_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_ctrlout_mod.F90	(revision 5117)
@@ -16,5 +16,5 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/ histmth, histday, histhf, histins /),'!!!!!!!!!!!!
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!  CHARACTER(len=20), dimension(nfiles) :: TEF = type_ecri_files
+!  CHARACTER(len=20), DIMENSION(nfiles) :: TEF = type_ecri_files
 
 !!! saving lon and lat as variables for CMIP6 DataRequest
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_mod.F90	(revision 5117)
@@ -35,5 +35,5 @@
     USE dimphy
     USE infotrac_phy, ONLY: nqtot, tracers, niso, ntraciso => ntiso
-    USE strings_mod, ONLY: maxlen
+    USE lmdz_strings, ONLY: maxlen
     USE ioipsl
     USE phys_cal_mod, ONLY: hour, calend
@@ -47,10 +47,10 @@
     USE time_phylmdz_mod, ONLY: day_ini, itau_phy, start_time, annee_ref, day_ref
     ! ug Pour les sorties XIOS
-    USE wxios
+    USE lmdz_wxios
     USE infotrac_phy, ONLY: nbtr_bin
 #ifdef ISO
     USE isotopes_mod, ONLY: isoName,iso_HTO
 #ifdef ISOTRAC
-    use isotrac_mod, ONLY: index_zone,index_iso,strtrac
+    USE isotrac_mod, ONLY: index_zone,index_iso,strtrac
 #endif
 #endif
@@ -190,5 +190,5 @@
     ALLOCATE(o_dxtthe(ntraciso))
     ALLOCATE(o_dxtch4(ntraciso))
-    if (iso_HTO.gt.0) THEN
+    IF (iso_HTO.gt.0) THEN
       ALLOCATE(o_dxtprod_nucl(ntraciso))
       ALLOCATE(o_dxtcosmo(ntraciso))
@@ -361,5 +361,5 @@
       IF (using_xios) THEN
         !!! Ouverture de chaque fichier XIOS !!!!!!!!!!!
-        IF (.not. ok_all_xml) THEN
+        IF (.NOT. ok_all_xml) THEN
           IF (prt_level >= 10) THEN
             PRINT*, 'phys_output_open: CALL wxios_add_file with phys_out_filenames(iff)=', trim(phys_out_filenames(iff))
@@ -632,5 +632,5 @@
   SUBROUTINE convers_timesteps(str, dtime, timestep)
 
-    use ioipsl
+    USE ioipsl
     USE phys_cal_mod
     USE time_phylmdz_mod, ONLY: day_ref, annee_ref
@@ -660,12 +660,12 @@
     ENDIF
 
-    IF (type == 'day'.or.type == 'days'.or.type == 'jours'.or.type == 'jour') timestep = ttt * dayseconde
-    IF (type == 'mounths'.or.type == 'mth'.or.type == 'mois') THEN
+    IF (type == 'day'.OR.type == 'days'.OR.type == 'jours'.OR.type == 'jour') timestep = ttt * dayseconde
+    IF (type == 'mounths'.OR.type == 'mth'.OR.type == 'mois') THEN
       WRITE(lunout, *)'annee_ref,day_ref mon_len', annee_ref, day_ref, mth_len
       timestep = ttt * dayseconde * mth_len
     ENDIF
-    IF (type == 'hours'.or.type == 'hr'.or.type == 'heurs') timestep = ttt * dayseconde / 24.
-    IF (type == 'mn'.or.type == 'minutes') timestep = ttt * 60.
-    IF (type == 's'.or.type == 'sec'.or.type == 'secondes') timestep = ttt
+    IF (type == 'hours'.OR.type == 'hr'.OR.type == 'heurs') timestep = ttt * dayseconde / 24.
+    IF (type == 'mn'.OR.type == 'minutes') timestep = ttt * 60.
+    IF (type == 's'.OR.type == 'sec'.OR.type == 'secondes') timestep = ttt
     IF (type == 'TS') timestep = ttt * dtime
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_var_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_var_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_var_mod.F90	(revision 5117)
@@ -5,5 +5,5 @@
 
   USE dimphy
-  USE strings_mod, ONLY: maxlen
+  USE lmdz_strings, ONLY: maxlen
   ! Variables outputs pour les ecritures des sorties
   !======================================================================
@@ -142,7 +142,7 @@
   LOGICAL, SAVE :: vars_defined = .FALSE. ! ug PAS THREADPRIVATE ET C'EST NORMAL
 
-  REAL, allocatable:: zustr_gwd_hines(:), zvstr_gwd_hines(:) ! (klon)
-  REAL, allocatable:: zustr_gwd_front(:), zvstr_gwd_front(:) ! (klon)
-  REAL, allocatable:: zustr_gwd_rando(:), zvstr_gwd_rando(:) ! (klon)
+  REAL, ALLOCATABLE:: zustr_gwd_hines(:), zvstr_gwd_hines(:) ! (klon)
+  REAL, ALLOCATABLE:: zustr_gwd_front(:), zvstr_gwd_front(:) ! (klon)
+  REAL, ALLOCATABLE:: zustr_gwd_rando(:), zvstr_gwd_rando(:) ! (klon)
   !$OMP THREADPRIVATE(zustr_gwd_hines, zvstr_gwd_hines)
   !$OMP THREADPRIVATE(zustr_gwd_front, zvstr_gwd_front)
@@ -185,6 +185,6 @@
   !======================================================================
   SUBROUTINE phys_output_var_init
-    use dimphy
-    use config_ocean_skin_m, ONLY: activate_ocean_skin
+    USE dimphy
+    USE config_ocean_skin_m, ONLY: activate_ocean_skin
 
     IMPLICIT NONE
@@ -236,9 +236,9 @@
 
     IF (ok_hines) allocate(zustr_gwd_hines(klon), zvstr_gwd_hines(klon))
-    IF (.not.ok_hines.and.ok_gwd_rando) &
+    IF (.NOT.ok_hines.AND.ok_gwd_rando) &
                   allocate(zustr_gwd_front(klon), zvstr_gwd_front(klon))
     IF (ok_gwd_rando) allocate(zustr_gwd_rando(klon), zvstr_gwd_rando(klon))
 
-    if (activate_ocean_skin >= 1) allocate(tkt(klon), tks(klon), taur(klon), &
+    IF (activate_ocean_skin >= 1) allocate(tkt(klon), tks(klon), taur(klon), &
          sss(klon))
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_write_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_write_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_write_mod.F90	(revision 5117)
@@ -26,5 +26,5 @@
     USE dimphy, ONLY: klon, klev, klevp1
     USE infotrac_phy, ONLY: nbtr, nqtot, nqo, type_trac, tracers, niso, ntiso
-    USE strings_mod,  ONLY: maxlen
+    USE lmdz_strings,  ONLY: maxlen
     USE lmdz_phys_para, ONLY: is_north_pole_phy,is_south_pole_phy
     USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
@@ -457,5 +457,5 @@
     ! ug Pour les sorties XIOS
     USE lmdz_xios
-    USE wxios, ONLY: wxios_closedef, missing_val_xios=>missing_val, wxios_set_context
+    USE lmdz_wxios, ONLY: wxios_closedef, missing_val_xios=>missing_val, wxios_set_context
     USE phys_cal_mod, ONLY: mth_len
 
@@ -1622,5 +1622,5 @@
           CALL histwrite_phy(o_wdtrainS, wdtrainS)
           CALL histwrite_phy(o_wdtrainM, wdtrainM)
-       ENDIF !(iflag_con.EQ.3.or.iflag_con.EQ.30)
+       ENDIF !(iflag_con.EQ.3.OR.iflag_con.EQ.30)
 !!! nrlmd le 10/04/2012
        IF (iflag_trig_bl>=1) THEN
@@ -1897,5 +1897,5 @@
           CALL histwrite_phy(o_swsrfcs_ant,zx_tmp_fi2d)
           !cf
-          IF (.not. aerosol_couple) THEN
+          IF (.NOT. aerosol_couple) THEN
              IF (vars_defined) zx_tmp_fi2d(:)=topswcf_aero(:,1)*swradcorr(:)
              CALL histwrite_phy(o_swtoacf_nat,zx_tmp_fi2d)
@@ -2410,5 +2410,5 @@
        ENDIF
 
-       IF (.not. ok_hines .and. ok_gwd_rando) THEN
+       IF (.NOT. ok_hines .AND. ok_gwd_rando) THEN
           IF (vars_defined)  zx_tmp_fi3d=du_gwd_front / pdtphys
           CALL histwrite_phy(o_du_gwd_front, zx_tmp_fi3d)
@@ -2814,5 +2814,5 @@
        ENDIF   !(iflag_phytrac==1)
 
-       if (activate_ocean_skin >= 1) THEN
+       IF (activate_ocean_skin >= 1) THEN
           CALL histwrite_phy(o_delta_sst, delta_sst)
           CALL histwrite_phy(o_delta_sal, delta_sal)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/phys_state_var_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/phys_state_var_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/phys_state_var_mod.F90	(revision 5117)
@@ -524,5 +524,5 @@
       ! ocean-air interface salinity minus subskin salinity. In ppt.
 
-      real, SAVE, ALLOCATABLE:: dt_ds(:) ! (klon)
+      REAL, SAVE, ALLOCATABLE:: dt_ds(:) ! (klon)
       ! (tks / tkt) * dTer, in K
 
@@ -540,9 +540,9 @@
 #endif
 USE indice_sol_mod
-use config_ocean_skin_m, ONLY: activate_ocean_skin
-use surface_data, ONLY: type_ocean
+USE config_ocean_skin_m, ONLY: activate_ocean_skin
+USE surface_data, ONLY: type_ocean
 IMPLICIT NONE
 
-integer, intent(in)::  read_climoz
+INTEGER, INTENT(IN)::  read_climoz
 ! read ozone climatology
 ! Allowed values are 0, 1 and 2
@@ -690,5 +690,5 @@
 !albedo SB <<<
 
-      if (read_climoz <= 1) THEN
+      IF (read_climoz <= 1) THEN
          ALLOCATE(wo(klon,klev, 1))
       else
@@ -778,13 +778,13 @@
         du_gwd_rando(:,:)=0.
       ENDIF
-      IF (.not. ok_hines .and. ok_gwd_rando) THEN
+      IF (.NOT. ok_hines .AND. ok_gwd_rando) THEN
         ALLOCATE(du_gwd_front(klon, klev))
         du_gwd_front(:,:) = 0 !ym missing init   
       ENDIF
 
-      if (activate_ocean_skin >= 1) THEN
+      IF (activate_ocean_skin >= 1) THEN
          ALLOCATE(delta_sal(klon), ds_ns(klon), dt_ns(klon), delta_sst(klon), &
               dter(klon), dser(klon))
-         if (activate_ocean_skin == 2 .and. type_ocean == "couple") &
+         IF (activate_ocean_skin == 2 .AND. type_ocean == "couple") &
               allocate(dt_ds(klon))
       end if
@@ -797,6 +797,6 @@
 !USE dimphy
 USE indice_sol_mod
-use config_ocean_skin_m, ONLY: activate_ocean_skin
-use surface_data, ONLY: type_ocean
+USE config_ocean_skin_m, ONLY: activate_ocean_skin
+USE surface_data, ONLY: type_ocean
 IMPLICIT NONE
 include "clesphys.h"
@@ -938,12 +938,12 @@
       DEALLOCATE(tau_aero_lw_rrtm,piz_aero_lw_rrtm,cg_aero_lw_rrtm)
       DEALLOCATE(ccm)
-      if (ok_gwd_rando) DEALLOCATE(du_gwd_rando)
-      if (.not. ok_hines .and. ok_gwd_rando) DEALLOCATE(du_gwd_front)
+      IF (ok_gwd_rando) DEALLOCATE(du_gwd_rando)
+      IF (.NOT. ok_hines .AND. ok_gwd_rando) DEALLOCATE(du_gwd_front)
       DEALLOCATE(ale_bl_trig)
       DEALLOCATE(ratqs_inter_)
 
-      if (activate_ocean_skin >= 1) THEN
+      IF (activate_ocean_skin >= 1) THEN
          deALLOCATE(delta_sal, ds_ns, dt_ns, delta_sst, dter, dser)
-         if (activate_ocean_skin == 2 .and. type_ocean == "couple") &
+         IF (activate_ocean_skin == 2 .AND. type_ocean == "couple") &
               deALLOCATE(dt_ds)
       end if
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90	(revision 5117)
@@ -39,6 +39,6 @@
     USE indice_sol_mod
     USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac
-    USE readTracFiles_mod, ONLY: addPhase
-    USE strings_mod, ONLY: strIdx
+    USE lmdz_readTracFiles, ONLY: addPhase
+    USE lmdz_strings, ONLY: strIdx
     USE iophy
     USE limit_read_mod, ONLY: init_limit_read
@@ -73,7 +73,7 @@
     USE tropopause_m, ONLY: dyn_tropopause
     USE ice_sursat_mod, ONLY: flight_init, airplane
-    USE vampir
+    USE lmdz_vampir
     USE lmdz_write_field_phy
-    USE wxios, ONLY: g_ctx, wxios_set_context
+    USE lmdz_wxios, ONLY: g_ctx, wxios_set_context
     USE lmdz_lscp, ONLY: lscp
     USE lmdz_call_cloud_optics_prop, ONLY: call_cloud_optics_prop
@@ -102,5 +102,5 @@
     USE lmdz_xios, ONLY: xios_update_calendar, xios_context_finalize, xios_get_field_attr, &
             xios_field_is_active, xios_context, xios_set_current_context
-    USE wxios, ONLY: missing_val, using_xios
+    USE lmdz_wxios, ONLY: missing_val, using_xios
     USE paramLMDZ_phy_mod
 
@@ -396,5 +396,5 @@
     !! d_ps----output-R-tendance physique de la pression au sol
     !!======================================================================
-    integer jjmp1
+    INTEGER jjmp1
     !  parameter (jjmp1=jjm+1-1/jjm) ! => (jjmp1=nbp_lat-1/(nbp_lat-1))
     !  integer iip1
@@ -476,5 +476,5 @@
     !$OMP THREADPRIVATE(seuil_inversion)
 
-    real facteur
+    REAL facteur
 
     REAL wmax_th(klon)
@@ -512,5 +512,5 @@
     REAL v(klon, klev)
 
-    REAL, intent(in) :: rot(klon, klev)
+    REAL, INTENT(IN) :: rot(klon, klev)
     ! relative vorticity, in s-1, needed for frontal waves
 
@@ -599,5 +599,5 @@
     INTEGER igwd, idx(klon), itest(klon)
 
-    !      REAL,allocatable,save :: run_off_lic_0(:)
+    !      REAL,ALLOCATABLE,save :: run_off_lic_0(:)
     !$OMP THREADPRIVATE(run_off_lic_0)
     !ym      SAVE run_off_lic_0
@@ -726,10 +726,10 @@
     ! continument (pcon dans
     ! thermcell_main.F90)
-    real fraca0(klon)           ! Fraction des thermiques au LCL
-    real w0(klon)               ! Vitesse des thermiques au LCL
-    real w_conv(klon)           ! Vitesse verticale de grande \'echelle au LCL
-    real tke0(klon, klev + 1)      ! TKE au d\'ebut du pas de temps
-    real therm_tke_max0(klon)   ! TKE dans les thermiques au LCL
-    real env_tke_max0(klon)     ! TKE dans l'environnement au LCL
+    REAL fraca0(klon)           ! Fraction des thermiques au LCL
+    REAL w0(klon)               ! Vitesse des thermiques au LCL
+    REAL w_conv(klon)           ! Vitesse verticale de grande \'echelle au LCL
+    REAL tke0(klon, klev + 1)      ! TKE au d\'ebut du pas de temps
+    REAL therm_tke_max0(klon)   ! TKE dans les thermiques au LCL
+    REAL env_tke_max0(klon)     ! TKE dans l'environnement au LCL
     INTEGER, SAVE :: iflag_thermcell_tke ! transtport TKE by thermals
     !$OMP THREADPRIVATE(iflag_thermcell_tke)
@@ -743,6 +743,6 @@
     !--------Statistical Boundary Layer Closure: ALP_BL--------
     !---Profils de TKE dans et hors du thermique
-    real therm_tke_max(klon, klev)   ! Profil de TKE dans les thermiques
-    real env_tke_max(klon, klev)     ! Profil de TKE dans l'environnement
+    REAL therm_tke_max(klon, klev)   ! Profil de TKE dans les thermiques
+    REAL env_tke_max(klon, klev)     ! Profil de TKE dans l'environnement
 
     !-------Activer les tendances de TKE due a l'orograp??ie---------
@@ -799,7 +799,7 @@
     SAVE lmt_pas                ! frequence de mise a jour
     !$OMP THREADPRIVATE(lmt_pas)
-    real zmasse(klon, nbp_lev), exner(klon, nbp_lev)
+    REAL zmasse(klon, nbp_lev), exner(klon, nbp_lev)
     !     (column-density of mass of air in a cell, in kg m-2)
-    real, parameter :: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
+    REAL, parameter :: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
 
     !IM sorties
@@ -878,5 +878,5 @@
     REAL za
     REAL zx_t, zx_qs, zdelta, zcor
-    real zqsat(klon, klev)
+    REAL zqsat(klon, klev)
 
     INTEGER i, k, iq, nsrf, l, itr
@@ -933,7 +933,7 @@
 
     ! tendance nulles
-    REAL, dimension(klon, klev) :: du0, dv0, dt0, dq0, dql0, dqi0, dqbs0
-    REAL, dimension(klon) :: dsig0, ddens0
-    INTEGER, dimension(klon) :: wkoccur1
+    REAL, DIMENSION(klon, klev) :: du0, dv0, dt0, dq0, dql0, dqi0, dqbs0
+    REAL, DIMENSION(klon) :: dsig0, ddens0
+    INTEGER, DIMENSION(klon) :: wkoccur1
     ! tendance buffer pour appel de add_phys_tend
     REAL, DIMENSION(klon, klev) :: d_q_ch4_dtime
@@ -988,5 +988,5 @@
     INTEGER, SAVE :: iflag_cld_th
     !$OMP THREADPRIVATE(iflag_cld_th)
-    !IM logical ptconv(klon,klev)  !passe dans phys_local_var_mod
+    !IM LOGICAL ptconv(klon,klev)  !passe dans phys_local_var_mod
     !IM cf. AM 081204 BEG
     LOGICAL ptconvth(klon, klev)
@@ -1098,5 +1098,5 @@
 
     ! Parameters
-    LOGICAL ok_ade, ok_aie    ! Apply aerosol (in)direct effects or not
+    LOGICAL ok_ade, ok_aie    ! Apply aerosol (IN)direct effects or not
     LOGICAL ok_alw            ! Apply aerosol LW effect or not
     LOGICAL ok_cdnc ! ok cloud droplet number concentration (O. Boucher 01-2013)
@@ -1183,5 +1183,5 @@
     INTEGER, ALLOCATABLE, SAVE :: iGCM(:), jGCM(:)
     !$OMP THREADPRIVATE(iGCM, jGCM)
-    logical, dimension(nfiles) :: phys_out_filestations
+    logical, DIMENSION(nfiles) :: phys_out_filestations
     logical, parameter :: lNMC = .FALSE.
 
@@ -1193,17 +1193,17 @@
     LOGICAL, SAVE :: mskocean_beta
     !$OMP THREADPRIVATE(mskocean_beta)
-    REAL, dimension(klon, klev) :: beta ! facteur sur cldtaurad et
+    REAL, DIMENSION(klon, klev) :: beta ! facteur sur cldtaurad et
     ! cldemirad pour evaluer les
     ! retros liees aux CRF
-    REAL, dimension(klon, klev) :: cldtaurad   ! epaisseur optique
+    REAL, DIMENSION(klon, klev) :: cldtaurad   ! epaisseur optique
     ! pour radlwsw pour
     ! tester "CRF off"
-    REAL, dimension(klon, klev) :: cldtaupirad ! epaisseur optique
+    REAL, DIMENSION(klon, klev) :: cldtaupirad ! epaisseur optique
     ! pour radlwsw pour
     ! tester "CRF off"
-    REAL, dimension(klon, klev) :: cldemirad   ! emissivite pour
+    REAL, DIMENSION(klon, klev) :: cldemirad   ! emissivite pour
     ! radlwsw pour tester
     ! "CRF off"
-    REAL, dimension(klon, klev) :: cldfrarad   ! fraction nuageuse
+    REAL, DIMENSION(klon, klev) :: cldfrarad   ! fraction nuageuse
 
     REAL :: calday, zxsnow_dummy(klon)
@@ -1220,9 +1220,9 @@
 
     INTEGER :: nbtr_tmp ! Number of tracer inside concvl
-    REAL, dimension(klon, klev) :: sh_in ! Specific humidity entering in phytrac
-    REAL, dimension(klon, klev) :: ch_in ! Condensed humidity entering in phytrac (eau liquide)
-    integer iostat
-
-    REAL, dimension(klon, klev + 1) :: l_mix_ave, wprime_ave
+    REAL, DIMENSION(klon, klev) :: sh_in ! Specific humidity entering in phytrac
+    REAL, DIMENSION(klon, klev) :: ch_in ! Condensed humidity entering in phytrac (eau liquide)
+    INTEGER iostat
+
+    REAL, DIMENSION(klon, klev + 1) :: l_mix_ave, wprime_ave
     REAL zzz
     !albedo SB >>>
@@ -1237,8 +1237,8 @@
     LOGICAL, PARAMETER :: ok_conserv_d_q_con = .FALSE.
 
-    REAL, dimension(klon, klev) :: t_env, q_env
-
-    REAL, dimension(klon) :: pr_et
-    REAL, dimension(klon) :: w_et, jlr_g_c, jlr_g_s
+    REAL, DIMENSION(klon, klev) :: t_env, q_env
+
+    REAL, DIMENSION(klon) :: pr_et
+    REAL, DIMENSION(klon) :: w_et, jlr_g_c, jlr_g_s
 
     REAL pi
@@ -1254,9 +1254,9 @@
     ! 14 mai 2023                                                          !
     !======================================================================!
-    if (debut) then                                                        !
+    IF (debut) then                                                        !
       iflag_physiq = 0
       CALL getin_p('iflag_physiq', iflag_physiq)                          !
     endif                                                                  !
-    if (iflag_physiq == 2) then                                          !
+    IF (iflag_physiq == 2) then                                          !
       CALL physiqex (nlon, nlev, &                                         !
               debut, lafin, pdtphys_, &                                             !
@@ -1363,5 +1363,5 @@
 
       !CR: check sur le nb de traceurs de l eau
-      IF ((iflag_ice_thermo>0).and.(nqo==2)) THEN
+      IF ((iflag_ice_thermo>0).AND.(nqo==2)) THEN
         WRITE (lunout, *) ' iflag_ice_thermo==1 requires 3 H2O tracers ', &
                 '(H2O_g, H2O_l, H2O_s) but nqo=', nqo, '. Might as well stop here.'
@@ -1745,5 +1745,5 @@
       IF (.NOT. create_etat0_limit) CALL init_readaerosolstrato(flag_aerosol_strat)  !! initialise aero strato from file for XIOS interpolation (unstructured_grid)
 
-      if (ok_cosp) THEN
+      IF (ok_cosp) THEN
 #ifdef CPP_COSP
         ! A.I : Initialisations pour le 1er passage a Cosp
@@ -1968,5 +1968,5 @@
                 "On va utiliser le melange convectif des traceurs qui"
         WRITE(lunout, *)"est calcule dans convect4.3"
-        WRITE(lunout, *)" !!! penser aux logical flags de phytrac"
+        WRITE(lunout, *)" !!! penser aux LOGICAL flags de phytrac"
 
         DO i = 1, klon
@@ -2150,5 +2150,5 @@
                 cell_area, ind_cell_glo)
 
-        if (grid_type==unstructured) THEN
+        IF (grid_type==unstructured) THEN
           CALL chemini(pplay, &
                   nbp_lon, nbp_lat, &
@@ -2307,5 +2307,5 @@
     itap = itap + 1
     IF (is_master .OR. prt_level > 9) THEN
-      IF (prt_level > 5 .or. MOD(itap, 5) == 0) THEN
+      IF (prt_level > 5 .OR. MOD(itap, 5) == 0) THEN
         WRITE(LUNOUT, *)'Entering physics elapsed seconds since start ', current_time
         WRITE(LUNOUT, 100)year_cur, mth_cur, day_cur, hour / 3600.
@@ -2751,5 +2751,5 @@
     ! A detruire en 2024 une fois les tests documentes et les choix faits        !
     ! Conservation des variables avant l'appel à l a diffusion pour les tehrmic  !
-    if (iflag_thermals_tenv / 10 == 1) then                                 !
+    IF (iflag_thermals_tenv / 10 == 1) then                                 !
       do k = 1, klev                                                          !
         do i = 1, klon                                                       !
@@ -2758,5 +2758,5 @@
         enddo                                                             !
       enddo                                                                !
-    else if (iflag_thermals_tenv / 10 == 2) then                            !
+    ELSE IF (iflag_thermals_tenv / 10 == 2) then                            !
       do k = 1, klev                                                          !
         do i = 1, klon                                                       !
@@ -2770,6 +2770,6 @@
 
       !jyg+nrlmd<
-      !!jyg       IF (prt_level .ge. 2 .and. mod(iflag_pbl_split,2) .eq. 1) THEN
-      IF (prt_level >= 2 .and. mod(iflag_pbl_split, 10) >= 1) THEN
+      !!jyg       IF (prt_level .ge. 2 .AND. mod(iflag_pbl_split,2) .EQ. 1) THEN
+      IF (prt_level >= 2 .AND. mod(iflag_pbl_split, 10) >= 1) THEN
         print *, 'debut du splitting de la PBL, wake_s = ', wake_s(:)
         print *, 'debut du splitting de la PBL, wake_deltat = ', wake_deltat(:, 1)
@@ -3301,5 +3301,5 @@
           ! où i n'est pas un point convectif et donc ibas_con(i)=0
           ! c'est un pb indépendant des isotopes
-          if (ibas_con(i) > 0) THEN
+          IF (ibas_con(i) > 0) THEN
             ema_pcb(i) = paprs(i, ibas_con(i))
           else
@@ -3556,5 +3556,5 @@
         ! Tests Fredho, instensibilite au pas de temps -------------------------------
         ! A detruire en 2024 une fois les tests documentes et les choix faits        !
-        if (iflag_thermals_tenv / 10 == 0) then                            !
+        IF (iflag_thermals_tenv / 10 == 0) then                            !
           do k = 1, klev                                                      !
             do i = 1, klon                                                   !
@@ -3563,5 +3563,5 @@
             enddo                                                         !
           enddo                                                            !
-        else if (iflag_thermals_tenv / 10 == 2) then                      !
+        ELSE IF (iflag_thermals_tenv / 10 == 2) then                      !
           do k = 1, klev                                                      !
             do i = 1, klon                                                   !
@@ -3569,5 +3569,5 @@
             enddo                                                         !
           enddo                                                            !
-        else if (iflag_thermals_tenv / 10 == 3) then                      !
+        ELSE IF (iflag_thermals_tenv / 10 == 3) then                      !
           do k = 1, klev                                                      !
             do i = 1, klon                                                   !
@@ -3672,5 +3672,5 @@
         ! Transport de la TKE par les panaches thermiques.
         ! FH : 2010/02/01
-        if (iflag_thermcell_tke==1) THEN
+        IF (iflag_thermcell_tke==1) THEN
           CALL thermcell_dtke(klon, klev, nbsrf, pdtphys, fm_therm, entr_therm, rg, paprs, pbl_tke)
         endif
@@ -3692,5 +3692,5 @@
       ! Dans le cas contraire, on demarre au niveau 1.
 
-      IF (iflag_thermals>=13.or.iflag_thermals<=0) THEN
+      IF (iflag_thermals>=13.OR.iflag_thermals<=0) THEN
 
         IF (iflag_thermals==0) THEN
@@ -3885,5 +3885,5 @@
 
     !IM cf FH
-    !     IF (iflag_cld_th.eq.-1) THEN ! seulement pour Tiedtke
+    !     IF (iflag_cld_th.EQ.-1) THEN ! seulement pour Tiedtke
     IF (iflag_cld_th<=-1) THEN ! seulement pour Tiedtke
       snow_tiedtke = 0.
@@ -4004,5 +4004,5 @@
     !        do i=1,klon
     !              zzz=prfl(:,k)+psfl(:,k)
-    !           if (.not.ptconvth.zzz.gt.0.)
+    !           if (.NOT.ptconvth.zzz.gt.0.)
     !        enddo prfl, psfl,
     !     enddo
@@ -4035,5 +4035,5 @@
         zx_t = t_seri(i, k)
         IF (thermcep) THEN
-          !!           if (iflag_ice_thermo.eq.0) then                 !jyg
+          !!           if (iflag_ice_thermo.EQ.0) then                 !jyg
           zdelta = MAX(0., SIGN(1., rtt - zx_t))
           !!           else                                            !jyg
@@ -4830,5 +4830,5 @@
     ENDIF
 
-    IF (.not. ok_hines .and. ok_gwd_rando) THEN
+    IF (.NOT. ok_hines .AND. ok_gwd_rando) THEN
       ! ym missing init for east_gwstress & west_gwstress -> added in phys_local_var_mod
       CALL acama_GWD_rando(PHYS_TSTEP, pplay, latitude_deg, t_seri, u_seri, &
@@ -4890,5 +4890,5 @@
     !IM calcul composantes axiales du moment angulaire et couple des montagnes
 
-    IF (is_sequential .and. ok_orodr) THEN
+    IF (is_sequential .AND. ok_orodr) THEN
       CALL aaam_bud (27, klon, klev, jD_cur - jD_ref, jH_cur, &
               ra, rg, romega, &
@@ -5070,5 +5070,5 @@
       ! adeclarer
 #ifdef CPP_COSP
-       IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
+       IF (itap.EQ.1.OR.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
 
           IF (prt_level .GE.10) THEN
@@ -5101,5 +5101,5 @@
 
 #ifdef CPP_COSP2
-       IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
+       IF (itap.EQ.1.OR.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
 
           IF (prt_level .GE.10) THEN
@@ -5125,5 +5125,5 @@
 
 #ifdef CPP_COSPV2
-       IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
+       IF (itap.EQ.1.OR.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
 !        IF (MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
 
@@ -5160,5 +5160,5 @@
 
     IF (ok_airs) THEN
-      IF (itap==1.or.MOD(itap, NINT(freq_airs / phys_tstep))==0) THEN
+      IF (itap==1.OR.MOD(itap, NINT(freq_airs / phys_tstep))==0) THEN
         WRITE(*, *) 'je vais appeler simu_airs, ok_airs, freq_airs=', ok_airs, freq_airs
         CALL simu_airs(itap, rneb, t_seri, cldemi, fiwc, ref_ice, pphi, pplay, paprs, &
@@ -5456,9 +5456,9 @@
         ENDIF
         !--ice_sursat: nqo=4, on ajoute rneb
-        IF (nqo>=4 .and. ok_ice_sursat) THEN
+        IF (nqo>=4 .AND. ok_ice_sursat) THEN
           d_qx(i, k, irneb) = (rneb_seri(i, k) - qx(i, k, irneb)) / phys_tstep
         ENDIF
 
-        IF (nqo>=4 .and. ok_bs) THEN
+        IF (nqo>=4 .AND. ok_bs) THEN
           d_qx(i, k, ibs) = (qbs_seri(i, k) - qx(i, k, ibs)) / phys_tstep
         ENDIF
@@ -5630,5 +5630,5 @@
 
     ! Petit appelle de sorties pour accompagner le travail sur phyex
-    if (iflag_physiq == 1) THEN
+    IF (iflag_physiq == 1) THEN
       CALL output_physiqex(debut, jD_eq, pdtphys, presnivs, paprs, u, v, t, qx, cldfra, 0. * t, 0. * t, 0. * t, pbl_tke, theta)
     endif
@@ -5678,5 +5678,5 @@
         END IF
 
-        IF (is_omp_master .and. grid_type==unstructured) CALL xios_context_finalize
+        IF (is_omp_master .AND. grid_type==unstructured) CALL xios_context_finalize
       ENDIF
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/physiqex_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/physiqex_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/physiqex_mod.F90	(revision 5117)
@@ -26,25 +26,25 @@
 ! Routine argument:
 
-      integer,intent(in) :: nlon ! number of atmospheric colums
-      integer,intent(in) :: nlev ! number of vertical levels (should be =klev)
-      logical,intent(in) :: debut ! signals first CALL to physics
-      logical,intent(in) :: lafin ! signals last CALL to physics
-      real,intent(in) :: pdtphys ! physics time step (s)
-      real,intent(in) :: paprs(klon,klev+1) ! interlayer pressure (Pa)
-      real,intent(in) :: pplay(klon,klev) ! mid-layer pressure (Pa)
-      real,intent(in) :: pphi(klon,klev) ! geopotential at mid-layer
-      real,intent(in) :: pphis(klon) ! surface geopotential
-      real,intent(in) :: presnivs(klev) ! pseudo-pressure (Pa) of mid-layers
-      real,intent(in) :: u(klon,klev) ! eastward zonal wind (m/s)
-      real,intent(in) :: v(klon,klev) ! northward meridional wind (m/s)
-      real,intent(in) :: rot(klon,klev) ! northward meridional wind (m/s)
-      real,intent(in) :: t(klon,klev) ! temperature (K)
-      real,intent(in) :: qx(klon,klev,nqtot) ! tracers (.../kg_air)
-      real,intent(in) :: flxmass_w(klon,klev) ! vertical mass flux
-      real,intent(out) :: d_u(klon,klev) ! physics tendency on u (m/s/s)
-      real,intent(out) :: d_v(klon,klev) ! physics tendency on v (m/s/s)
-      real,intent(out) :: d_t(klon,klev) ! physics tendency on t (K/s)
-      real,intent(out) :: d_qx(klon,klev,nqtot) ! physics tendency on tracers
-      real,intent(out) :: d_ps(klon) ! physics tendency on surface pressure
+      INTEGER,INTENT(IN) :: nlon ! number of atmospheric colums
+      INTEGER,INTENT(IN) :: nlev ! number of vertical levels (should be =klev)
+      logical,INTENT(IN) :: debut ! signals first CALL to physics
+      logical,INTENT(IN) :: lafin ! signals last CALL to physics
+      REAL,INTENT(IN) :: pdtphys ! physics time step (s)
+      REAL,INTENT(IN) :: paprs(klon,klev+1) ! interlayer pressure (Pa)
+      REAL,INTENT(IN) :: pplay(klon,klev) ! mid-layer pressure (Pa)
+      REAL,INTENT(IN) :: pphi(klon,klev) ! geopotential at mid-layer
+      REAL,INTENT(IN) :: pphis(klon) ! surface geopotential
+      REAL,INTENT(IN) :: presnivs(klev) ! pseudo-pressure (Pa) of mid-layers
+      REAL,INTENT(IN) :: u(klon,klev) ! eastward zonal wind (m/s)
+      REAL,INTENT(IN) :: v(klon,klev) ! northward meridional wind (m/s)
+      REAL,INTENT(IN) :: rot(klon,klev) ! northward meridional wind (m/s)
+      REAL,INTENT(IN) :: t(klon,klev) ! temperature (K)
+      REAL,INTENT(IN) :: qx(klon,klev,nqtot) ! tracers (.../kg_air)
+      REAL,INTENT(IN) :: flxmass_w(klon,klev) ! vertical mass flux
+      REAL,INTENT(OUT) :: d_u(klon,klev) ! physics tendency on u (m/s/s)
+      REAL,INTENT(OUT) :: d_v(klon,klev) ! physics tendency on v (m/s/s)
+      REAL,INTENT(OUT) :: d_t(klon,klev) ! physics tendency on t (K/s)
+      REAL,INTENT(OUT) :: d_qx(klon,klev,nqtot) ! physics tendency on tracers
+      REAL,INTENT(OUT) :: d_ps(klon) ! physics tendency on surface pressure
 
 !    include "clesphys.h"
@@ -62,5 +62,5 @@
 !$OMP THREADPRIVATE(first)
 
-real,save :: rg=9.81
+REAL,save :: rg=9.81
 !$OMP THREADPRIVATE(rg)
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/phytrac_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/phytrac_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/phytrac_mod.F90	(revision 5117)
@@ -123,5 +123,5 @@
     USE dimphy
     USE infotrac_phy, ONLY: nbtr, nqCO2, type_trac, conv_flg, pbl_flg
-    USE strings_mod, ONLY: int2str
+    USE lmdz_strings, ONLY: int2str
     USE lmdz_grid_phy
     USE lmdz_phys_para
@@ -190,5 +190,5 @@
     REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb
     REAL, DIMENSION(klon, klev), INTENT(IN) :: beta_fisrt ! taux de conversion de l'eau cond (de fisrtilp)
-    REAL, DIMENSION(klon, klev), INTENT(out) :: beta_v1    ! -- (originale version)
+    REAL, DIMENSION(klon, klev), INTENT(OUT) :: beta_v1    ! -- (originale version)
 
     INTEGER, DIMENSION(klon), INTENT(IN) :: itop_con
@@ -556,5 +556,5 @@
             flag_cvltr(it) = .FALSE.
           ELSE IF (type_trac == 'coag' .AND. CPPKEY_STRATAER) THEN
-            IF (convscav.and.aerosol(it)) THEN
+            IF (convscav.AND.aerosol(it)) THEN
               flag_cvltr(it) = .TRUE.
               ccntrAA(it) = ccntrAA_in
@@ -565,5 +565,5 @@
             ENDIF
           ELSE IF (type_trac == 'lmdz') THEN
-            IF (convscav.and.aerosol(it)) THEN
+            IF (convscav.AND.aerosol(it)) THEN
               flag_cvltr(it) = .TRUE.
               ccntrAA(it) = ccntrAA_in    !--a modifier par JYG a lire depuis fichier
@@ -576,5 +576,5 @@
         ENDDO
 
-      ELSE ! iflag_con .ne. 3
+      ELSE ! iflag_con .NE. 3
         flag_cvltr(:) = .FALSE.
       ENDIF
@@ -985,5 +985,5 @@
                   !-------------   d_tr_evapls(i,k,it)=-0.5*evaplsc*(d_tr_lsc(i,k+1,it))
                   beta = 0.5 * evaplsc
-                  if ((prfl(i, k) + psfl(i, k))<1.e-10) THEN
+                  IF ((prfl(i, k) + psfl(i, k))<1.e-10) THEN
                     beta = 1.0 * evaplsc
                   endif
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/plevel.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/plevel.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/plevel.F90	(revision 5117)
@@ -10,5 +10,5 @@
   USE dimphy
   USE phys_state_var_mod, ONLY: missing_val_nf90
-  USE wxios, ONLY: missing_val_xios => missing_val, using_xios
+  USE lmdz_wxios, ONLY: missing_val_xios => missing_val, using_xios
   IMPLICIT NONE
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/plevel_new.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/plevel_new.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/plevel_new.F90	(revision 5117)
@@ -10,5 +10,5 @@
   USE dimphy
   USE phys_state_var_mod, ONLY: missing_val_nf90
-  USE wxios, ONLY: missing_val_xios=>missing_val, using_xios
+  USE lmdz_wxios, ONLY: missing_val_xios=>missing_val, using_xios
 
   IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/press_coefoz_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/press_coefoz_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/press_coefoz_m.F90	(revision 5117)
@@ -4,9 +4,9 @@
   IMPLICIT NONE
 
-  real, allocatable, save:: plev(:)
+  REAL, ALLOCATABLE, save:: plev(:)
   ! (pressure level of Mobidic input data, converted to Pa, in strictly
   ! ascending order)
 
-  real, allocatable, save:: press_in_edg(:)
+  REAL, ALLOCATABLE, save:: press_in_edg(:)
   ! (edges of pressure intervals for Mobidic input data, in Pa, in strictly
   ! ascending order)
@@ -23,14 +23,14 @@
     ! and in strictly ascending order.
 
-    use netcdf95, ONLY: nf95_open, nf95_close, nf95_gw_var, nf95_inq_varid
-    use netcdf, ONLY: nf90_nowrite
+    USE netcdf95, ONLY: nf95_open, nf95_close, nf95_gw_var, nf95_inq_varid
+    USE netcdf, ONLY: nf90_nowrite
 
-    use lmdz_phys_mpi_data, ONLY: is_mpi_root
-    use lmdz_phys_mpi_transfert, ONLY: bcast_mpi ! broadcast
+    USE lmdz_phys_mpi_data, ONLY: is_mpi_root
+    USE lmdz_phys_mpi_transfert, ONLY: bcast_mpi ! broadcast
 
     ! Variables local to the procedure:
-    integer ncid, varid ! for NetCDF
-    integer n_plev ! number of pressure levels in the input data
-    integer k
+    INTEGER ncid, varid ! for NetCDF
+    INTEGER n_plev ! number of pressure levels in the input data
+    INTEGER k
 
     !---------------------------------------
@@ -39,5 +39,5 @@
     print *, "Call sequence information: press_coefoz"
 
-    if (is_mpi_root) THEN
+    IF (is_mpi_root) THEN
        CALL nf95_open("coefoz_LMDZ.nc", nf90_nowrite, ncid)
 
@@ -52,10 +52,10 @@
 
     CALL bcast_mpi(n_plev)
-    if (.not. is_mpi_root) allocate(plev(n_plev))
+    IF (.NOT. is_mpi_root) allocate(plev(n_plev))
     CALL bcast_mpi(plev)
     
     ! Compute edges of pressure intervals:
     allocate(press_in_edg(n_plev + 1))
-    if (is_mpi_root) THEN
+    IF (is_mpi_root) THEN
        press_in_edg(1) = 0.
        ! We choose edges halfway in logarithm:
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/print_debug_phys.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/print_debug_phys.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/print_debug_phys.F90	(revision 5117)
@@ -5,9 +5,9 @@
 USE lmdz_geometry, ONLY: longitude_deg, latitude_deg
 IMPLICIT NONE
-integer i,debug_lev
+INTEGER i,debug_lev
 CHARACTER*(*) text
 
 
-integer k
+INTEGER k
 
 PRINT*,'PLANTAGE POUR LE POINT i=',i,text
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/radiation_ar4_param.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/radiation_ar4_param.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/radiation_ar4_param.F90	(revision 5117)
@@ -12,8 +12,8 @@
  REAL(KIND=8), parameter :: RTUMG = 240.0
 
- REAL(KIND=8), dimension(2), parameter :: WG1 = (/1.0, 1.0/)
- REAL(KIND=8), dimension(11), parameter :: TINTP = (/ 187.5, 200., 212.5, 225., 237.5, 250., 262.5, 275., 287.5, 300., 312.5 /)
-
- real(kind=8), dimension(11,16,3), parameter :: GA = reshape ( (/ &
+ REAL(KIND=8), DIMENSION(2), parameter :: WG1 = (/1.0, 1.0/)
+ REAL(KIND=8), DIMENSION(11), parameter :: TINTP = (/ 187.5, 200., 212.5, 225., 237.5, 250., 262.5, 275., 287.5, 300., 312.5 /)
+
+ real(kind=8), DIMENSION(11,16,3), parameter :: GA = reshape ( (/ &
  0.63499072E-02, 0.65566348E-02, 0.67849730E-02, 0.70481947E-02, 0.73585943E-02, 0.77242818E-02, 0.81472693E-02, 0.86227527E-02,&
  0.91396814E-02, 0.96825438E-02, 0.10233955E-01, 0.77266491E-02, 0.81323287E-02, 0.86507620E-02, 0.92776391E-02, 0.99806312E-02,&
@@ -84,5 +84,5 @@
  , (/ 11,16,3 /) )
 
- real(kind=8), dimension(11,16,3), parameter :: GB = reshape ( (/ &
+ real(kind=8), DIMENSION(11,16,3), parameter :: GB = reshape ( (/ &
  0.63499072E-02, 0.65566348E-02, 0.67849730E-02, 0.70481947E-02, 0.73585943E-02, 0.77242818E-02, 0.81472693E-02, 0.86227527E-02,&
  0.91396814E-02, 0.96825438E-02, 0.10233955E-01, 0.77266491E-02, 0.81323287E-02, 0.86507620E-02, 0.92776391E-02, 0.99806312E-02,&
@@ -153,5 +153,5 @@
   , (/ 11,16,3 /) )
 
-      real(kind=8), dimension(6,6), parameter :: XP = reshape ( (/  &
+      real(kind=8), DIMENSION(6,6), parameter :: XP = reshape ( (/  &
       0.46430621E+02,  0.12928299E+03,  0.20732648E+03,  0.31398411E+03,  0.18373177E+03, -0.11412303E+03, &
       0.73604774E+02,  0.27887914E+03,  0.27076947E+03, -0.57322111E+02, -0.64742459E+02,  0.87238280E+02, &
@@ -162,6 +162,6 @@
 
 ! If running with Reporbus type_trac=repr, values of RSUN might be overritten in radiation_AR4
-      REAL(KIND=8), dimension(2) :: RSUN = (/ 0.441676 , 0.558324 /)
-      REAL(KIND=8), dimension(2,6), parameter :: RRAY = reshape ( &
+      REAL(KIND=8), DIMENSION(2) :: RSUN = (/ 0.441676 , 0.558324 /)
+      REAL(KIND=8), DIMENSION(2,6), parameter :: RRAY = reshape ( &
          (/ .428937E-01, .697200E-02,&
             .890743E+00, .173297E-01,&
@@ -171,15 +171,15 @@
             .161645E+01, .129662E+00 /) , (/2,6/) )
 
-      REAL(KIND=8), dimension(2,5), parameter :: TAUA = reshape ( &
+      REAL(KIND=8), DIMENSION(2,5), parameter :: TAUA = reshape ( &
       (/ 0.730719, 0.730719, 0.912819, 0.912819, 0.725059, &
          0.725059, 0.745405, 0.745405, 0.682188, 0.682188 /),(/2,5/) )
-      REAL(KIND=8), dimension(2,5), parameter :: RPIZA = reshape ( &
+      REAL(KIND=8), DIMENSION(2,5), parameter :: RPIZA = reshape ( &
       (/ 0.872212, 0.872212, 0.982545, 0.982545, 0.623143,   &
          0.623143, 0.944887, 0.944887, 0.997975, 0.997975 /),(/2,5/) )
-      REAL(KIND=8), dimension(2,5), parameter :: RCGA = reshape (  &
+      REAL(KIND=8), DIMENSION(2,5), parameter :: RCGA = reshape (  &
       (/ 0.647596, 0.647596, 0.739002, 0.739002, 0.580845,   &
          0.580845, 0.662657, 0.662657, 0.624246, 0.624246 /),(/2,5/) )
 
-      REAL(KIND=8), dimension(2,3,7), parameter :: APAD = reshape (  &
+      REAL(KIND=8), DIMENSION(2,3,7), parameter :: APAD = reshape (  &
           (/ 0.912418292E+05, 0.376655383E-08, 0.000000000E-00,&
              0.739646016E-08, 0.925887084E-04, 0.410177786E+03,&
@@ -196,5 +196,5 @@
              0.000000000E-00, 0.000000000E+00, 0.000000000E-00,&
              0.000000000E+00, 0.000000000E+00, 0.000000000E+00 /) , (/2,3,7/) )
-      REAL(KIND=8), dimension(2,3,7), parameter :: BPAD = reshape (  &
+      REAL(KIND=8), DIMENSION(2,3,7), parameter :: BPAD = reshape (  &
           (/ 0.912418292E+05, 0.376655383E-08, 0.000000000E-00,&
              0.739646016E-08, 0.925887084E-04, 0.410177786E+03,&
@@ -211,10 +211,10 @@
              0.000000000E-00, 0.100000000E+01, 0.000000000E-00,&
              0.100000000E+01, 0.100000000E+01, 0.000000000E+00 /) , (/2,3,7/) )
-      REAL(KIND=8), dimension(2,3), parameter :: D = reshape ( &
+      REAL(KIND=8), DIMENSION(2,3), parameter :: D = reshape ( &
        (/ 0.0, 0.0, 0.0, 0.0, 0.0, 0.8 /) , (/2,3/) )
 
       REAL(KIND=8), parameter :: TREF = 250.0
-      REAL(KIND=8), dimension(2), parameter :: RT1 = (/ -0.577350269, +0.577350269 /)
-      REAL(KIND=8), dimension(5,5), parameter :: RAER= reshape ( &
+      REAL(KIND=8), DIMENSION(2), parameter :: RT1 = (/ -0.577350269, +0.577350269 /)
+      REAL(KIND=8), DIMENSION(5,5), parameter :: RAER= reshape ( &
         (/ .038520, .037196, .040532, .054934, .038520 &
          , .12613 , .18313 , .10357 , .064106, .126130 &
@@ -223,5 +223,5 @@
          , .013792, .026810, .052203, .066338, .013792 /) , (/5,5/) )
 
-      REAL(KIND=8), dimension(8,3), parameter :: AT= reshape ( &
+      REAL(KIND=8), DIMENSION(8,3), parameter :: AT= reshape ( &
        (/ 0.298199E-02,0.143676E-01,0.197861E-01,0.289560E-01,&
           0.103800E-01,0.868859E-02,0.250073E-03,0.307423E-01,&
@@ -231,5 +231,5 @@
           -.161431E-02,0.000000E-00,0.109242E-03,-.322172E-03 /) , (/8,3/) )
 
-      REAL(KIND=8), dimension(8,3), parameter :: BT= reshape ( &
+      REAL(KIND=8), DIMENSION(8,3), parameter :: BT= reshape ( &
        (/ -0.106432E-04,-0.553979E-04,-0.877012E-04,-0.165960E-03,&
           -0.276744E-04,-0.278412E-04, 0.199846E-05,-0.108482E-03,&
@@ -239,5 +239,5 @@
            0.127646E-04 ,0.117469E-05, 0.175991E-06,-0.814575E-06 /) , (/8,3/) )
 
-      REAL(KIND=8), dimension(4), parameter :: OCT = (/ -.326E-03, -.102E-05, .137E-02, -.535E-05 /)
+      REAL(KIND=8), DIMENSION(4), parameter :: OCT = (/ -.326E-03, -.102E-05, .137E-02, -.535E-05 /)
 
  end module radiation_AR4_param
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/radlwsw_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/radlwsw_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/radlwsw_m.F90	(revision 5117)
@@ -195,35 +195,35 @@
 
     ! Input arguments
-    REAL, INTENT(in) :: dist
-    REAL, INTENT(in) :: rmu0(KLON), fract(KLON)
-    REAL, INTENT(in) :: paprs(KLON, KLEV + 1), pplay(KLON, KLEV)
+    REAL, INTENT(IN) :: dist
+    REAL, INTENT(IN) :: rmu0(KLON), fract(KLON)
+    REAL, INTENT(IN) :: paprs(KLON, KLEV + 1), pplay(KLON, KLEV)
     !albedo SB >>>
-    ! REAL,    INTENT(in)  :: alb1(KLON), alb2(KLON), tsol(KLON)
-    REAL, INTENT(in) :: tsol(KLON)
-    REAL, INTENT(in) :: alb_dir(KLON, NSW), alb_dif(KLON, NSW)
-    REAL, INTENT(in) :: SFRWL(6)
+    ! REAL,    INTENT(IN)  :: alb1(KLON), alb2(KLON), tsol(KLON)
+    REAL, INTENT(IN) :: tsol(KLON)
+    REAL, INTENT(IN) :: alb_dir(KLON, NSW), alb_dif(KLON, NSW)
+    REAL, INTENT(IN) :: SFRWL(6)
     !albedo SB <<<
-    REAL, INTENT(in) :: t(KLON, KLEV), q(KLON, KLEV)
-
-    REAL, INTENT(in) :: wo(:, :, :) ! dimension(KLON,KLEV, 1 or 2)
+    REAL, INTENT(IN) :: t(KLON, KLEV), q(KLON, KLEV)
+
+    REAL, INTENT(IN) :: wo(:, :, :) ! DIMENSION(KLON,KLEV, 1 or 2)
     ! column-density of ozone in a layer, in kilo-Dobsons
     ! "wo(:, :, 1)" is for the average day-night field, 
     ! "wo(:, :, 2)" is for daylight time.
 
-    LOGICAL, INTENT(in) :: ok_ade, ok_aie                                 ! switches whether to use aerosol direct (indirect) effects or not
-    LOGICAL, INTENT(in) :: ok_volcan                                      ! produce volcanic diags (SW/LW heat flux and rate)
-    INTEGER, INTENT(in) :: flag_volc_surfstrat                            ! allow to impose volcanic cooling rate at surf or heating in strato
+    LOGICAL, INTENT(IN) :: ok_ade, ok_aie                                 ! switches whether to use aerosol direct (indirect) effects or not
+    LOGICAL, INTENT(IN) :: ok_volcan                                      ! produce volcanic diags (SW/LW heat flux and rate)
+    INTEGER, INTENT(IN) :: flag_volc_surfstrat                            ! allow to impose volcanic cooling rate at surf or heating in strato
     LOGICAL :: lldebug = .FALSE.
-    INTEGER, INTENT(in) :: flag_aerosol                                   ! takes value 0 (no aerosol) or 1 to 6 (aerosols)
-    INTEGER, INTENT(in) :: flag_aerosol_strat                             ! use stratospheric aerosols
-    LOGICAL, INTENT(in) :: flag_aer_feedback                              ! activate aerosol radiative feedback
-    REAL, INTENT(in) :: cldfra(KLON, KLEV), cldemi(KLON, KLEV), cldtaupd(KLON, KLEV)
-    REAL, INTENT(in) :: tau_aero(KLON, KLEV, naero_grp, 2)                        ! aerosol optical properties (see aeropt.F)
-    REAL, INTENT(in) :: piz_aero(KLON, KLEV, naero_grp, 2)                        ! aerosol optical properties (see aeropt.F)
-    REAL, INTENT(in) :: cg_aero(KLON, KLEV, naero_grp, 2)                         ! aerosol optical properties (see aeropt.F)
+    INTEGER, INTENT(IN) :: flag_aerosol                                   ! takes value 0 (no aerosol) or 1 to 6 (aerosols)
+    INTEGER, INTENT(IN) :: flag_aerosol_strat                             ! use stratospheric aerosols
+    LOGICAL, INTENT(IN) :: flag_aer_feedback                              ! activate aerosol radiative feedback
+    REAL, INTENT(IN) :: cldfra(KLON, KLEV), cldemi(KLON, KLEV), cldtaupd(KLON, KLEV)
+    REAL, INTENT(IN) :: tau_aero(KLON, KLEV, naero_grp, 2)                        ! aerosol optical properties (see aeropt.F)
+    REAL, INTENT(IN) :: piz_aero(KLON, KLEV, naero_grp, 2)                        ! aerosol optical properties (see aeropt.F)
+    REAL, INTENT(IN) :: cg_aero(KLON, KLEV, naero_grp, 2)                         ! aerosol optical properties (see aeropt.F)
     !--OB
-    REAL, INTENT(in) :: tau_aero_sw_rrtm(KLON, KLEV, 2, NSW)                 ! aerosol optical properties RRTM
-    REAL, INTENT(in) :: piz_aero_sw_rrtm(KLON, KLEV, 2, NSW)                 ! aerosol optical properties RRTM
-    REAL, INTENT(in) :: cg_aero_sw_rrtm(KLON, KLEV, 2, NSW)                  ! aerosol optical properties RRTM
+    REAL, INTENT(IN) :: tau_aero_sw_rrtm(KLON, KLEV, 2, NSW)                 ! aerosol optical properties RRTM
+    REAL, INTENT(IN) :: piz_aero_sw_rrtm(KLON, KLEV, 2, NSW)                 ! aerosol optical properties RRTM
+    REAL, INTENT(IN) :: cg_aero_sw_rrtm(KLON, KLEV, 2, NSW)                  ! aerosol optical properties RRTM
     ! AI
     !--OB fin
@@ -231,51 +231,51 @@
     !--C. Kleinschmitt
 #ifdef CPP_RRTM
-    REAL,    INTENT(in)  :: tau_aero_lw_rrtm(KLON,KLEV,2,NLW)                 ! LW aerosol optical properties RRTM
+    REAL,    INTENT(IN)  :: tau_aero_lw_rrtm(KLON,KLEV,2,NLW)                 ! LW aerosol optical properties RRTM
 #else
-    REAL, INTENT(in) :: tau_aero_lw_rrtm(KLON, KLEV, 2, nbands_lw_rrtm)
+    REAL, INTENT(IN) :: tau_aero_lw_rrtm(KLON, KLEV, 2, nbands_lw_rrtm)
 #endif
     !--C. Kleinschmitt end
 
-    REAL, INTENT(in) :: cldtaupi(KLON, KLEV)                            ! cloud optical thickness for pre-industrial aerosol concentrations
-    REAL, INTENT(in) :: qsat(klon, klev) ! Variable pour iflag_rrtm=1
-    REAL, INTENT(in) :: flwc(klon, klev) ! Variable pour iflag_rrtm=1
-    REAL, INTENT(in) :: fiwc(klon, klev) ! Variable pour iflag_rrtm=1
-    REAL, INTENT(in) :: ref_liq(klon, klev) ! cloud droplet radius present-day from newmicro
-    REAL, INTENT(in) :: ref_ice(klon, klev) ! ice crystal radius   present-day from newmicro
-    REAL, INTENT(in) :: ref_liq_pi(klon, klev) ! cloud droplet radius pre-industrial from newmicro
-    REAL, INTENT(in) :: ref_ice_pi(klon, klev) ! ice crystal radius   pre-industrial from newmicro
-    REAL, INTENT(in) :: m_allaer(klon, klev, naero_tot) ! mass aero
-
-    CHARACTER(len = 512), INTENT(in) :: namelist_ecrad_file
-    LOGICAL, INTENT(in) :: debut
+    REAL, INTENT(IN) :: cldtaupi(KLON, KLEV)                            ! cloud optical thickness for pre-industrial aerosol concentrations
+    REAL, INTENT(IN) :: qsat(klon, klev) ! Variable pour iflag_rrtm=1
+    REAL, INTENT(IN) :: flwc(klon, klev) ! Variable pour iflag_rrtm=1
+    REAL, INTENT(IN) :: fiwc(klon, klev) ! Variable pour iflag_rrtm=1
+    REAL, INTENT(IN) :: ref_liq(klon, klev) ! cloud droplet radius present-day from newmicro
+    REAL, INTENT(IN) :: ref_ice(klon, klev) ! ice crystal radius   present-day from newmicro
+    REAL, INTENT(IN) :: ref_liq_pi(klon, klev) ! cloud droplet radius pre-industrial from newmicro
+    REAL, INTENT(IN) :: ref_ice_pi(klon, klev) ! ice crystal radius   pre-industrial from newmicro
+    REAL, INTENT(IN) :: m_allaer(klon, klev, naero_tot) ! mass aero
+
+    CHARACTER(len = 512), INTENT(IN) :: namelist_ecrad_file
+    LOGICAL, INTENT(IN) :: debut
 
     ! Output arguments
-    REAL, INTENT(out) :: heat(KLON, KLEV), cool(KLON, KLEV)
-    REAL, INTENT(out) :: heat0(KLON, KLEV), cool0(KLON, KLEV)
-    REAL, INTENT(out) :: heat_volc(KLON, KLEV), cool_volc(KLON, KLEV) !NL
-    REAL, INTENT(out) :: topsw(KLON), toplw(KLON)
-    REAL, INTENT(out) :: solsw(KLON), sollw(KLON), albpla(KLON), solswfdiff(KLON)
-    REAL, INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON)
-    REAL, INTENT(out) :: sollwdown(KLON)
-    REAL, INTENT(out) :: swdn(KLON, kflev + 1), swdn0(KLON, kflev + 1), swdnc0(KLON, kflev + 1)
-    REAL, INTENT(out) :: swup(KLON, kflev + 1), swup0(KLON, kflev + 1), swupc0(KLON, kflev + 1)
-    REAL, INTENT(out) :: lwdn(KLON, kflev + 1), lwdn0(KLON, kflev + 1), lwdnc0(KLON, kflev + 1)
-    REAL, INTENT(out) :: lwup(KLON, kflev + 1), lwup0(KLON, kflev + 1), lwupc0(KLON, kflev + 1)
-    REAL, INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON)         ! output: aerosol direct forcing at TOA and surface
-    REAL, INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON)         ! output: aerosol indirect forcing atTOA and surface
-    REAL, INTENT(out) :: toplwad_aero(KLON), sollwad_aero(KLON)         ! output: LW aerosol direct forcing at TOA and surface
-    REAL, INTENT(out) :: toplwai_aero(KLON), sollwai_aero(KLON)         ! output: LW aerosol indirect forcing atTOA and surface
-    REAL, DIMENSION(klon), INTENT(out) :: topswad0_aero
-    REAL, DIMENSION(klon), INTENT(out) :: solswad0_aero
-    REAL, DIMENSION(klon), INTENT(out) :: toplwad0_aero
-    REAL, DIMENSION(klon), INTENT(out) :: sollwad0_aero
-    REAL, DIMENSION(kdlon, 9), INTENT(out) :: topsw_aero
-    REAL, DIMENSION(kdlon, 9), INTENT(out) :: topsw0_aero
-    REAL, DIMENSION(kdlon, 9), INTENT(out) :: solsw_aero
-    REAL, DIMENSION(kdlon, 9), INTENT(out) :: solsw0_aero
-    REAL, DIMENSION(kdlon, 3), INTENT(out) :: topswcf_aero
-    REAL, DIMENSION(kdlon, 3), INTENT(out) :: solswcf_aero
-    REAL, DIMENSION(kdlon, kflev + 1), INTENT(out) :: ZSWFT0_i
-    REAL, DIMENSION(kdlon, kflev + 1), INTENT(out) :: ZLWFT0_i
+    REAL, INTENT(OUT) :: heat(KLON, KLEV), cool(KLON, KLEV)
+    REAL, INTENT(OUT) :: heat0(KLON, KLEV), cool0(KLON, KLEV)
+    REAL, INTENT(OUT) :: heat_volc(KLON, KLEV), cool_volc(KLON, KLEV) !NL
+    REAL, INTENT(OUT) :: topsw(KLON), toplw(KLON)
+    REAL, INTENT(OUT) :: solsw(KLON), sollw(KLON), albpla(KLON), solswfdiff(KLON)
+    REAL, INTENT(OUT) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON)
+    REAL, INTENT(OUT) :: sollwdown(KLON)
+    REAL, INTENT(OUT) :: swdn(KLON, kflev + 1), swdn0(KLON, kflev + 1), swdnc0(KLON, kflev + 1)
+    REAL, INTENT(OUT) :: swup(KLON, kflev + 1), swup0(KLON, kflev + 1), swupc0(KLON, kflev + 1)
+    REAL, INTENT(OUT) :: lwdn(KLON, kflev + 1), lwdn0(KLON, kflev + 1), lwdnc0(KLON, kflev + 1)
+    REAL, INTENT(OUT) :: lwup(KLON, kflev + 1), lwup0(KLON, kflev + 1), lwupc0(KLON, kflev + 1)
+    REAL, INTENT(OUT) :: topswad_aero(KLON), solswad_aero(KLON)         ! output: aerosol direct forcing at TOA and surface
+    REAL, INTENT(OUT) :: topswai_aero(KLON), solswai_aero(KLON)         ! output: aerosol indirect forcing atTOA and surface
+    REAL, INTENT(OUT) :: toplwad_aero(KLON), sollwad_aero(KLON)         ! output: LW aerosol direct forcing at TOA and surface
+    REAL, INTENT(OUT) :: toplwai_aero(KLON), sollwai_aero(KLON)         ! output: LW aerosol indirect forcing atTOA and surface
+    REAL, DIMENSION(klon), INTENT(OUT) :: topswad0_aero
+    REAL, DIMENSION(klon), INTENT(OUT) :: solswad0_aero
+    REAL, DIMENSION(klon), INTENT(OUT) :: toplwad0_aero
+    REAL, DIMENSION(klon), INTENT(OUT) :: sollwad0_aero
+    REAL, DIMENSION(kdlon, 9), INTENT(OUT) :: topsw_aero
+    REAL, DIMENSION(kdlon, 9), INTENT(OUT) :: topsw0_aero
+    REAL, DIMENSION(kdlon, 9), INTENT(OUT) :: solsw_aero
+    REAL, DIMENSION(kdlon, 9), INTENT(OUT) :: solsw0_aero
+    REAL, DIMENSION(kdlon, 3), INTENT(OUT) :: topswcf_aero
+    REAL, DIMENSION(kdlon, 3), INTENT(OUT) :: solswcf_aero
+    REAL, DIMENSION(kdlon, kflev + 1), INTENT(OUT) :: ZSWFT0_i
+    REAL, DIMENSION(kdlon, kflev + 1), INTENT(OUT) :: ZLWFT0_i
 
     ! Local variables
@@ -403,5 +403,5 @@
     REAL(KIND = 8) zsolsw_aero(kdlon, 9), zsolsw0_aero(kdlon, 9)
     REAL(KIND = 8) ztopswcf_aero(kdlon, 3), zsolswcf_aero(kdlon, 3)
-    ! real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2 deje declare dans physiq.F MPL 20130618
+    ! REAL, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2 deje declare dans physiq.F MPL 20130618
     !MPL input supplementaires pour RECMWFL
     ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)
@@ -1316,5 +1316,5 @@
 !!! - Gas en VMR pour offline et MMR pour online
 !!! - on utilise pour solarirrad une valeur constante
-          if (lldebug_for_offline) THEN
+          IF (lldebug_for_offline) THEN
              SOLARIRAD = 1366.0896
              ZCH4_off = CH4_ppb*1e-9
@@ -1354,5 +1354,5 @@
           ! lldebug_for_offline
 
-          if (namelist_ecrad_file.eq.'namelist_ecrad') THEN
+          IF (namelist_ecrad_file.EQ.'namelist_ecrad') THEN
              PRINT*,' 1er apell Ecrad : ok_3Deffect, namelist_ecrad_file = ', &
                   ok_3Deffect, namelist_ecrad_file    
@@ -1447,5 +1447,5 @@
           print *,'========= RADLWSW: apres RADIATION_SCHEME ==================== '
 
-          if (lldebug_for_offline) THEN
+          IF (lldebug_for_offline) THEN
              CALL writefield_phy('FLUX_LW',ZLWFT_i,klev+1)
              CALL writefield_phy('FLUX_LW_CLEAR',ZLWFT0_ii,klev+1)
@@ -1531,5 +1531,5 @@
              zdir=SUM(PSFSWDIR(i,:))
              zdif=SUM(PSFSWDIF(i,:))
-             IF (fract(i).GT.0.0.and.(zdir+zdif).gt.seuilmach) THEN
+             IF (fract(i).GT.0.0.AND.(zdir+zdif).gt.seuilmach) THEN
                 zsolswfdiff(i) = zdif/(zdir+zdif)
              ELSE  !--night
@@ -1673,5 +1673,5 @@
 
     IF (lldebug) THEN
-      if (0==1) THEN
+      IF (0==1) THEN
         ! Verifs dans le cas 1D
         PRINT*, '================== Sortie de radlw ================='
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ran0_vec.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ran0_vec.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ran0_vec.F90	(revision 5117)
@@ -17,9 +17,9 @@
 
   ! do j=1,npoints
-  ! if (idum(j).eq.0) THEN
+  ! if (idum(j).EQ.0) THEN
   ! WRITE(6,*) 'idum=',idum
   ! WRITE(6,*) 'ZERO seed not allowed'
   ! stop
-  ! endif
+  ! END IF
   ! enddo
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosol_interp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosol_interp.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosol_interp.F90	(revision 5117)
@@ -20,5 +20,5 @@
   USE lmdz_write_field_phy
   USE phys_cal_mod
-  USE pres2lev_mod
+  USE lmdz_pres2lev
   USE lmdz_print_control, ONLY: lunout
   USE lmdz_abort_physic, ONLY: abort_physic
@@ -280,5 +280,5 @@
     month_mid(:) = month_start (:) + month_len(:) / 2.
 
-    if (debug) THEN
+    IF (debug) THEN
       WRITE(lunout, *)' month_len = ', month_len
       WRITE(lunout, *)' month_mid = ', month_mid
@@ -335,5 +335,5 @@
       CALL abort_physic('readaerosol_interp', 'number of months undefined', 1)
     ENDIF
-    if (debug) THEN
+    IF (debug) THEN
       WRITE(lunout, *)' jDay, day1, day2, im, im2 = ', jDay, day1, day2, im, im2
     endif
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosol_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosol_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosol_mod.F90	(revision 5117)
@@ -440,5 +440,5 @@
         !**************************************************************************************************
         ierr = nf90_inq_dimid(ncid, 'TIME', dimid)
-        if (ierr /= nf90_noerr) THEN
+        IF (ierr /= nf90_noerr) THEN
           ierr = nf90_inq_dimid(ncid, 'time_counter', dimid)
         ENDIF
@@ -683,5 +683,5 @@
         CALL xios_send_field("load_" // TRIM(varname) // "_in", load_glo2D)
         CALL xios_recv_field("load_" // TRIM(varname) // "_out", load_out_mpi)
-        IF (.not. allocated(psurf_interp)) THEN
+        IF (.NOT. allocated(psurf_interp)) THEN
           ! psurf_interp is a shared array
           ALLOCATE(psurf_interp(klon_mpi, 12))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosolstrato.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosolstrato.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosolstrato.F90	(revision 5117)
@@ -1,7 +1,7 @@
 SUBROUTINE readaerosolstrato(debut)
 
-  use netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, &
+  USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, &
           nf95_inq_varid, nf95_open
-  use netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
+  USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
 
   USE phys_cal_mod, ONLY: mth_cur
@@ -23,40 +23,40 @@
 
   ! Variable input
-  logical debut
+  LOGICAL debut
 
   ! Variables locales
-  integer n_lat   ! number of latitudes in the input data
-  integer n_lon   ! number of longitudes in the input data
-  integer n_lev   ! number of levels in the input data
-  integer n_month ! number of months in the input data
-  real, allocatable :: latitude(:)
-  real, allocatable :: longitude(:)
-  real, allocatable :: time(:)
-  real, allocatable :: lev(:)
-  integer i, k, band, wave
-  integer, save :: mth_pre = 1
+  INTEGER n_lat   ! number of latitudes in the input data
+  INTEGER n_lon   ! number of longitudes in the input data
+  INTEGER n_lev   ! number of levels in the input data
+  INTEGER n_month ! number of months in the input data
+  REAL, ALLOCATABLE :: latitude(:)
+  REAL, ALLOCATABLE :: longitude(:)
+  REAL, ALLOCATABLE :: time(:)
+  REAL, ALLOCATABLE :: lev(:)
+  INTEGER i, k, band, wave
+  INTEGER, save :: mth_pre = 1
   !$OMP THREADPRIVATE(mth_pre)
 
-  real, allocatable, dimension(:, :), save :: tau_aer_strat
+  REAL, ALLOCATABLE, DIMENSION(:, :), save :: tau_aer_strat
   !$OMP THREADPRIVATE(tau_aer_strat)
 
   ! Champs reconstitues
-  real, allocatable :: tauaerstrat(:, :, :, :)
-  real, allocatable :: tauaerstrat_mois(:, :, :)
-  real, allocatable :: tauaerstrat_mois_glo(:, :)
-  real, allocatable :: tau_aer_strat_mpi(:, :)
+  REAL, ALLOCATABLE :: tauaerstrat(:, :, :, :)
+  REAL, ALLOCATABLE :: tauaerstrat_mois(:, :, :)
+  REAL, ALLOCATABLE :: tauaerstrat_mois_glo(:, :)
+  REAL, ALLOCATABLE :: tau_aer_strat_mpi(:, :)
 
   ! For NetCDF:
-  integer ncid_in  ! IDs for input files
-  integer varid, ncerr
+  INTEGER ncid_in  ! IDs for input files
+  INTEGER varid, ncerr
 
   ! Stratospheric aerosols optical properties
   ! alpha_strat over the 2 bands is normalised by the 550 nm extinction coefficient
   ! alpha_strat_wave is *not* normalised by the 550 nm extinction coefficient
-  real, dimension(nbands) :: alpha_strat, piz_strat, cg_strat
+  REAL, DIMENSION(nbands) :: alpha_strat, piz_strat, cg_strat
   data alpha_strat/0.9922547, 0.7114912 /
   data piz_strat  /0.9999998, 0.99762493/
   data cg_strat   /0.73107845, 0.73229635/
-  real, dimension(nwave_sw) :: alpha_strat_wave
+  REAL, DIMENSION(nwave_sw) :: alpha_strat_wave
   data alpha_strat_wave/3.36780953, 3.34667683, 3.20444202, 3.0293026, 2.82108808/
 
@@ -66,5 +66,5 @@
   !--------------------------------------------------------
 
-  IF (.not.ALLOCATED(tau_aer_strat)) ALLOCATE(tau_aer_strat(klon, klev))
+  IF (.NOT.ALLOCATED(tau_aer_strat)) ALLOCATE(tau_aer_strat(klon, klev))
 
   !--only read file if beginning of run or start of new month
@@ -120,7 +120,7 @@
       ENDIF
 
-      IF (.not.ALLOCATED(tauaerstrat))          ALLOCATE(tauaerstrat(n_lon, n_lat, n_lev, n_month))
-      IF (.not.ALLOCATED(tauaerstrat_mois))     ALLOCATE(tauaerstrat_mois(n_lon, n_lat, n_lev))
-      IF (.not.ALLOCATED(tauaerstrat_mois_glo)) ALLOCATE(tauaerstrat_mois_glo(klon_glo, n_lev))
+      IF (.NOT.ALLOCATED(tauaerstrat))          ALLOCATE(tauaerstrat(n_lon, n_lat, n_lev, n_month))
+      IF (.NOT.ALLOCATED(tauaerstrat_mois))     ALLOCATE(tauaerstrat_mois(n_lon, n_lat, n_lev))
+      IF (.NOT.ALLOCATED(tauaerstrat_mois_glo)) ALLOCATE(tauaerstrat_mois_glo(klon_glo, n_lev))
 
       !--reading stratospheric AOD at 550 nm
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosolstrato_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosolstrato_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosolstrato_m.F90	(revision 5117)
@@ -31,6 +31,6 @@
 !  USE YOERAD, ONLY: NLW
   IMPLICIT NONE
-  REAL, allocatable:: latitude(:)
-  REAL, allocatable:: longitude(:)
+  REAL, ALLOCATABLE:: latitude(:)
+  REAL, ALLOCATABLE:: longitude(:)
   INTEGER :: nlat, nlon
   REAL    :: null_array(0)
@@ -74,6 +74,6 @@
 !  USE YOERAD, ONLY: NLW
   IMPLICIT NONE
-  REAL, allocatable:: latitude(:)
-  REAL, allocatable:: wav(:)
+  REAL, ALLOCATABLE:: latitude(:)
+  REAL, ALLOCATABLE:: wav(:)
   INTEGER :: nlat,n_wav
   REAL    :: null_array(0)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/readchlorophyll.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/readchlorophyll.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/readchlorophyll.F90	(revision 5117)
@@ -80,7 +80,7 @@
       ENDIF
 
-      IF (.not.ALLOCATED(chlorocon))          ALLOCATE(chlorocon(n_lon, n_lat, n_month))
-      IF (.not.ALLOCATED(chlorocon_mois))     ALLOCATE(chlorocon_mois(n_lon, n_lat))
-      IF (.not.ALLOCATED(chlorocon_mois_glo)) ALLOCATE(chlorocon_mois_glo(klon_glo))
+      IF (.NOT.ALLOCATED(chlorocon))          ALLOCATE(chlorocon(n_lon, n_lat, n_month))
+      IF (.NOT.ALLOCATED(chlorocon_mois))     ALLOCATE(chlorocon_mois(n_lon, n_lat))
+      IF (.NOT.ALLOCATED(chlorocon_mois_glo)) ALLOCATE(chlorocon_mois_glo(klon_glo))
 
       !--reading stratospheric AOD at 550 nm
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/reevap.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/reevap.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/reevap.F90	(revision 5117)
@@ -9,6 +9,6 @@
 
     INTEGER klon,klev,iflag_ice_thermo
-    REAL, DIMENSION(klon,klev), INTENT(in) :: t_seri,q_seri,ql_seri,qs_seri
-    REAL, DIMENSION(klon,klev), INTENT(out) :: d_t_eva,d_q_eva,d_ql_eva,d_qs_eva
+    REAL, DIMENSION(klon,klev), INTENT(IN) :: t_seri,q_seri,ql_seri,qs_seri
+    REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_eva,d_q_eva,d_ql_eva,d_qs_eva
 
     REAL za,zb,zdelta,zlvdcp,zlsdcp
@@ -27,5 +27,5 @@
     DO k = 1, klev  ! re-evaporation de l'eau liquide nuageuse
        DO i = 1, klon
-        if (fl_cor_ebil > 0) THEN
+        IF (fl_cor_ebil > 0) THEN
           zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
           zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/regr_horiz_time_climoz_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/regr_horiz_time_climoz_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/regr_horiz_time_climoz_m.F90	(revision 5117)
@@ -1,7 +1,7 @@
 MODULE regr_horiz_time_climoz_m
 
-  use lmdz_interpolation, ONLY: locate
+  USE lmdz_interpolation, ONLY: locate
   USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, grid_type, unstructured
-  USE nrtype, ONLY: pi
+  USE lmdz_physical_constants, ONLY: pi
   USE netcdf, ONLY: nf90_clobber, nf90_float, nf90_open, &
           nf90_nowrite, nf90_noerr, nf90_get_att, nf90_global
@@ -62,8 +62,8 @@
     USE time_phylmdz_mod, ONLY: annee_ref
     USE ioipsl, ONLY: ioget_year_len, ioget_calendar
-    USE regr_conserv_m, ONLY: regr_conserv
-    USE regr_lint_m, ONLY: regr_lint
+    USE lmdz_regr_conserv, ONLY: regr_conserv
+    USE lmdz_regr_lint, ONLY: regr_lint
     USE lmdz_regular_lonlat, ONLY: boundslon_reg, boundslat_reg, south, west, east
-    USE slopes_m, ONLY: slopes
+    USE lmdz_slopes, ONLY: slopes
     USE lmdz_xios
     USE lmdz_phys_para, ONLY: is_mpi_root, is_master, is_omp_master, gather, gather_mpi, bcast_mpi, klon_mpi
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/regr_lat_time_coefoz_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/regr_lat_time_coefoz_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/regr_lat_time_coefoz_m.F90	(revision 5117)
@@ -33,5 +33,5 @@
     ! -- the latitude is in degrees and strictly monotonic (as all
     ! NetCDF coordinate variables should be);
-    ! -- time increases from January to December (even though we do
+    ! -- time increases from January to December (even though we DO
     ! not use values of the input time coordinate);
     ! -- pressure is in hPa and in strictly ascending order (even
@@ -40,35 +40,35 @@
     ! when we regrid in pressure).
 
-    use lmdz_grid_phy, ONLY: nbp_lat
-    use regr_conserv_m, ONLY: regr_conserv
-    use regr_lint_m, ONLY: regr_lint
-    use netcdf95, ONLY: nf95_open, nf95_close, nf95_inq_varid, nf95_get_var, &
+    USE lmdz_grid_phy, ONLY: nbp_lat
+    USE lmdz_regr_conserv, ONLY: regr_conserv
+    USE lmdz_regr_lint, ONLY: regr_lint
+    USE netcdf95, ONLY: nf95_open, nf95_close, nf95_inq_varid, nf95_get_var, &
          nf95_put_var, nf95_gw_var
-    use netcdf, ONLY: nf90_nowrite
-    use nrtype, ONLY: pi
-    use lmdz_regular_lonlat, ONLY: boundslat_reg, south
+    USE netcdf, ONLY: nf90_nowrite
+    USE lmdz_physical_constants, ONLY: pi
+    USE lmdz_regular_lonlat, ONLY: boundslat_reg, south
 
     ! Variables local to the procedure:
 
-    integer ncid_in, ncid_out ! NetCDF IDs for input and output files
-    integer n_plev ! number of pressure levels in the input data
-    integer n_lat! number of latitudes in the input data
-
-    real, allocatable:: latitude(:)
+    INTEGER ncid_in, ncid_out ! NetCDF IDs for input and output files
+    INTEGER n_plev ! number of pressure levels in the input data
+    INTEGER n_lat! number of latitudes in the input data
+
+    REAL, ALLOCATABLE:: latitude(:)
     ! (of input data, converted to rad, sorted in strictly ascending order)
 
-    real, allocatable:: lat_in_edg(:)
+    REAL, ALLOCATABLE:: lat_in_edg(:)
     ! (edges of latitude intervals for input data, in rad, in strictly
     ! ascending order)
 
-    real, allocatable:: plev(:) ! pressure level of input data
-    logical desc_lat ! latitude in descending order in the input file
-
-    real, allocatable:: o3_par_in(:, :, :) ! (n_lat, n_plev, 12)
+    REAL, ALLOCATABLE:: plev(:) ! pressure level of input data
+    LOGICAL desc_lat ! latitude in descending order in the input file
+
+    REAL, ALLOCATABLE:: o3_par_in(:, :, :) ! (n_lat, n_plev, 12)
     ! (ozone parameter from the input file)
     ! ("o3_par_in(j, l, month)" is at latitude "latitude(j)" and pressure
     ! level "plev(l)". "month" is between 1 and 12.)
 
-    real, allocatable:: v_regr_lat(:, :, :) ! (jjm + 1, n_plev, 0:13)
+    REAL, ALLOCATABLE:: v_regr_lat(:, :, :) ! (jjm + 1, n_plev, 0:13)
     ! (mean of a variable "v" over a latitude interval)
     ! (First dimension is latitude interval.
@@ -84,5 +84,5 @@
     ! Last dimension is month number.)
 
-    real, allocatable:: o3_par_out(:, :, :) ! (jjm + 1, n_plev, ndays)
+    REAL, ALLOCATABLE:: o3_par_out(:, :, :) ! (jjm + 1, n_plev, ndays)
     ! (regridded ozone parameter)
     ! ("o3_par_out(j, l, day)" is at latitude "rlatu(j)", pressure
@@ -90,7 +90,7 @@
     ! 360-day calendar.)
 
-    integer j
-    integer i_v ! index of ozone parameter
-    integer, parameter:: n_o3_param = 8 ! number of ozone parameters
+    INTEGER j
+    INTEGER i_v ! index of ozone parameter
+    INTEGER, parameter:: n_o3_param = 8 ! number of ozone parameters
 
     CHARACTER(LEN=11) name_in(n_o3_param)
@@ -100,9 +100,9 @@
     ! (name of NetCDF primary variable in the output file)
 
-    integer varid_in(n_o3_param), varid_out(n_o3_param), varid_plev, varid_time
-    integer ncerr, varid
+    INTEGER varid_in(n_o3_param), varid_out(n_o3_param), varid_plev, varid_time
+    INTEGER ncerr, varid
     ! (for NetCDF)
 
-    real, parameter:: tmidmonth(0:13) = (/(-15. + 30. * j, j = 0, 13)/)
+    REAL, parameter:: tmidmonth(0:13) = (/(-15. + 30. * j, j = 0, 13)/)
     ! (time to middle of month, in days since January 1st 0h, in a
     ! 360-day calendar)
@@ -110,5 +110,5 @@
     ! interpolated between the December and the January value.)
 
-    real, parameter:: tmidday(360) = (/(j + 0.5, j = 0, 359)/)
+    REAL, parameter:: tmidday(360) = (/(j + 0.5, j = 0, 359)/)
     ! (time to middle of day, in days since January 1st 0h, in a
     ! 360-day calendar)
@@ -165,5 +165,5 @@
     ! ascending order, so invert order if necessary:
     desc_lat = latitude(1) > latitude(n_lat)
-    if (desc_lat) latitude = latitude(n_lat:1:-1)
+    IF (desc_lat) latitude = latitude(n_lat:1:-1)
 
     ! Compute edges of latitude intervals:
@@ -202,5 +202,5 @@
 
        CALL nf95_get_var(ncid_in, varid_in(i_v), o3_par_in)
-       if (desc_lat) o3_par_in = o3_par_in(n_lat:1:-1, :, :)
+       IF (desc_lat) o3_par_in = o3_par_in(n_lat:1:-1, :, :)
 
        ! Regrid in latitude:
@@ -240,23 +240,23 @@
     ! dimensions and variables, and writes one of the coordinate variables.
 
-    use lmdz_grid_phy, ONLY: nbp_lat
-    use lmdz_assert_eq, ONLY: assert_eq
-
-    use netcdf95, ONLY: nf95_create, nf95_def_dim, nf95_def_var, &
+    USE lmdz_grid_phy, ONLY: nbp_lat
+    USE lmdz_assert_eq, ONLY: assert_eq
+
+    USE netcdf95, ONLY: nf95_create, nf95_def_dim, nf95_def_var, &
          nf95_put_att, nf95_enddef, nf95_copy_att, nf95_put_var
-    use netcdf, ONLY: nf90_clobber, nf90_float, nf90_copy_att, nf90_global
-    use nrtype, ONLY: pi
-    use lmdz_regular_lonlat, ONLY: lat_reg
-
-    integer, intent(in):: ncid_in, varid_in(:), n_plev
-    CHARACTER(LEN=*), intent(in):: name_out(:) ! of NetCDF variables
-    integer, intent(out):: ncid_out, varid_out(:), varid_plev, varid_time
+    USE netcdf, ONLY: nf90_clobber, nf90_float, nf90_copy_att, nf90_global
+    USE lmdz_physical_constants, ONLY: pi
+    USE lmdz_regular_lonlat, ONLY: lat_reg
+
+    INTEGER, INTENT(IN):: ncid_in, varid_in(:), n_plev
+    CHARACTER(LEN=*), INTENT(IN):: name_out(:) ! of NetCDF variables
+    INTEGER, INTENT(OUT):: ncid_out, varid_out(:), varid_plev, varid_time
 
     ! Variables local to the procedure:
 
-    integer ncerr
-    integer dimid_rlatu, dimid_plev, dimid_time
-    integer varid_rlatu
-    integer i, n_o3_param
+    INTEGER ncerr
+    INTEGER dimid_rlatu, dimid_plev, dimid_time
+    INTEGER varid_rlatu
+    INTEGER i, n_o3_param
 
     !---------------------------
@@ -328,11 +328,11 @@
     SUBROUTINE handle_err_copy_att(att_name)
 
-      use netcdf, ONLY: nf90_noerr, nf90_strerror
-
-      CHARACTER(LEN=*), intent(in):: att_name
+      USE netcdf, ONLY: nf90_noerr, nf90_strerror
+
+      CHARACTER(LEN=*), INTENT(IN):: att_name
 
       !----------------------------------------
 
-      if (ncerr /= nf90_noerr) THEN
+      IF (ncerr /= nf90_noerr) THEN
          print *, "prepare_out " // trim(name_out(i)) &
               // " nf90_copy_att " // att_name // " -- " &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_comb_coefoz_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_comb_coefoz_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_comb_coefoz_m.F90	(revision 5117)
@@ -9,21 +9,21 @@
   ! "rlon(i)", latitude "rlat(i)" and middle of layer "k".
 
-  real, allocatable, save:: c_Mob(:, :)
+  REAL, ALLOCATABLE, save:: c_Mob(:, :)
   ! (sum of Mobidic terms in the net mass production rate of ozone
   ! by chemistry, per unit mass of air, in s-1)
 
-  real, allocatable, save:: a2(:, :)
+  REAL, ALLOCATABLE, save:: a2(:, :)
   ! (derivative of mass production rate of ozone per unit mass of
   ! air with respect to ozone mass fraction, in s-1)
 
-  real, allocatable, save:: a4_mass(:, :)
+  REAL, ALLOCATABLE, save:: a4_mass(:, :)
   ! (derivative of mass production rate of ozone per unit mass of
   ! air with respect to temperature, in s-1 K-1)
 
-  real, allocatable, save:: a6_mass(:, :)
+  REAL, ALLOCATABLE, save:: a6_mass(:, :)
   ! (derivative of mass production rate of ozone per unit mass of
   ! air with respect to mass column-density of ozone above, in m2 s-1 kg-1)
 
-  real, allocatable, save:: r_het_interm(:, :)
+  REAL, ALLOCATABLE, save:: r_het_interm(:, :)
   ! (net mass production rate by heterogeneous chemistry, per unit
   ! mass of ozone, corrected for chlorine content and latitude, but
@@ -39,6 +39,6 @@
     ! It allocates module variables.
 
-    use dimphy, ONLY: klon
-    use lmdz_grid_phy, ONLY: nbp_lev
+    USE dimphy, ONLY: klon
+    USE lmdz_grid_phy, ONLY: nbp_lev
 
     ! Variables local to the procedure:
@@ -71,30 +71,30 @@
     !    coefficients are combined to define the five module variables.
 
-    use netcdf95, ONLY: nf95_open, nf95_close
-    use netcdf, ONLY: nf90_nowrite
-    use lmdz_assert, ONLY: assert
-    use dimphy, ONLY: klon
-    use lmdz_phys_mpi_data, ONLY: is_mpi_root
-    use regr_pr_time_av_m, ONLY: regr_pr_time_av
-    use regr_pr_int_m, ONLY: regr_pr_int
-    use press_coefoz_m, ONLY: press_in_edg, plev
-    use lmdz_grid_phy, ONLY: nbp_lev
+    USE netcdf95, ONLY: nf95_open, nf95_close
+    USE netcdf, ONLY: nf90_nowrite
+    USE lmdz_assert, ONLY: assert
+    USE dimphy, ONLY: klon
+    USE lmdz_phys_mpi_data, ONLY: is_mpi_root
+    USE regr_pr_time_av_m, ONLY: regr_pr_time_av
+    USE regr_pr_int_m, ONLY: regr_pr_int
+    USE press_coefoz_m, ONLY: press_in_edg, plev
+    USE lmdz_grid_phy, ONLY: nbp_lev
 
-    integer, intent(in):: julien ! jour julien, 1 <= julien <= 360
+    INTEGER, INTENT(IN):: julien ! jour julien, 1 <= julien <= 360
 
-    REAL, intent(in):: rlat(:)
+    REAL, INTENT(IN):: rlat(:)
     ! (latitude on the partial "physics" grid, in degrees)
 
-    real, intent(in):: paprs(:, :) ! (klon, nbp_lev + 1)
+    REAL, INTENT(IN):: paprs(:, :) ! (klon, nbp_lev + 1)
     ! (pression pour chaque inter-couche, en Pa)
 
-    real, intent(in):: pplay(:, :) ! (klon, nbp_lev)
+    REAL, INTENT(IN):: pplay(:, :) ! (klon, nbp_lev)
     ! (pression pour le mileu de chaque couche, en Pa)
 
     ! Variables local to the procedure:
 
-    integer ncid ! for NetCDF
+    INTEGER ncid ! for NetCDF
 
-    real coefoz(klon, nbp_lev, 7)
+    REAL coefoz(klon, nbp_lev, 7)
     ! (temporary storage for 7 ozone coefficients)
     ! (On the partial "physics" grid.
@@ -102,5 +102,5 @@
     ! middle of layer "k".)
 
-    real a6(klon, nbp_lev)
+    REAL a6(klon, nbp_lev)
     ! (derivative of "P_net_Mob" with respect to column-density of ozone
     ! above, in cm2 s-1)
@@ -109,10 +109,10 @@
     ! middle of layer "k".)
 
-    real, parameter:: amu = 1.6605402e-27 ! atomic mass unit, in kg
+    REAL, parameter:: amu = 1.6605402e-27 ! atomic mass unit, in kg
 
-    real, parameter:: Clx = 3.8e-9
+    REAL, parameter:: Clx = 3.8e-9
     ! (total chlorine content in the upper stratosphere)
 
-    integer k
+    INTEGER k
 
     !------------------------------------
@@ -125,5 +125,5 @@
 
     !$omp master
-    if (is_mpi_root) CALL nf95_open("coefoz_LMDZ.nc", nf90_nowrite, ncid)
+    IF (is_mpi_root) CALL nf95_open("coefoz_LMDZ.nc", nf90_nowrite, ncid)
     !$omp end master
 
@@ -156,5 +156,5 @@
 
     !$omp master
-    if (is_mpi_root) CALL nf95_close(ncid)
+    IF (is_mpi_root) CALL nf95_close(ncid)
     !$omp end master
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_int_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_int_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_int_m.F90	(revision 5117)
@@ -24,27 +24,27 @@
     ! Regridding is by linear interpolation.
 
-    use dimphy, ONLY: klon
-    use netcdf95, ONLY: nf95_inq_varid, nf95_get_var
-    use lmdz_assert, ONLY: assert
-    use regr_lint_m, ONLY: regr_lint
-    use lmdz_phys_mpi_data, ONLY: is_mpi_root
-    use lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, nbp_lev
-    use lmdz_phys_transfert_para, ONLY: scatter2d
+    USE dimphy, ONLY: klon
+    USE netcdf95, ONLY: nf95_inq_varid, nf95_get_var
+    USE lmdz_assert, ONLY: assert
+    USE lmdz_regr_lint, ONLY: regr_lint
+    USE lmdz_phys_mpi_data, ONLY: is_mpi_root
+    USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, nbp_lev
+    USE lmdz_phys_transfert_para, ONLY: scatter2d
     ! (pack to the LMDZ horizontal "physics" grid and scatter)
 
-    integer, intent(in):: ncid ! NetCDF ID of the file
-    CHARACTER(LEN=*), intent(in):: name ! of the NetCDF variable
-    integer, intent(in):: julien ! jour julien, 1 <= julien <= 360
+    INTEGER, INTENT(IN):: ncid ! NetCDF ID of the file
+    CHARACTER(LEN=*), INTENT(IN):: name ! of the NetCDF variable
+    INTEGER, INTENT(IN):: julien ! jour julien, 1 <= julien <= 360
 
-    real, intent(in):: plev(:)
+    REAL, INTENT(IN):: plev(:)
     ! (pressure level of input data, in Pa, in strictly ascending order)
 
-    real, intent(in):: pplay(:, :) ! (klon, nbp_lev)
+    REAL, INTENT(IN):: pplay(:, :) ! (klon, nbp_lev)
     ! (pression pour le mileu de chaque couche, en Pa)
 
-    real, intent(in):: top_value
+    REAL, INTENT(IN):: top_value
     ! (extra value of field at 0 pressure)
 
-    real, intent(out):: v3(:, :) ! (klon, nbp_lev)
+    REAL, INTENT(OUT):: v3(:, :) ! (klon, nbp_lev)
     ! (regridded field on the partial "physics" grid)
     ! ("v3(i, k)" is at longitude "xlon(i)", latitude
@@ -53,5 +53,5 @@
     ! Variables local to the procedure:
 
-    integer varid, ncerr ! for NetCDF
+    INTEGER varid, ncerr ! for NetCDF
 
     real  v1(nbp_lon, nbp_lat, 0:size(plev))
@@ -61,10 +61,10 @@
     ! "v1(:, j, k >=1)" is at latitude "rlatu(j)" and pressure "plev(k)".)
 
-    real v2(klon, 0:size(plev))
+    REAL v2(klon, 0:size(plev))
     ! (field scattered to the partial "physics" horizontal grid)
     ! "v2(i, k >= 1)" is at longitude "xlon(i)", latitude "xlat(i)"
     ! and pressure "plev(k)".)
 
-    integer i
+    INTEGER i
 
     !--------------------------------------------
@@ -74,5 +74,5 @@
 
     !$omp master
-    if (is_mpi_root) THEN
+    IF (is_mpi_root) THEN
        CALL nf95_inq_varid(ncid, name, varid)
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_o3_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_o3_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_o3_m.F90	(revision 5117)
@@ -25,17 +25,17 @@
     ! hPa and strictly increasing.
 
-    use netcdf95, ONLY: nf95_open, nf95_close, nf95_inq_varid, nf95_get_var
-    use netcdf, ONLY:  nf90_nowrite
-    use lmdz_assert, ONLY: assert
-    use regr_conserv_m, ONLY: regr_conserv
-    use press_coefoz_m, ONLY: press_in_edg
-    use time_phylmdz_mod, ONLY: day_ref
-    use lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, nbp_lev
+    USE netcdf95, ONLY: nf95_open, nf95_close, nf95_inq_varid, nf95_get_var
+    USE netcdf, ONLY:  nf90_nowrite
+    USE lmdz_assert, ONLY: assert
+    USE lmdz_regr_conserv, ONLY: regr_conserv
+    USE press_coefoz_m, ONLY: press_in_edg
+    USE time_phylmdz_mod, ONLY: day_ref
+    USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, nbp_lev
 
-    REAL, intent(in):: p3d(:, :, :) ! pressure at layer interfaces, in Pa
+    REAL, INTENT(IN):: p3d(:, :, :) ! pressure at layer interfaces, in Pa
     ! ("p3d(i, j, l)" is at longitude "rlonv(i)", latitude "rlatu(j)",
     ! for interface "l")
 
-    real, intent(out):: o3_mob_regr(:, :, :) ! (iim + 1, jjm + 1, llm)
+    REAL, INTENT(OUT):: o3_mob_regr(:, :, :) ! (iim + 1, jjm + 1, llm)
     ! (ozone mole fraction from Mobidic adapted to the LMDZ grid)
     ! ("o3_mob_regr(i, j, l)" is at longitude "rlonv(i)", latitude
@@ -44,8 +44,8 @@
     ! Variables local to the procedure:
 
-    integer ncid, varid, ncerr ! for NetCDF
-    integer i, j
+    INTEGER ncid, varid, ncerr ! for NetCDF
+    INTEGER i, j
 
-    real r_mob(nbp_lat, size(press_in_edg) - 1)
+    REAL r_mob(nbp_lat, size(press_in_edg) - 1)
     ! (ozone mole fraction from Mobidic at day "day_ref")
     ! (r_mob(j, k) is at latitude "rlatu(j)", in pressure interval
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_time_av_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_time_av_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_time_av_m.F90	(revision 5117)
@@ -119,8 +119,8 @@
     USE lmdz_assert_eq, ONLY: assert_eq
     !!  USE comvert_mod,    ONLY: scaleheight
-    use lmdz_interpolation, ONLY: locate
-    USE regr_conserv_m, ONLY: regr_conserv
-    USE regr_lint_m, ONLY: regr_lint
-    USE slopes_m, ONLY: slopes
+    USE lmdz_interpolation, ONLY: locate
+    USE lmdz_regr_conserv, ONLY: regr_conserv
+    USE lmdz_regr_lint, ONLY: regr_lint
+    USE lmdz_slopes, ONLY: slopes
     USE lmdz_phys_para, ONLY: is_mpi_root, is_master
     USE lmdz_grid_phy, ONLY: nlon => nbp_lon, nlat => nbp_lat, nlev_ou => nbp_lev, klon_glo, grid_type, unstructured
@@ -539,5 +539,5 @@
     !-------------------------------------------------------------------------------
 
-    FUNCTION get_SigTrop(ih, it) RESULT(out)
+    FUNCTION get_SigTrop(ih, it) RESULT(OUT)
 
       !-------------------------------------------------------------------------------
@@ -565,5 +565,5 @@
     !-------------------------------------------------------------------------------
 
-    FUNCTION PTrop_chem(ih, it, it0, pres, o3, o3trop) RESULT(out)
+    FUNCTION PTrop_chem(ih, it, it0, pres, o3, o3trop) RESULT(OUT)
 
       !-------------------------------------------------------------------------------
@@ -618,5 +618,5 @@
     !-------------------------------------------------------------------------------
 
-    FUNCTION check_ozone(o3col, lon, lat, ilev0, layer, vmin, vmax) RESULT(out)
+    FUNCTION check_ozone(o3col, lon, lat, ilev0, layer, vmin, vmax) RESULT(OUT)
 
       !-------------------------------------------------------------------------------
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/screenc_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/screenc_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/screenc_mod.F90	(revision 5117)
@@ -56,19 +56,19 @@
 ! delq----input-R- anomalie de l'humidite relative par rapport a la surface
 
-      INTEGER, intent(in) :: klon, knon, nsrf
-      LOGICAL, intent(in) :: zxli, okri 
-      REAL, dimension(klon), intent(in) :: speed, temp, q_zref
-      REAL, intent(in) :: zref
-      REAL, dimension(klon), intent(IN) :: ts
-      REAL, dimension(klon), intent(in) :: qsurf, psol
-      REAL, dimension(klon), intent(inout):: z0m, z0h
-      REAL, dimension(klon), intent(in) :: ustar, testar, qstar, ri1   
-
-      REAL, dimension(klon), intent(inout) :: s_pblh    
-      REAL, dimension(klon), intent(in) :: prain    
-      REAL, dimension(klon), intent(in) :: tsol    
+      INTEGER, INTENT(IN) :: klon, knon, nsrf
+      LOGICAL, INTENT(IN) :: zxli, okri
+      REAL, DIMENSION(klon), INTENT(IN) :: speed, temp, q_zref
+      REAL, INTENT(IN) :: zref
+      REAL, DIMENSION(klon), INTENT(IN) :: ts
+      REAL, DIMENSION(klon), INTENT(IN) :: qsurf, psol
+      REAL, DIMENSION(klon), INTENT(INOUT):: z0m, z0h
+      REAL, DIMENSION(klon), INTENT(IN) :: ustar, testar, qstar, ri1
+
+      REAL, DIMENSION(klon), INTENT(INOUT) :: s_pblh
+      REAL, DIMENSION(klon), INTENT(IN) :: prain
+      REAL, DIMENSION(klon), INTENT(IN) :: tsol
       REAL, DIMENSION(klon), INTENT(IN)    :: pat1 !pression premier lev      
 
-      REAL, dimension(klon), intent(out) :: pref, delu, delte, delq 
+      REAL, DIMENSION(klon), INTENT(OUT) :: pref, delu, delte, delq
 !-----------------------------------------------------------------------
       include "YOMCST.h"
@@ -77,5 +77,5 @@
 ! Variables locales  
       INTEGER :: i 
-      REAL, dimension(klon) :: cdram, cdrah, cdran, zri1, gref,ycdragm,zri_zero
+      REAL, DIMENSION(klon) :: cdram, cdrah, cdran, zri1, gref,ycdragm,zri_zero
 
 !------------------------------------------------------------------------- 
@@ -159,20 +159,20 @@
 ! delq----input-R- anomalie de l'humidite relative par rapport a la surface
 
-      INTEGER, intent(in) :: klon, knon, nsrf
-      LOGICAL, intent(in) :: zxli, okri 
-      REAL, dimension(klon), intent(in) :: speed, temp, q_zref
-      REAL, intent(in) :: zref
-      REAL, dimension(klon), intent(in) :: ts, qsurf, psol
-      REAL, dimension(klon), intent(inout) :: z0m, z0h
-      REAL, dimension(klon), intent(in) :: cdrm, cdrh, ri1         
-      REAL, dimension(klon), intent(inout) :: s_pblh    
-      REAL, dimension(klon), intent(in) :: prain    
-      REAL, dimension(klon), intent(in) :: tsol    
+      INTEGER, INTENT(IN) :: klon, knon, nsrf
+      LOGICAL, INTENT(IN) :: zxli, okri
+      REAL, DIMENSION(klon), INTENT(IN) :: speed, temp, q_zref
+      REAL, INTENT(IN) :: zref
+      REAL, DIMENSION(klon), INTENT(IN) :: ts, qsurf, psol
+      REAL, DIMENSION(klon), INTENT(INOUT) :: z0m, z0h
+      REAL, DIMENSION(klon), INTENT(IN) :: cdrm, cdrh, ri1
+      REAL, DIMENSION(klon), INTENT(INOUT) :: s_pblh
+      REAL, DIMENSION(klon), INTENT(IN) :: prain
+      REAL, DIMENSION(klon), INTENT(IN) :: tsol
       REAL, DIMENSION(klon), INTENT(IN) :: pat1 !pression premier lev      
       INTEGER, INTENT(IN)  :: iri1 ! Richardson de la 1ere couche
 
-      REAL, dimension(klon), intent(out) :: pref, delm, delh, zri1
-!171220     REAL, dimension(klon) :: cdram, cdrah, zri1 
-      REAL, dimension(klon) :: cdram, cdrah
+      REAL, DIMENSION(klon), INTENT(OUT) :: pref, delm, delh, zri1
+!171220     REAL, DIMENSION(klon) :: cdram, cdrah, zri1
+      REAL, DIMENSION(klon) :: cdram, cdrah
 !-----------------------------------------------------------------------
       include "YOMCST.h"
@@ -181,5 +181,5 @@
 ! Variables locales  
       INTEGER :: i 
-      REAL, dimension(klon) :: cdran, gref,ycdragm
+      REAL, DIMENSION(klon) :: cdran, gref,ycdragm
 
 !------------------------------------------------------------------------- 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/screenp_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/screenp_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/screenp_mod.F90	(revision 5117)
@@ -51,12 +51,12 @@
 ! delq----input-R- anomalie de l'humidite relative par rapport a la surface
 
-      INTEGER, intent(in) :: klon, knon, nsrf
-      REAL, dimension(klon), intent(in) :: speed, tair, qair
-      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos
-      DOUBLE PRECISION, dimension(klon), intent(in) :: lmon
-      REAL, dimension(klon), intent(in) :: ustar, testar, qstar
-      REAL, intent(in) :: zref
+      INTEGER, INTENT(IN) :: klon, knon, nsrf
+      REAL, DIMENSION(klon), INTENT(IN) :: speed, tair, qair
+      REAL, DIMENSION(klon), INTENT(IN) :: ts, qsurf, rugos
+      DOUBLE PRECISION, DIMENSION(klon), INTENT(IN) :: lmon
+      REAL, DIMENSION(klon), INTENT(IN) :: ustar, testar, qstar
+      REAL, INTENT(IN) :: zref
 
-      REAL, dimension(klon), intent(out) :: delu, delte, delq
+      REAL, DIMENSION(klon), INTENT(OUT) :: delu, delte, delq
 
 !-------------------------------------------------------------------------
@@ -154,11 +154,11 @@
 ! delq----input-R- anomalie de l'humidite relative par rapport a la surface
 
-      INTEGER, intent(in) :: klon, knon, nsrf
-      REAL, dimension(klon), intent(in) :: speed, tair, qair
-      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos
-      REAL, dimension(klon), intent(in) :: zri1
-      REAL, intent(in) :: zref
+      INTEGER, INTENT(IN) :: klon, knon, nsrf
+      REAL, DIMENSION(klon), INTENT(IN) :: speed, tair, qair
+      REAL, DIMENSION(klon), INTENT(IN) :: ts, qsurf, rugos
+      REAL, DIMENSION(klon), INTENT(IN) :: zri1
+      REAL, INTENT(IN) :: zref
 
-      REAL, dimension(klon), intent(out) :: delu, delte, delq
+      REAL, DIMENSION(klon), INTENT(OUT) :: delu, delte, delq
 
 !-------------------------------------------------------------------------
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/simu_airs.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/simu_airs.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/simu_airs.F90	(revision 5117)
@@ -33,5 +33,5 @@
     slope(N) = slope(N - 1)
 
-    if (P(1)>P(N)) THEN
+    IF (P(1)>P(N)) THEN
       i_dir = 1
       i = 1
@@ -44,10 +44,10 @@
     exit_flag = 0
     do while(exit_flag==0)
-      if (P(i)>=P_min.and.P(i)<=P_max) THEN
-        if (first_point>0) THEN
+      IF (P(i)>=P_min.AND.P(i)<=P_max) THEN
+        IF (first_point>0) THEN
           delta_alt = alt(i) - alt(first_point)
-          if (delta_alt>=delta_alt_limit) THEN
+          IF (delta_alt>=delta_alt_limit) THEN
             slope_2km = (T(first_point) - T(i)) / delta_alt
-            if (slope_2km<slope_limit) THEN
+            IF (slope_2km<slope_limit) THEN
               exit_flag = 1
             else
@@ -56,13 +56,13 @@
           end if
         end if
-        if (first_point==0.and.slope(i)<slope_limit) first_point = i
+        IF (first_point==0.AND.slope(i)<slope_limit) first_point = i
       end if
       i = i + i_dir
-      if (i<=1.or.i>=N) exit_flag = 1
+      IF (i<=1.OR.i>=N) exit_flag = 1
     END DO
 
-    if (first_point<=0) P_tropo = 65.4321
-    if (first_point==1) P_tropo = 64.5432
-    if (first_point>1) THEN
+    IF (first_point<=0) P_tropo = 65.4321
+    IF (first_point==1) P_tropo = 64.5432
+    IF (first_point>1) THEN
       tmp = (slope_limit - slope(first_point)) / (slope(first_point + 1) - &
               slope(first_point)) * (P(first_point + 1) - P(first_point))
@@ -72,5 +72,5 @@
 
     ! Ajout Marine
-    if (P_tropo < 60. .or. P_tropo > 470.) THEN
+    IF (P_tropo < 60. .OR. P_tropo > 470.) THEN
       P_tropo = 999.
     endif
@@ -93,10 +93,10 @@
     INTEGER :: i, n, nss
 
-    INTEGER, intent(in) :: len_cs
-    REAL, DIMENSION(:), intent(in) :: rneb_cs, temp_cs
-    REAL, DIMENSION(:), intent(in) :: emis_cs, iwco_cs, rad_cs
-    REAL, DIMENSION(:), intent(in) :: pres_cs, dz_cs, rhodz_cs
-
-    REAL, intent(out) :: cc_tot_cs, cc_hc_cs, cc_hist_cs, &
+    INTEGER, INTENT(IN) :: len_cs
+    REAL, DIMENSION(:), INTENT(IN) :: rneb_cs, temp_cs
+    REAL, DIMENSION(:), INTENT(IN) :: emis_cs, iwco_cs, rad_cs
+    REAL, DIMENSION(:), INTENT(IN) :: pres_cs, dz_cs, rhodz_cs
+
+    REAL, INTENT(OUT) :: cc_tot_cs, cc_hc_cs, cc_hist_cs, &
             cc_Cb_cs, cc_ThCi_cs, cc_Anv_cs, &
             pcld_hc_cs, tcld_hc_cs, em_hc_cs, iwp_hc_cs, &
@@ -110,9 +110,9 @@
     REAL :: rneb_min
 
-    REAL, DIMENSION(:), allocatable :: s, s_hc, s_hist, rneb_max
-    REAL, DIMENSION(:), allocatable :: sCb, sThCi, sAnv
-    REAL, DIMENSION(:), allocatable :: iwp_ss, pcld_ss, tcld_ss, &
+    REAL, DIMENSION(:), ALLOCATABLE :: s, s_hc, s_hist, rneb_max
+    REAL, DIMENSION(:), ALLOCATABLE :: sCb, sThCi, sAnv
+    REAL, DIMENSION(:), ALLOCATABLE :: iwp_ss, pcld_ss, tcld_ss, &
             emis_ss
-    REAL, DIMENSION(:), allocatable :: deltaz_ss, rad_ss
+    REAL, DIMENSION(:), ALLOCATABLE :: deltaz_ss, rad_ss
 
     CHARACTER (len = 50) :: modname = 'simu_airs.cloud_structure'
@@ -130,5 +130,5 @@
 
     do i = 2, size(rneb_cs)
-      if (rneb_ord(i) > rneb_min) THEN
+      IF (rneb_ord(i) > rneb_min) THEN
         nss = nss + 1
         rneb_min = rneb_ord(i)
@@ -162,5 +162,5 @@
 
     do i = 2, size(rneb_cs)
-      if (rneb_ord(i) > rneb_min) THEN
+      IF (rneb_ord(i) > rneb_min) THEN
         n = n + 1
         s(n) = rneb_ord(i) - rneb_min
@@ -298,5 +298,5 @@
     ! Tests
 
-    if (cc_tot_cs > maxval(rneb_cs) .and. &
+    IF (cc_tot_cs > maxval(rneb_cs) .AND. &
             abs(cc_tot_cs - maxval(rneb_cs)) > 1.e-4)  THEN
       WRITE(abort_message, *) 'cc_tot_cs > max rneb_cs', cc_tot_cs, maxval(rneb_cs)
@@ -304,5 +304,5 @@
     endif
 
-    if (iwp_hc_cs < 0.) THEN
+    IF (iwp_hc_cs < 0.) THEN
       abort_message = 'cloud_structure: iwp_hc_cs < 0'
       CALL abort_physic(modname, abort_message, 1)
@@ -314,8 +314,8 @@
   SUBROUTINE normal_undef(num, den)
 
-    REAL, intent(in) :: den
-    REAL, intent(inout) :: num
-
-    if (den /= 0) THEN
+    REAL, INTENT(IN) :: den
+    REAL, INTENT(INOUT) :: num
+
+    IF (den /= 0) THEN
       num = num / den
     else
@@ -328,9 +328,9 @@
   SUBROUTINE normal2_undef(res, num, den)
 
-    REAL, intent(in) :: den
-    REAL, intent(in) :: num
-    REAL, intent(out) :: res
-
-    if (den /= 0.) THEN
+    REAL, INTENT(IN) :: den
+    REAL, INTENT(IN) :: num
+    REAL, INTENT(OUT) :: res
+
+    IF (den /= 0.) THEN
       res = num / den
     else
@@ -348,15 +348,15 @@
           emis, pcld, tcld, iwp, deltaz, rad)
 
-    INTEGER, intent(in) :: len_cs
-    REAL, DIMENSION(len_cs), intent(in) :: rneb_cs, temp_cs
-    REAL, DIMENSION(len_cs), intent(in) :: emis_cs, iwco_cs, &
+    INTEGER, INTENT(IN) :: len_cs
+    REAL, DIMENSION(len_cs), INTENT(IN) :: rneb_cs, temp_cs
+    REAL, DIMENSION(len_cs), INTENT(IN) :: emis_cs, iwco_cs, &
             rneb_ord
-    REAL, DIMENSION(len_cs), intent(in) :: pres_cs, dz_cs, rad_cs
-    REAL, DIMENSION(len_cs), intent(in) :: rhodz_cs
+    REAL, DIMENSION(len_cs), INTENT(IN) :: pres_cs, dz_cs, rad_cs
+    REAL, DIMENSION(len_cs), INTENT(IN) :: rhodz_cs
     REAL, DIMENSION(len_cs) :: tau_cs, w
-    REAL, intent(in) :: rnebmax
-    REAL, intent(inout) :: stot, shc, shist
-    REAL, intent(inout) :: sCb, sThCi, sAnv
-    REAL, intent(out) :: emis, pcld, tcld, iwp, deltaz, rad
+    REAL, INTENT(IN) :: rnebmax
+    REAL, INTENT(INOUT) :: stot, shc, shist
+    REAL, INTENT(INOUT) :: sCb, sThCi, sAnv
+    REAL, INTENT(OUT) :: emis, pcld, tcld, iwp, deltaz, rad
 
     INTEGER :: i, ideb, ibeg, iend, nuage, visible
@@ -370,5 +370,5 @@
 
     do i = 1, len_cs
-      if (rneb_cs(i) >= rnebmax) THEN
+      IF (rneb_cs(i) >= rnebmax) THEN
         w(i) = 1.
       else
@@ -381,5 +381,5 @@
     som = 0.
     do i = 1, len_cs
-      if (emis_cs(i) == 1.) THEN
+      IF (emis_cs(i) == 1.) THEN
         tau_cs(i) = 10.
       else
@@ -395,5 +395,5 @@
 
     ! Boucle sur les nuages
-    do while (ideb /= 0 .and. ideb <= len_cs)
+    do while (ideb /= 0 .AND. ideb <= len_cs)
 
 
@@ -403,5 +403,5 @@
       ideb = iend + 1
 
-      if (ibeg > 0) THEN
+      IF (ibeg > 0) THEN
         nuage = nuage + 1
 
@@ -427,5 +427,5 @@
     CALL topbot(1, w, ibeg, iend)
 
-    if (ibeg > 0) THEN
+    IF (ibeg > 0) THEN
       CALL caract(ibeg, iend, temp_cs, tau_cs, iwco_cs, &
               pres_cs, dz_cs, rhodz_cs, rad_cs, pcld, tcld, &
@@ -438,5 +438,5 @@
       rad = som_rad
 
-      if (pcld > p_thresh) THEN
+      IF (pcld > p_thresh) THEN
         shc = 0.
         shist = 0.
@@ -447,18 +447,18 @@
       else
 
-        if (emis < em_min .or. emis > em_max  &
-                .or. tcld > 230.) THEN
+        IF (emis < em_min .OR. emis > em_max  &
+                .OR. tcld > 230.) THEN
           shist = 0.
         endif
 
-        if (emis < 0.98) THEN
+        IF (emis < 0.98) THEN
           sCb = 0.
         endif
 
-        if (emis > 0.5 .or. emis < 0.1) THEN
+        IF (emis > 0.5 .OR. emis < 0.1) THEN
           sThCi = 0.
         endif
 
-        if (emis <= 0.5 .or. emis >= 0.98) THEN
+        IF (emis <= 0.5 .OR. emis >= 0.98) THEN
           sAnv = 0.
         endif
@@ -487,15 +487,15 @@
     ! Tests
 
-    if (iwp < 0.) THEN
+    IF (iwp < 0.) THEN
       WRITE(abort_message, *) 'ideb iwp =', ideb, iwp
       CALL abort_physic(modname, abort_message, 1)
     endif
 
-    if (deltaz < 0.) THEN
+    IF (deltaz < 0.) THEN
       WRITE(abort_message, *)'ideb deltaz =', ideb, deltaz
       CALL abort_physic(modname, abort_message, 1)
     endif
 
-    if (emis < 0.048 .and. emis /= 0.) THEN
+    IF (emis < 0.048 .AND. emis /= 0.) THEN
       WRITE(abort_message, *) 'ideb emis =', ideb, emis
       CALL abort_physic(modname, abort_message, 1)
@@ -508,9 +508,9 @@
           visible, w)
 
-    INTEGER, intent(in) :: ibeg, iend
-    REAL, intent(in) :: som_tau
-
-    INTEGER, intent(inout) :: visible
-    REAL, DIMENSION(:), intent(inout) :: w
+    INTEGER, INTENT(IN) :: ibeg, iend
+    REAL, INTENT(IN) :: som_tau
+
+    INTEGER, INTENT(INOUT) :: visible
+    REAL, DIMENSION(:), INTENT(INOUT) :: w
 
     INTEGER :: i
@@ -522,6 +522,6 @@
     ! Cas ou il n'y a pas de nuage visible au-dessus
 
-    if (visible == 0) THEN
-      if (som_tau < tau_thresh) THEN
+    IF (visible == 0) THEN
+      IF (som_tau < tau_thresh) THEN
         do i = ibeg, iend
           w(i) = 0.
@@ -548,10 +548,10 @@
           som_tau, som_iwc, som_dz, som_rad)
 
-    INTEGER, intent(in) :: ibeg, iend
-    REAL, DIMENSION(:), intent(in) :: tau_cs, iwco_cs, temp_cs
-    REAL, DIMENSION(:), intent(in) :: pres_cs, dz_cs, rad_cs
-    REAL, DIMENSION(:), intent(in) :: rhodz_cs
-    REAL, intent(out) :: som_tau, som_iwc, som_dz, som_rad
-    REAL, intent(out) :: pcld, tcld
+    INTEGER, INTENT(IN) :: ibeg, iend
+    REAL, DIMENSION(:), INTENT(IN) :: tau_cs, iwco_cs, temp_cs
+    REAL, DIMENSION(:), INTENT(IN) :: pres_cs, dz_cs, rad_cs
+    REAL, DIMENSION(:), INTENT(IN) :: rhodz_cs
+    REAL, INTENT(OUT) :: som_tau, som_iwc, som_dz, som_rad
+    REAL, INTENT(OUT) :: pcld, tcld
 
     INTEGER :: i, ibase, imid
@@ -576,5 +576,5 @@
       som_rad = som_rad + rad_cs(i) * dz_cs(i)
 
-      if (som_tau > 3. .and. ibase == -100) THEN
+      IF (som_tau > 3. .AND. ibase == -100) THEN
         ibase = i - 1
       endif
@@ -582,5 +582,5 @@
     enddo
 
-    if (som_dz /= 0.) THEN
+    IF (som_dz /= 0.) THEN
       som_rad = som_rad / som_dz
     else
@@ -596,5 +596,5 @@
     ! Determination de Pcld et Tcld
 
-    if (ibase < ibeg) THEN
+    IF (ibase < ibeg) THEN
       ibase = ibeg
     endif
@@ -609,7 +609,7 @@
   SUBROUTINE topbot(ideb, w, ibeg, iend)
 
-    INTEGER, intent(in) :: ideb
-    REAL, DIMENSION(:), intent(in) :: w
-    INTEGER, intent(out) :: ibeg, iend
+    INTEGER, INTENT(IN) :: ideb
+    REAL, DIMENSION(:), INTENT(IN) :: w
+    INTEGER, INTENT(OUT) :: ibeg, iend
 
     INTEGER :: i, itest
@@ -621,5 +621,5 @@
     do i = ideb, size(w)
 
-      if (w(i) == 1. .and. itest == 0) THEN
+      IF (w(i) == 1. .AND. itest == 0) THEN
         ibeg = i
         itest = 1
@@ -629,5 +629,5 @@
 
     i = ibeg
-    do while (w(i) == 1. .and. i <= size(w))
+    do while (w(i) == 1. .AND. i <= size(w))
       i = i + 1
     enddo
@@ -638,7 +638,7 @@
   SUBROUTINE ordonne(len_cs, rneb_cs, rneb_ord)
 
-    INTEGER, intent(in) :: len_cs
-    REAL, DIMENSION(:), intent(in) :: rneb_cs
-    REAL, DIMENSION(:), intent(out) :: rneb_ord
+    INTEGER, INTENT(IN) :: len_cs
+    REAL, DIMENSION(:), INTENT(IN) :: rneb_cs
+    REAL, DIMENSION(:), INTENT(OUT) :: rneb_ord
 
     INTEGER :: i, j, ind_min
@@ -656,5 +656,5 @@
 
       do i = 1, size(rneb_cs)
-        if (rneb(i) < rneb_max) THEN
+        IF (rneb(i) < rneb_max) THEN
           rneb_max = rneb(i)
           ind_min = i
@@ -684,23 +684,23 @@
     USE dimphy
 
-    REAL, DIMENSION(klev), intent(in) :: rneb_1D, temp_1D, emis_1D, &
+    REAL, DIMENSION(klev), INTENT(IN) :: rneb_1D, temp_1D, emis_1D, &
             iwcon_1D, rad_1D
-    REAL, DIMENSION(klev), intent(in) :: pres, dz, rhodz_1D
-    REAL, intent(out) :: cc_tot_mesh, cc_hc_mesh, cc_hist_mesh
-    REAL, intent(out) :: cc_Cb_mesh, cc_ThCi_mesh, cc_Anv_mesh
-    REAL, intent(out) :: em_hc_mesh, pcld_hc_mesh, tcld_hc_mesh, &
+    REAL, DIMENSION(klev), INTENT(IN) :: pres, dz, rhodz_1D
+    REAL, INTENT(OUT) :: cc_tot_mesh, cc_hc_mesh, cc_hist_mesh
+    REAL, INTENT(OUT) :: cc_Cb_mesh, cc_ThCi_mesh, cc_Anv_mesh
+    REAL, INTENT(OUT) :: em_hc_mesh, pcld_hc_mesh, tcld_hc_mesh, &
             iwp_hc_mesh
 
-    REAL, intent(out) :: pcld_Cb_mesh, tcld_Cb_mesh, em_Cb_mesh
-    REAL, intent(out) :: pcld_ThCi_mesh, tcld_ThCi_mesh, &
+    REAL, INTENT(OUT) :: pcld_Cb_mesh, tcld_Cb_mesh, em_Cb_mesh
+    REAL, INTENT(OUT) :: pcld_ThCi_mesh, tcld_ThCi_mesh, &
             em_ThCi_mesh
-    REAL, intent(out) :: pcld_Anv_mesh, tcld_Anv_mesh, em_Anv_mesh
-
-    REAL, intent(out) :: em_hist_mesh, iwp_hist_mesh, rad_hist_mesh
-    REAL, intent(out) :: deltaz_hc_mesh, deltaz_hist_mesh
-
-    REAL, DIMENSION(:), allocatable :: rneb_cs, temp_cs, emis_cs, &
+    REAL, INTENT(OUT) :: pcld_Anv_mesh, tcld_Anv_mesh, em_Anv_mesh
+
+    REAL, INTENT(OUT) :: em_hist_mesh, iwp_hist_mesh, rad_hist_mesh
+    REAL, INTENT(OUT) :: deltaz_hc_mesh, deltaz_hist_mesh
+
+    REAL, DIMENSION(:), ALLOCATABLE :: rneb_cs, temp_cs, emis_cs, &
             iwco_cs
-    REAL, DIMENSION(:), allocatable :: pres_cs, dz_cs, rad_cs, &
+    REAL, DIMENSION(:), ALLOCATABLE :: pres_cs, dz_cs, rad_cs, &
             rhodz_cs
 
@@ -784,5 +784,5 @@
       do l = ltop, 1, -1
 
-        if (itop == 0 .and. rneb_1D(l) > 0.001) THEN
+        IF (itop == 0 .AND. rneb_1D(l) > 0.001) THEN
           itop = l
         endif
@@ -792,5 +792,5 @@
       ibot = itop
 
-      do while (rneb_1D(ibot) > 0.001 .and. ibot >= 1)
+      do while (rneb_1D(ibot) > 0.001 .AND. ibot >= 1)
         ibot = ibot - 1
       enddo
@@ -798,5 +798,5 @@
       ibot = ibot + 1
 
-      if (itop > 0) then    ! itop > 0
+      IF (itop > 0) then    ! itop > 0
 
         num_cs = num_cs + 1
@@ -925,5 +925,5 @@
     ! Determination des variables de sortie
 
-    if (N_CS > 0) then   ! if N_CS>0
+    IF (N_CS > 0) then   ! if N_CS>0
 
       cc_tot_mesh = 1. - prod
@@ -982,5 +982,5 @@
       ! Tests
 
-      if (cc_tot_mesh > tsom_tot .and. &
+      IF (cc_tot_mesh > tsom_tot .AND. &
               abs(cc_tot_mesh - tsom_tot) > 1.e-4) THEN
         WRITE(abort_message, *)'cc_tot_mesh > tsom_tot', cc_tot_mesh, tsom_tot
@@ -988,5 +988,5 @@
       endif
 
-      if (cc_tot_mesh < maxval(test_tot(1:N_CS)) .and. &
+      IF (cc_tot_mesh < maxval(test_tot(1:N_CS)) .AND. &
               abs(cc_tot_mesh - maxval(test_tot(1:N_CS))) > 1.e-4) THEN
         WRITE(abort_message, *) 'cc_tot_mesh < max', cc_tot_mesh, maxval(test_tot(1:N_CS))
@@ -994,5 +994,5 @@
       endif
 
-      if (cc_hc_mesh > tsom_hc .and. &
+      IF (cc_hc_mesh > tsom_hc .AND. &
               abs(cc_hc_mesh - tsom_hc) > 1.e-4) THEN
         WRITE(abort_message, *) 'cc_hc_mesh > tsom_hc', cc_hc_mesh, tsom_hc
@@ -1000,5 +1000,5 @@
       endif
 
-      if (cc_hc_mesh < maxval(test_hc(1:N_CS)) .and. &
+      IF (cc_hc_mesh < maxval(test_hc(1:N_CS)) .AND. &
               abs(cc_hc_mesh - maxval(test_hc(1:N_CS))) > 1.e-4) THEN
         WRITE(abort_message, *) 'cc_hc_mesh < max', cc_hc_mesh, maxval(test_hc(1:N_CS))
@@ -1006,5 +1006,5 @@
       endif
 
-      if (cc_hist_mesh > tsom_hist .and. &
+      IF (cc_hist_mesh > tsom_hist .AND. &
               abs(cc_hist_mesh - tsom_hist) > 1.e-4) THEN
         WRITE(abort_message, *) 'cc_hist_mesh > tsom_hist', cc_hist_mesh, tsom_hist
@@ -1012,14 +1012,14 @@
       endif
 
-      if (cc_hist_mesh < 0.) THEN
+      IF (cc_hist_mesh < 0.) THEN
         WRITE(abort_message, *) 'cc_hist_mesh < 0', cc_hist_mesh
         CALL abort_physic(modname, abort_message, 1)
       endif
 
-      if ((pcld_hc_mesh > maxval(test_pcld(1:N_CS)) .or. &
-              pcld_hc_mesh < minval(test_pcld(1:N_CS))) .and. &
-              abs(pcld_hc_mesh - maxval(test_pcld(1:N_CS))) > 1. .and. &
+      IF ((pcld_hc_mesh > maxval(test_pcld(1:N_CS)) .OR. &
+              pcld_hc_mesh < minval(test_pcld(1:N_CS))) .AND. &
+              abs(pcld_hc_mesh - maxval(test_pcld(1:N_CS))) > 1. .AND. &
               maxval(test_pcld(1:N_CS)) /= 999. &
-              .and. minval(test_pcld(1:N_CS)) /= 999.) THEN
+              .AND. minval(test_pcld(1:N_CS)) /= 999.) THEN
         WRITE(abort_message, *) 'pcld_hc_mesh est faux', pcld_hc_mesh, maxval(test_pcld(1:N_CS)), &
                 minval(test_pcld(1:N_CS))
@@ -1027,9 +1027,9 @@
       endif
 
-      if ((tcld_hc_mesh > maxval(test_tcld(1:N_CS)) .or. &
-              tcld_hc_mesh < minval(test_tcld(1:N_CS))) .and. &
-              abs(tcld_hc_mesh - maxval(test_tcld(1:N_CS))) > 0.1 .and. &
+      IF ((tcld_hc_mesh > maxval(test_tcld(1:N_CS)) .OR. &
+              tcld_hc_mesh < minval(test_tcld(1:N_CS))) .AND. &
+              abs(tcld_hc_mesh - maxval(test_tcld(1:N_CS))) > 0.1 .AND. &
               maxval(test_tcld(1:N_CS)) /= 999. &
-              .and. minval(test_tcld(1:N_CS)) /= 999.) THEN
+              .AND. minval(test_tcld(1:N_CS)) /= 999.) THEN
         WRITE(abort_message, *) 'tcld_hc_mesh est faux', tcld_hc_mesh, maxval(test_tcld(1:N_CS)), &
                 minval(test_tcld(1:N_CS))
@@ -1037,8 +1037,8 @@
       endif
 
-      if ((em_hc_mesh > maxval(test_em(1:N_CS)) .or. &
-              em_hc_mesh < minval(test_em(1:N_CS))) .and. &
-              abs(em_hc_mesh - maxval(test_em(1:N_CS))) > 1.e-4 .and. &
-              minval(test_em(1:N_CS)) /= 999. .and. &
+      IF ((em_hc_mesh > maxval(test_em(1:N_CS)) .OR. &
+              em_hc_mesh < minval(test_em(1:N_CS))) .AND. &
+              abs(em_hc_mesh - maxval(test_em(1:N_CS))) > 1.e-4 .AND. &
+              minval(test_em(1:N_CS)) /= 999. .AND. &
               maxval(test_em(1:N_CS)) /= 999.) THEN
         WRITE(abort_message, *) 'em_hc_mesh est faux', em_hc_mesh, maxval(test_em(1:N_CS)), &
@@ -1085,10 +1085,10 @@
   SUBROUTINE test_bornes(sx, x, bsup, binf)
 
-    REAL, intent(in) :: x, bsup, binf
-    character*14, intent(in) :: sx
+    REAL, INTENT(IN) :: x, bsup, binf
+    character*14, INTENT(IN) :: sx
     CHARACTER (len = 50) :: modname = 'simu_airs.test_bornes'
     CHARACTER (len = 160) :: abort_message
 
-    if (x > bsup .or. x < binf) THEN
+    IF (x > bsup .OR. x < binf) THEN
       WRITE(abort_message, *) sx, 'est faux', sx, x
       CALL abort_physic(modname, abort_message, 1)
@@ -1119,7 +1119,7 @@
   include "YOMCST.h"
 
-  INTEGER, intent(in) :: itap
-
-  REAL, DIMENSION(klon, klev), intent(in) :: &
+  INTEGER, INTENT(IN) :: itap
+
+  REAL, DIMENSION(klon, klev), INTENT(IN) :: &
           rneb_airs, temp_airs, cldemi_airs, iwcon0_airs, &
           rad_airs, geop_airs, pplay_airs, paprs_airs
@@ -1128,5 +1128,5 @@
           rhodz_airs, rho_airs, iwcon_airs
 
-  REAL, DIMENSION(klon), intent(out) :: alt_tropo
+  REAL, DIMENSION(klon), INTENT(OUT) :: alt_tropo
 
   REAL, DIMENSION(klev) :: rneb_1D, temp_1D, &
@@ -1145,18 +1145,18 @@
   REAL :: pcld_Anv_mesh, tcld_Anv_mesh, em_Anv_mesh
 
-  REAL, DIMENSION(klon), intent(out) :: map_prop_hc, map_prop_hist
-  REAL, DIMENSION(klon), intent(out) :: map_emis_hc, map_iwp_hc
-  REAL, DIMENSION(klon), intent(out) :: map_deltaz_hc, map_pcld_hc
-  REAL, DIMENSION(klon), intent(out) :: map_tcld_hc
-  REAL, DIMENSION(klon), intent(out) :: map_emis_Cb, map_pcld_Cb, map_tcld_Cb
-  REAL, DIMENSION(klon), intent(out) :: &
+  REAL, DIMENSION(klon), INTENT(OUT) :: map_prop_hc, map_prop_hist
+  REAL, DIMENSION(klon), INTENT(OUT) :: map_emis_hc, map_iwp_hc
+  REAL, DIMENSION(klon), INTENT(OUT) :: map_deltaz_hc, map_pcld_hc
+  REAL, DIMENSION(klon), INTENT(OUT) :: map_tcld_hc
+  REAL, DIMENSION(klon), INTENT(OUT) :: map_emis_Cb, map_pcld_Cb, map_tcld_Cb
+  REAL, DIMENSION(klon), INTENT(OUT) :: &
           map_emis_ThCi, map_pcld_ThCi, map_tcld_ThCi
-  REAL, DIMENSION(klon), intent(out) :: &
+  REAL, DIMENSION(klon), INTENT(OUT) :: &
           map_emis_Anv, map_pcld_Anv, map_tcld_Anv
-  REAL, DIMENSION(klon), intent(out) :: &
+  REAL, DIMENSION(klon), INTENT(OUT) :: &
           map_emis_hist, map_iwp_hist, map_deltaz_hist, &
           map_rad_hist
-  REAL, DIMENSION(klon), intent(out) :: map_ntot, map_hc, map_hist
-  REAL, DIMENSION(klon), intent(out) :: map_Cb, map_ThCi, map_Anv
+  REAL, DIMENSION(klon), INTENT(OUT) :: map_ntot, map_hc, map_hist
+  REAL, DIMENSION(klon), INTENT(OUT) :: map_Cb, map_ThCi, map_Anv
 
   WRITE(*, *) 'simu_airs'
@@ -1180,5 +1180,5 @@
               pplay_airs(i, j) / (temp_airs(i, j) * RD)
 
-      if (rneb_airs(i, j) > 0.001) THEN
+      IF (rneb_airs(i, j) > 0.001) THEN
         iwcon_airs(i, j) = iwcon0_airs(i, j) / rneb_airs(i, j)
       else
@@ -1215,5 +1215,5 @@
     ! Appel du ss-programme sim_mesh
 
-    !        if (itap .eq. 1 ) THEN
+    !        if (itap .EQ. 1 ) THEN
     CALL sim_mesh(rneb_1D, temp_1D, emis_1D, iwcon_1D, rad_1D, &
             pres_1D, dz_1D, rhodz_1D, &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/slab_heat_transp_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/slab_heat_transp_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/slab_heat_transp_mod.F90	(revision 5117)
@@ -110,5 +110,5 @@
 
     ! Sanity check on dimensions
-    if ((ip1jm/=((nbp_lon + 1) * (nbp_lat - 1))).or. &
+    IF ((ip1jm/=((nbp_lon + 1) * (nbp_lat - 1))).OR. &
             (ip1jmp1/=((nbp_lon + 1) * nbp_lat))) THEN
       abort_message = "ini_slab_transp_geom Error: wrong array sizes"
@@ -474,5 +474,5 @@
     IMPLICIT NONE
 
-    LOGICAL, INTENT(in) :: slab_gm
+    LOGICAL, INTENT(IN) :: slab_gm
     ! Here, temperature and flux variables are on 2 layers
     INTEGER ij
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/stdlevvar_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/stdlevvar_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/stdlevvar_mod.F90	(revision 5117)
@@ -58,13 +58,13 @@
 ! ustar--output-R- u*
 
-      INTEGER, intent(in) :: klon, knon, nsrf
-      LOGICAL, intent(in) :: zxli
-      REAL, dimension(klon), intent(in) :: u1, v1, t1, q1, z1, ts1
-      REAL, dimension(klon), intent(in) :: qsurf
-      REAL, dimension(klon), intent(inout) :: z0m, z0h
-      REAL, dimension(klon), intent(in) :: psol, pat1
-
-      REAL, dimension(klon), intent(out) :: t_2m, q_2m, ustar
-      REAL, dimension(klon), intent(out) :: u_10m, t_10m, q_10m
+      INTEGER, INTENT(IN) :: klon, knon, nsrf
+      LOGICAL, INTENT(IN) :: zxli
+      REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, t1, q1, z1, ts1
+      REAL, DIMENSION(klon), INTENT(IN) :: qsurf
+      REAL, DIMENSION(klon), INTENT(INOUT) :: z0m, z0h
+      REAL, DIMENSION(klon), INTENT(IN) :: psol, pat1
+
+      REAL, DIMENSION(klon), INTENT(OUT) :: t_2m, q_2m, ustar
+      REAL, DIMENSION(klon), INTENT(OUT) :: u_10m, t_10m, q_10m
       REAL, DIMENSION(klon), INTENT(INOUT) :: s_pblh
       REAL, DIMENSION(klon), INTENT(IN) :: prain
@@ -87,26 +87,26 @@
       INTEGER :: i, n
       REAL :: zref
-      REAL, dimension(klon) :: speed
+      REAL, DIMENSION(klon) :: speed
 ! tpot : temperature potentielle
-      REAL, dimension(klon) :: tpot
-      REAL, dimension(klon) :: zri1, cdran
-      REAL, dimension(klon) :: cdram, cdrah
+      REAL, DIMENSION(klon) :: tpot
+      REAL, DIMENSION(klon) :: zri1, cdran
+      REAL, DIMENSION(klon) :: cdram, cdrah
 ! ri1 : nb. de Richardson entre la surface --> la 1ere couche
-      REAL, dimension(klon) :: ri1 
-      REAL, dimension(klon) :: testar, qstar
-      REAL, dimension(klon) :: zdte, zdq   
+      REAL, DIMENSION(klon) :: ri1
+      REAL, DIMENSION(klon) :: testar, qstar
+      REAL, DIMENSION(klon) :: zdte, zdq
 ! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney 
-      DOUBLE PRECISION, dimension(klon) :: lmon
+      DOUBLE PRECISION, DIMENSION(klon) :: lmon
       DOUBLE PRECISION, parameter :: eps=1.0D-20
-      REAL, dimension(klon) :: delu, delte, delq
-      REAL, dimension(klon) :: u_zref, te_zref, q_zref  
-      REAL, dimension(klon) :: temp, pref
+      REAL, DIMENSION(klon) :: delu, delte, delq
+      REAL, DIMENSION(klon) :: u_zref, te_zref, q_zref
+      REAL, DIMENSION(klon) :: temp, pref
       LOGICAL :: okri
-      REAL, dimension(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
+      REAL, DIMENSION(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
 !convertgence
-      REAL, dimension(klon) :: te_zref_con, q_zref_con
-      REAL, dimension(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
-      REAL, dimension(klon) :: ok_pred, ok_corr, zri_zero
-!     REAL, dimension(klon) :: conv_te, conv_q
+      REAL, DIMENSION(klon) :: te_zref_con, q_zref_con
+      REAL, DIMENSION(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
+      REAL, DIMENSION(klon) :: ok_pred, ok_corr, zri_zero
+!     REAL, DIMENSION(klon) :: conv_te, conv_q
 !------------------------------------------------------------------------- 
       DO i=1, knon
@@ -359,21 +359,21 @@
 ! q_10m--output-R- humidite specifique a 10m
 
-      INTEGER, intent(in) :: klon, knon, nsrf
-      LOGICAL, intent(in) :: zxli
-      REAL, dimension(klon), intent(in) :: u1, v1, t1, q1, ts1, z1
-      REAL, dimension(klon), intent(inout) :: z0m, z0h
-      REAL, dimension(klon), intent(in) :: qsurf
-      REAL, dimension(klon), intent(in) :: psol, pat1
-
-      REAL, dimension(klon), intent(out) :: t_2m, q_2m, ustar
-      REAL, dimension(klon), intent(out) :: u_10m, t_10m, q_10m
-      INTEGER, dimension(klon, 6), intent(out) :: n2mout
-
-      REAL, dimension(klon) :: u_2m
-      REAL, dimension(klon) :: cdrm2m, cdrh2m, ri2m
-      REAL, dimension(klon) :: cdram, cdrah, zri1
-      REAL, dimension(klon) :: cdmn1, cdhn1, fm1, fh1
-      REAL, dimension(klon) :: cdmn2m, cdhn2m, fm2m, fh2m
-      REAL, dimension(klon) :: ri2m_new
+      INTEGER, INTENT(IN) :: klon, knon, nsrf
+      LOGICAL, INTENT(IN) :: zxli
+      REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, t1, q1, ts1, z1
+      REAL, DIMENSION(klon), INTENT(INOUT) :: z0m, z0h
+      REAL, DIMENSION(klon), INTENT(IN) :: qsurf
+      REAL, DIMENSION(klon), INTENT(IN) :: psol, pat1
+
+      REAL, DIMENSION(klon), INTENT(OUT) :: t_2m, q_2m, ustar
+      REAL, DIMENSION(klon), INTENT(OUT) :: u_10m, t_10m, q_10m
+      INTEGER, DIMENSION(klon, 6), INTENT(OUT) :: n2mout
+
+      REAL, DIMENSION(klon) :: u_2m
+      REAL, DIMENSION(klon) :: cdrm2m, cdrh2m, ri2m
+      REAL, DIMENSION(klon) :: cdram, cdrah, zri1
+      REAL, DIMENSION(klon) :: cdmn1, cdhn1, fm1, fh1
+      REAL, DIMENSION(klon) :: cdmn2m, cdhn2m, fm2m, fh2m
+      REAL, DIMENSION(klon) :: ri2m_new
       REAL, DIMENSION(klon) :: s_pblh
       REAL, DIMENSION(klon) :: prain
@@ -398,38 +398,38 @@
       INTEGER :: i, n
       REAL :: zref
-      REAL, dimension(klon) :: speed
+      REAL, DIMENSION(klon) :: speed
 ! tpot : temperature potentielle
-      REAL, dimension(klon) :: tpot
-      REAL, dimension(klon) :: cdran
+      REAL, DIMENSION(klon) :: tpot
+      REAL, DIMENSION(klon) :: cdran
 ! ri1 : nb. de Richardson entre la surface --> la 1ere couche
-      REAL, dimension(klon) :: ri1 
+      REAL, DIMENSION(klon) :: ri1
       DOUBLE PRECISION, parameter :: eps=1.0D-20
-      REAL, dimension(klon) :: delu, delte, delq
-      REAL, dimension(klon) :: delh, delm
-      REAL, dimension(klon) :: delh_new, delm_new
-      REAL, dimension(klon) :: u_zref, te_zref, q_zref  
-      REAL, dimension(klon) :: u_zref_pnew, te_zref_pnew, q_zref_pnew
-      REAL, dimension(klon) :: temp, pref
-      REAL, dimension(klon) :: temp_new, pref_new
+      REAL, DIMENSION(klon) :: delu, delte, delq
+      REAL, DIMENSION(klon) :: delh, delm
+      REAL, DIMENSION(klon) :: delh_new, delm_new
+      REAL, DIMENSION(klon) :: u_zref, te_zref, q_zref
+      REAL, DIMENSION(klon) :: u_zref_pnew, te_zref_pnew, q_zref_pnew
+      REAL, DIMENSION(klon) :: temp, pref
+      REAL, DIMENSION(klon) :: temp_new, pref_new
       LOGICAL :: okri
-      REAL, dimension(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
-      REAL, dimension(klon) :: u_zref_p_new, te_zref_p_new, temp_p_new, q_zref_p_new
+      REAL, DIMENSION(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
+      REAL, DIMENSION(klon) :: u_zref_p_new, te_zref_p_new, temp_p_new, q_zref_p_new
 !convergence
-      REAL, dimension(klon) :: te_zref_con, q_zref_con
-      REAL, dimension(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
-      REAL, dimension(klon) :: ok_pred, ok_corr
-
-      REAL, dimension(klon) :: cdrm10m, cdrh10m, ri10m
-      REAL, dimension(klon) :: cdmn10m, cdhn10m, fm10m, fh10m
-      REAL, dimension(klon) :: cdn2m, cdn1, zri_zero
+      REAL, DIMENSION(klon) :: te_zref_con, q_zref_con
+      REAL, DIMENSION(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
+      REAL, DIMENSION(klon) :: ok_pred, ok_corr
+
+      REAL, DIMENSION(klon) :: cdrm10m, cdrh10m, ri10m
+      REAL, DIMENSION(klon) :: cdmn10m, cdhn10m, fm10m, fh10m
+      REAL, DIMENSION(klon) :: cdn2m, cdn1, zri_zero
       REAL :: CEPDUE,zdu2 
       INTEGER :: nzref, nz1
-      LOGICAL, dimension(klon) :: ok_t2m_toosmall, ok_t2m_toobig
-      LOGICAL, dimension(klon) :: ok_q2m_toosmall, ok_q2m_toobig
-      LOGICAL, dimension(klon) :: ok_u2m_toobig
-      LOGICAL, dimension(klon) :: ok_t10m_toosmall, ok_t10m_toobig
-      LOGICAL, dimension(klon) :: ok_q10m_toosmall, ok_q10m_toobig
-      LOGICAL, dimension(klon) :: ok_u10m_toobig
-      INTEGER, dimension(klon, 6) :: n10mout
+      LOGICAL, DIMENSION(klon) :: ok_t2m_toosmall, ok_t2m_toobig
+      LOGICAL, DIMENSION(klon) :: ok_q2m_toosmall, ok_q2m_toobig
+      LOGICAL, DIMENSION(klon) :: ok_u2m_toobig
+      LOGICAL, DIMENSION(klon) :: ok_t10m_toosmall, ok_t10m_toobig
+      LOGICAL, DIMENSION(klon) :: ok_q10m_toosmall, ok_q10m_toobig
+      LOGICAL, DIMENSION(klon) :: ok_u10m_toobig
+      INTEGER, DIMENSION(klon, 6) :: n10mout
 
 !------------------------------------------------------------------------- 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/stratosphere_mask.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/stratosphere_mask.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/stratosphere_mask.F90	(revision 5117)
@@ -115,11 +115,11 @@
 include "YOMCST.h"
 
-integer,intent(in)              :: level
-real,intent(in)                 :: missing_val
-real,intent(in),dimension(level):: t, p
-real,intent(in)                 :: plimu, pliml, gamma, ps, zs
-real,intent(out)                :: ptrp, ttrp, ztrp
-
-real,parameter                  :: deltaz = 2000.0
+INTEGER,INTENT(IN)              :: level
+REAL,INTENT(IN)                 :: missing_val
+REAL,INTENT(IN),DIMENSION(level):: t, p
+REAL,INTENT(IN)                 :: plimu, pliml, gamma, ps, zs
+REAL,INTENT(OUT)                :: ptrp, ttrp, ztrp
+
+REAL,parameter                  :: deltaz = 2000.0
 
 real     :: faktor
@@ -129,5 +129,5 @@
 real     :: p2km, asum, aquer
 real     :: pmk2, pm2, a2, b2, tm2, dtdp2, dtdz2
-integer  :: icount, jj, j
+INTEGER  :: icount, jj, j
 
 ptrp=missing_val
@@ -149,8 +149,8 @@
 
    ! dt/dz valid?
-   if (j==level)     go to 999                 ! no, start level, initialize first
-   if (dtdz<=gamma)  go to 999                 ! no, dt/dz < -2 K/km
-   if (dtdz0>gamma) go to 999                 ! no, dt/dz below > -2 K/km
-   if (pm>plimu)    go to 999                 ! no, pm too low
+   IF (j==level)     go to 999                 ! no, start level, initialize first
+   IF (dtdz<=gamma)  go to 999                 ! no, dt/dz < -2 K/km
+   IF (dtdz0>gamma) go to 999                 ! no, dt/dz below > -2 K/km
+   IF (pm>plimu)    go to 999                 ! no, pm too low
 
    ! dtdz is valid, calculate tropopause pressure ptph
@@ -165,6 +165,6 @@
    ttph = ttph + (bg * log(ptph) + ag * (ptph**rkappa)/rkappa) / faktor*t(j)
 
-   if (ptph<pliml) go to 999
-   if (ptph>plimu) go to 999
+   IF (ptph<pliml) go to 999
+   IF (ptph>plimu) go to 999
 
    ! 2nd test: dtdz above 2 km must not exceed gamma
@@ -192,5 +192,5 @@
    
        ! discard ptropo ?
-        if (aquer<=gamma) go to 999           ! dt/dz above < gamma
+        IF (aquer<=gamma) go to 999           ! dt/dz above < gamma
 
 110 continue 
@@ -206,5 +206,5 @@
 
 jj = LEVEL                                       ! bottom
-DO while ((P(jj)>PS) .or. (T(jj)<100))     ! T must be valid too
+DO while ((P(jj)>PS) .OR. (T(jj)<100))     ! T must be valid too
   jj=jj-1
 END DO
@@ -214,5 +214,5 @@
 TDLNP = TM*DLNP
 
-DO while ( (JJ>=2) .and. (PTRP<P(jj-1)) )
+DO while ( (JJ>=2) .AND. (PTRP<P(jj-1)) )
   DLNP = log(P(jj)/P(jj-1))
   TM = 0.5 * (T(jj) + T(jj-1))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_bucket_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_bucket_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_bucket_mod.F90	(revision 5117)
@@ -35,5 +35,5 @@
     USE indice_sol_mod
 #ifdef ISO
-    use infotrac_phy, ONLY: ntiso,niso
+    USE infotrac_phy, ONLY: ntiso,niso
     USE isotopes_mod, ONLY: iso_eau, iso_HDO, iso_O18, iso_O17, &
         ridicule_qsol
@@ -162,5 +162,5 @@
 ! calculate constants
     CALL calbeta(dtime, is_ter, knon, snow, qsol, beta, capsol, dif_grnd)
-    if (type_veget=='betaclim') THEN
+    IF (type_veget=='betaclim') THEN
        CALL calbeta_clim(knon,jour,latitude(knindex(1:knon)),beta)
     endif
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_mod.F90	(revision 5117)
@@ -66,8 +66,8 @@
     USE indice_sol_mod
 #ifdef ISO
-    use infotrac_phy, ONLY: ntiso,niso
-    use isotopes_mod, ONLY: nudge_qsol, iso_eau
-#ifdef ISOVERIF
-    use isotopes_verif_mod
+    USE infotrac_phy, ONLY: ntiso,niso
+    USE isotopes_mod, ONLY: nudge_qsol, iso_eau
+#ifdef ISOVERIF
+    USE isotopes_verif_mod
 #endif
 #endif
@@ -160,8 +160,8 @@
 
 #ifdef ISO       
-      real, parameter :: t_coup = 273.15
-      real, dimension(klon) :: fqfonte_diag
-      real, dimension(klon) :: snow_evap_diag 
-      real, dimension(klon) :: fqcalving_diag 
+      REAL, parameter :: t_coup = 273.15
+      REAL, DIMENSION(klon) :: fqfonte_diag
+      REAL, DIMENSION(klon) :: snow_evap_diag
+      REAL, DIMENSION(klon) :: fqcalving_diag
       INTEGER :: ixt
 #endif 
@@ -179,5 +179,5 @@
 !        WRITE(*,*) 'surf_land_mod 162'
         do i=1,knon
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(precip_snow(i), &
             xtprecip_snow(iso_eau,i),'surf_land_mod 129', &
@@ -252,5 +252,5 @@
      WRITE(*,*) 'surf_land 193: apres surf_land_orchidee'
      do i=1,knon
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), &
               'surf_land 197',errmax,errmaxrel)
@@ -280,5 +280,5 @@
 
 #ifdef ISO
-        if (nudge_qsol.eq.1) THEN
+        IF (nudge_qsol.EQ.1) THEN
           CALL surf_land_nudge_qsol(knon,rlat,rlon,qsol,xtsol,knindex)
         endif
@@ -397,7 +397,7 @@
 
     DO i=1,knon
-      IF ((rlat(knindex(i)) >= lat_min_nudge_qsol).and. &
-         (rlat(knindex(i)) <= lat_max_nudge_qsol).and. &
-         (rlon(knindex(i)) >= lon_min_nudge_qsol).and. &
+      IF ((rlat(knindex(i)) >= lat_min_nudge_qsol).AND. &
+         (rlat(knindex(i)) <= lat_max_nudge_qsol).AND. &
+         (rlon(knindex(i)) >= lon_min_nudge_qsol).AND. &
          (rlon(knindex(i)) <= lon_max_nudge_qsol)) THEN
 !        WRITE(*,*) 'surf_land 324: bon domaine: rlat,rlon,qsol=', &
@@ -408,9 +408,9 @@
         ELSE IF (region_nudge_qsol == 2) THEN      
            qsol_new=max(qsol(i),120.0)
-        ELSE !if (region_nudge_qsol.eq.1) THEN
+        ELSE !if (region_nudge_qsol.EQ.1) THEN
            WRITE(*,*) 'surf_land 317: cas pas prevu'
            WRITE(*,*) 'region_nudge_qsol=',region_nudge_qsol
            STOP
-        ENDIF !if (region_nudge_qsol.eq.1) THEN
+        ENDIF !if (region_nudge_qsol.EQ.1) THEN
         IF (qsol(i) > 0.0) THEN
            DO ixt=1,niso
@@ -424,5 +424,5 @@
         qsol(i)=qsol_new
         WRITE(*,*) 'surf_land 346: qsol_new=',qsol(i)      
-     ENDIF ! if ((rlat(i).ge.lat_min_nudge_qsol).and.
+     ENDIF ! if ((rlat(i).ge.lat_min_nudge_qsol).AND.
   ENDDO !DO i=1,knon
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_mod.F90	(revision 5117)
@@ -29,5 +29,5 @@
   USE lmdz_phys_para, mpi_root_rank => mpi_master
   USE carbon_cycle_mod, ONLY: nbcf_in_orc, nbcf_out, fields_in, yfields_in, yfields_out, cfname_in, cfname_out
-  USE nrtype, ONLY: PI
+  USE lmdz_physical_constants, ONLY: PI
 
   IMPLICIT NONE
@@ -162,5 +162,5 @@
 
     ! type de couplage dans sechiba
-    !  character (len=10)   :: coupling = 'implicit'
+    !  CHARACTER (LEN=10)   :: coupling = 'implicit'
     ! drapeaux controlant les appels dans SECHIBA
     !  type(control_type), save   :: control_in
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_nofrein_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_nofrein_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_nofrein_mod.F90	(revision 5117)
@@ -161,5 +161,5 @@
 
 ! type de couplage dans sechiba
-!  character (len=10)   :: coupling = 'implicit' 
+!  CHARACTER (LEN=10)   :: coupling = 'implicit'
 ! drapeaux controlant les appels dans SECHIBA
 !  type(control_type), save   :: control_in
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_nolic_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_nolic_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_nolic_mod.F90	(revision 5117)
@@ -25,5 +25,5 @@
   USE lmdz_phys_para, mpi_root_rank=>mpi_master
   USE carbon_cycle_mod, ONLY: nbcf_in_orc, nbcf_out, fields_in, yfields_in, yfields_out, cfname_in, cfname_out
-  USE nrtype, ONLY: PI
+  USE lmdz_physical_constants, ONLY: PI
   
   IMPLICIT NONE
@@ -155,5 +155,5 @@
 
 ! type de couplage dans sechiba
-!  character (len=10)   :: coupling = 'implicit' 
+!  CHARACTER (LEN=10)   :: coupling = 'implicit'
 ! drapeaux controlant les appels dans SECHIBA
 !  type(control_type), save   :: control_in
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_noopenmp_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_noopenmp_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_noopenmp_mod.F90	(revision 5117)
@@ -158,5 +158,5 @@
 
 ! type de couplage dans sechiba
-!  character (len=10)   :: coupling = 'implicit' 
+!  CHARACTER (LEN=10)   :: coupling = 'implicit'
 ! drapeaux controlant les appels dans SECHIBA
 !  type(control_type), save   :: control_in
@@ -410,5 +410,5 @@
 !    ktindex(:)=ktindex(:)+MOD(offset,nbp_lon)
 !    offset=offset-MOD(offset,nbp_lon)
-!  endif
+!  ENDIF
   
     IF (debut) THEN
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_nounstruct_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_nounstruct_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_nounstruct_mod.F90	(revision 5117)
@@ -156,5 +156,5 @@
 
 ! type de couplage dans sechiba
-!  character (len=10)   :: coupling = 'implicit' 
+!  CHARACTER (LEN=10)   :: coupling = 'implicit'
 ! drapeaux controlant les appels dans SECHIBA
 !  type(control_type), save   :: control_in
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_noz0h_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_noz0h_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_noz0h_mod.F90	(revision 5117)
@@ -158,5 +158,5 @@
 
 ! type de couplage dans sechiba
-!  character (len=10)   :: coupling = 'implicit' 
+!  CHARACTER (LEN=10)   :: coupling = 'implicit'
 ! drapeaux controlant les appels dans SECHIBA
 !  type(control_type), save   :: control_in
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/surf_landice_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/surf_landice_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/surf_landice_mod.F90	(revision 5117)
@@ -66,6 +66,6 @@
     !****************************************************************************************
     INTEGER, INTENT(IN) :: itime, knon
-    INTEGER, DIMENSION(klon), INTENT(in) :: knindex
-    REAL, INTENT(in) :: dtime
+    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
+    REAL, INTENT(IN) :: dtime
     REAL, DIMENSION(klon), INTENT(IN) :: swnet ! net shortwave radiance
     REAL, DIMENSION(klon), INTENT(IN) :: lwnet ! net longwave radiance
@@ -135,5 +135,5 @@
 #ifdef ISO
     REAL, DIMENSION(ntiso,klon), INTENT(OUT)     :: xtevap     
-!    real, DIMENSION(niso,klon) :: xtrun_off_lic_0_diag ! est une variable globale de
+!    REAL, DIMENSION(niso,klon) :: xtrun_off_lic_0_diag ! est une variable globale de
 !    fonte_neige
 #endif
@@ -163,5 +163,5 @@
     REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec
     REAL, DIMENSION(klon) :: snow_prec,qsol_prec
-!    real, DIMENSION(klon) :: run_off_lic_0_diag
+!    REAL, DIMENSION(klon) :: run_off_lic_0_diag
 #endif
 
@@ -433,5 +433,5 @@
       !****************************************************************************************
 
-      if (z0m_landice > 0.) THEN
+      IF (z0m_landice > 0.) THEN
         z0m(1:knon) = z0m_landice
         z0h(1:knon) = z0h_landice
@@ -449,9 +449,9 @@
         coefd = log(z03) - coefc * ta3
         do j = 1, knon
-          if (temp_air(j) < ta1) THEN
+          IF (temp_air(j) < ta1) THEN
             z0m(j) = z01
-          else if (temp_air(j)>=ta1 .and. temp_air(j)<ta2) THEN
+          ELSE IF (temp_air(j)>=ta1 .AND. temp_air(j)<ta2) THEN
             z0m(j) = exp(coefa * temp_air(j) + coefb)
-          else if (temp_air(j)>=ta2 .and. temp_air(j)<ta3) THEN
+          ELSE IF (temp_air(j)>=ta2 .AND. temp_air(j)<ta3) THEN
             ! if st > 0, melting induce smooth surface
             z0m(j) = exp(coefc * temp_air(j) + coefd)
@@ -473,5 +473,5 @@
       ! this layer
 
-      if (ok_bs) THEN
+      IF (ok_bs) THEN
         fluxbs(:) = 0.
         do j = 1, knon
@@ -484,5 +484,5 @@
         ! 1st step: erosion of fresh snow accumulated during the time step
         do j = 1, knon
-          if (precip_snow(j) > 0.) THEN
+          IF (precip_snow(j) > 0.) THEN
             rhos(j) = rhofresh_bs
             ! blowing snow flux formula used in MAR
@@ -507,5 +507,5 @@
             fluxbs_1(j) = max(-maxerosion, fluxbs_1(j))
 
-            if (precip_snow(j) > abs(fluxbs_1(j))) THEN
+            IF (precip_snow(j) > abs(fluxbs_1(j))) THEN
               ok_remaining_freshsnow(j) = .TRUE.
               bsweight_fresh(j) = 1.
@@ -530,5 +530,5 @@
         ! which depends on surface snow density
         do j = 1, knon
-          if (ok_remaining_freshsnow(j)) THEN
+          IF (ok_remaining_freshsnow(j)) THEN
             fluxbs_2(j) = 0.
           else
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/surf_ocean_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/surf_ocean_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/surf_ocean_mod.F90	(revision 5117)
@@ -28,6 +28,6 @@
             )
 
-    use albedo, ONLY: alboc, alboc_cd
-    use bulk_flux_m, ONLY: bulk_flux
+    USE albedo, ONLY: alboc, alboc_cd
+    USE bulk_flux_m, ONLY: bulk_flux
     USE dimphy, ONLY: klon, zmasq
     USE surface_data, ONLY: type_ocean
@@ -96,32 +96,32 @@
 #endif
 
-    REAL, intent(inout) :: delta_sst(:) ! (knon)
+    REAL, INTENT(INOUT) :: delta_sst(:) ! (knon)
     ! Ocean-air interface temperature minus bulk SST, in K. Defined
     ! only if activate_ocean_skin >= 1.
 
-    real, intent(inout) :: delta_sal(:) ! (knon)
+    REAL, INTENT(INOUT) :: delta_sal(:) ! (knon)
     ! Ocean-air interface salinity minus bulk salinity, in ppt. Defined
     ! only if activate_ocean_skin >= 1.
 
-    REAL, intent(inout) :: ds_ns(:) ! (knon)
+    REAL, INTENT(INOUT) :: ds_ns(:) ! (knon)
     ! "delta salinity near surface". Salinity variation in the
     ! near-surface turbulent layer. That is subskin salinity minus
     ! foundation salinity. In ppt.
 
-    REAL, intent(inout) :: dt_ns(:) ! (knon)
+    REAL, INTENT(INOUT) :: dt_ns(:) ! (knon)
     ! "delta temperature near surface". Temperature variation in the
     ! near-surface turbulent layer. That is subskin temperature
     ! minus foundation temperature. (Can be negative.) In K.
 
-    REAL, intent(inout) :: dter(:) ! (knon)
+    REAL, INTENT(INOUT) :: dter(:) ! (knon)
     ! Temperature variation in the diffusive microlayer, that is
     ! ocean-air interface temperature minus subskin temperature. In
     ! K.
 
-    REAL, intent(inout) :: dser(:) ! (knon)
+    REAL, INTENT(INOUT) :: dser(:) ! (knon)
     ! Salinity variation in the diffusive microlayer, that is
     ! ocean-air interface salinity minus subskin salinity. In ppt.
 
-    real, intent(inout) :: dt_ds(:) ! (knon)
+    REAL, INTENT(INOUT) :: dt_ds(:) ! (knon)
     ! (tks / tkt) * dTer, in K
 
@@ -141,15 +141,15 @@
     REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
 
-    REAL, intent(out) :: tkt(:) ! (knon)
+    REAL, INTENT(OUT) :: tkt(:) ! (knon)
     ! épaisseur (m) de la couche de diffusion thermique (microlayer)
     ! cool skin thickness
 
-    REAL, intent(out) :: tks(:) ! (knon)
+    REAL, INTENT(OUT) :: tks(:) ! (knon)
     ! épaisseur (m) de la couche de diffusion de masse (microlayer)
 
-    REAL, intent(out) :: taur(:) ! (knon)
+    REAL, INTENT(OUT) :: taur(:) ! (knon)
     ! momentum flux due to rain, in Pa
 
-    real, intent(out) :: sss(:) ! (klon)
+    REAL, INTENT(OUT) :: sss(:) ! (klon)
     ! Bulk salinity of the surface layer of the ocean, in ppt. (Only
     ! defined for subscripts 1:knon, but we have to declare it with
@@ -157,6 +157,6 @@
 
 #ifdef ISO
-    REAL, DIMENSION(ntraciso,klon), INTENT(out) :: xtevap ! isotopes in surface evaporation flux 
-    REAL, DIMENSION(klon), INTENT(out)          :: h1 ! just a diagnostic, not useful for the simulation   
+    REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: xtevap ! isotopes in surface evaporation flux
+    REAL, DIMENSION(klon), INTENT(OUT)          :: h1 ! just a diagnostic, not useful for the simulation
 #endif
 
@@ -378,6 +378,6 @@
     ENDIF
 
-    if (activate_ocean_skin >= 1) THEN
-      if (type_ocean /= 'couple') sss(:knon) = 35.
+    IF (activate_ocean_skin >= 1) THEN
+      IF (type_ocean /= 'couple') sss(:knon) = 35.
       CALL bulk_flux(tkt, tks, taur, dter, dser, t_int, s_int, ds_ns, dt_ns, &
               u = windsp(:knon), t_ocean_1 = tsurf_new(:knon), s1 = sss(:knon), &
@@ -391,7 +391,7 @@
       delta_sal = s_int - sss(:knon)
 
-      if (activate_ocean_skin == 2) THEN
+      IF (activate_ocean_skin == 2) THEN
         tsurf_new(:knon) = t_int
-        if (type_ocean == 'couple') dt_ds = (tks / tkt) * dter
+        IF (type_ocean == 'couple') dt_ds = (tks / tkt) * dter
       end if
     end if
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/surf_seaice_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/surf_seaice_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/surf_seaice_mod.F90	(revision 5117)
@@ -116,5 +116,5 @@
 !albedo SB <<<
 
-    real rhoa(knon) ! density of moist air  (kg / m3)
+    REAL rhoa(knon) ! density of moist air  (kg / m3)
 
 ! End definitions
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/sw_aeroAR4.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/sw_aeroAR4.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/sw_aeroAR4.F90	(revision 5117)
@@ -98,5 +98,5 @@
   !* LOCAL VARIABLES:
 
-  real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
+  REAL, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
 
   REAL(KIND=8) ZOZ(KDLON,KFLEV)
@@ -252,5 +252,5 @@
 
 ! clear sky with no aerosols at all is computed IF ACTIVEFEEDBACK_ACTIVE is false or for extended diag
-     IF ( swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol == 0 ) THEN
+     IF ( swaero_diag .OR. .NOT. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol == 0 ) THEN
 
      ! clear-sky: zero aerosol effect
@@ -278,8 +278,8 @@
         ENDDO
      ENDDO
-     ENDIF ! swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE
+     ENDIF ! swaero_diag .OR. .NOT. AEROSOLFEEDBACK_ACTIVE
 
 ! cloudy sky with no aerosols at all is either computed IF no indirect effect is asked for, or for extended diag
-     IF ( swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol == 0 ) THEN
+     IF ( swaero_diag .OR. .NOT. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol == 0 ) THEN
      ! cloudy-sky: zero aerosol effect
      flag_aer=0.0
@@ -307,9 +307,9 @@
         ENDDO
      ENDDO
-     ENDIF ! swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE
+     ENDIF ! swaero_diag .OR. .NOT. AEROSOLFEEDBACK_ACTIVE
 
      IF (flag_aerosol>0 .OR. flag_aerosol_strat>0) THEN
 
-     IF (ok_ade.and.swaero_diag .or. .not. ok_ade) THEN
+     IF (ok_ade.AND.swaero_diag .OR. .NOT. ok_ade) THEN
 
         ! clear sky direct effect natural aerosol
@@ -401,5 +401,5 @@
      ENDIF !-end ok_ade
 
-     IF ( .not. ok_ade .or. .not. ok_aie ) THEN
+     IF ( .NOT. ok_ade .OR. .NOT. ok_aie ) THEN
 
         ! cloudy-sky with natural aerosols for indirect effect 
@@ -435,5 +435,5 @@
      ENDIF  !--true/false or false/true
 
-     IF (ok_ade .and. ok_aie) THEN
+     IF (ok_ade .AND. ok_aie) THEN
 
         ! cloudy-sky with total aerosols for indirect effect 
@@ -466,5 +466,5 @@
         ENDDO
   
-      ENDIF ! ok_ade .and. ok_aie
+      ENDIF ! ok_ade .AND. ok_aie
 
      IF (ok_aie) THEN
@@ -507,5 +507,5 @@
 
   IF  ( AEROSOLFEEDBACK_ACTIVE .AND. (flag_aerosol>0 .OR. flag_aerosol_strat>0) ) THEN
-  IF ( ok_ade .and. ok_aie  ) THEN
+  IF ( ok_ade .AND. ok_aie  ) THEN
     ZFSUP(:,:) =    ZFSUP_AERO(:,:,4)
     ZFSDN(:,:) =    ZFSDN_AERO(:,:,4)
@@ -514,5 +514,5 @@
   ENDIF
 
-  IF ( ok_ade .and. (.not. ok_aie) )  THEN
+  IF ( ok_ade .AND. (.NOT. ok_aie) )  THEN
     ZFSUP(:,:) =    ZFSUP_AERO(:,:,2)
     ZFSDN(:,:) =    ZFSDN_AERO(:,:,2)
@@ -521,5 +521,5 @@
   ENDIF
 
-  IF ( (.not. ok_ade) .and. ok_aie  )  THEN
+  IF ( (.NOT. ok_ade) .AND. ok_aie  )  THEN
     ZFSUP(:,:) =    ZFSUP_AERO(:,:,5)
     ZFSDN(:,:) =    ZFSDN_AERO(:,:,5)
@@ -528,5 +528,5 @@
   ENDIF
 
-  IF ((.not. ok_ade) .and. (.not. ok_aie)) THEN
+  IF ((.NOT. ok_ade) .AND. (.NOT. ok_aie)) THEN
     ZFSUP(:,:) =    ZFSUP_AERO(:,:,3)
     ZFSDN(:,:) =    ZFSDN_AERO(:,:,3)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/thermcell_old.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/thermcell_old.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/thermcell_old.h	(revision 5117)
@@ -1,4 +1,4 @@
 
-      real,parameter     :: r_aspect_thermals=2.
-      real,parameter     :: l_mix_thermals=30.
-      integer,parameter  :: w2di_thermals=0
+      REAL,parameter     :: r_aspect_thermals=2.
+      REAL,parameter     :: l_mix_thermals=30.
+      INTEGER,parameter  :: w2di_thermals=0
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/tracco2i_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/tracco2i_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/tracco2i_mod.F90	(revision 5117)
@@ -366,5 +366,5 @@
 
     INTEGER :: n_glo, n_month
-    REAL, allocatable :: vector(:), time(:)
+    REAL, ALLOCATABLE :: vector(:), time(:)
     REAL, ALLOCATABLE :: flx_co2ff_glo(:, :) !  fossil-fuel CO2
     REAL, ALLOCATABLE :: flx_co2bb_glo(:, :) !  biomass-burning CO2
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/tracinca_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/tracinca_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/tracinca_mod.F90	(revision 5117)
@@ -58,5 +58,5 @@
     USE dimphy
     USE infotrac_phy, ONLY: nbtr
-    USE vampir
+    USE lmdz_vampir
     USE indice_sol_mod
     USE lmdz_geometry, ONLY: cell_area
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/traclmdz_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/traclmdz_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/traclmdz_mod.F90	(revision 5117)
@@ -117,12 +117,12 @@
     LOGICAL :: zero
     ! RomP >>> profil initial Be7
-    integer ilesfil
+    INTEGER ilesfil
     parameter (ilesfil = 1)
-    integer  irr, kradio
+    INTEGER  irr, kradio
     real     beryllium(klon, klev)
     ! profil initial Pb210
-    integer ilesfil2
+    INTEGER ilesfil2
     parameter (ilesfil2 = 1)
-    integer  irr2, kradio2
+    INTEGER  irr2, kradio2
     real     plomb(klon, klev)
     !! RomP <<<
@@ -308,8 +308,9 @@
     USE dimphy
     USE infotrac_phy, ONLY: nbtr, pbl_flg
-    USE strings_mod, ONLY: int2str
+    USE lmdz_strings, ONLY: int2str
     USE regr_pr_comb_coefoz_m, ONLY: regr_pr_comb_coefoz
     USE o3_chem_m, ONLY: o3_chem
     USE indice_sol_mod
+    USE lmdz_q_sat, ONLY: q_sat
 
     INCLUDE "YOMCST.h"
@@ -334,5 +335,5 @@
     REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs   ! pression pour chaque inter-couche (en Pa)
     REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay   ! pression pour le mileu de chaque couche (en Pa)
-    REAL, intent(in) :: zmasse (:, :)   ! dim(klon,klev) density of air, in kg/m2
+    REAL, INTENT(IN) :: zmasse (:, :)   ! dim(klon,klev) density of air, in kg/m2
 
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/tsoilnudge.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/tsoilnudge.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/tsoilnudge.h	(revision 5117)
@@ -1,5 +1,5 @@
-      logical nudge_tsoil
-      integer isoil_nudge
-      real Tsoil_nudge, tau_soil_nudge
+      LOGICAL nudge_tsoil
+      INTEGER isoil_nudge
+      REAL Tsoil_nudge, tau_soil_nudge
 
       common /tsoilnudge/ nudge_tsoil, isoil_nudge, Tsoil_nudge,        &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/undefSTD.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/undefSTD.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/undefSTD.F90	(revision 5117)
@@ -6,5 +6,5 @@
   USE dimphy
   USE phys_state_var_mod
-  USE wxios, ONLY: missing_val_xios => missing_val, using_xios
+  USE lmdz_wxios, ONLY: missing_val_xios => missing_val, using_xios
 
   IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/vdif_kcay.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/vdif_kcay.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/vdif_kcay.F90	(revision 5117)
@@ -384,7 +384,7 @@
 
       ! abd
-      ! IF(ilev.le.57.and.ilev.ge.37) THEN
+      ! IF(ilev.le.57.AND.ilev.ge.37) THEN
       ! PRINT*,'L=',ilev,'   GN=',gn,'  SM=',sm(igrid,ilev)
-      ! endif
+      ! END IF
       ! --->
       ! la decomposition de Taylor en q2 n'a de sens que
@@ -533,5 +533,5 @@
       q2(igrid, ilev) = q2cstat
       m(igrid, ilev) = mcstat
-      ! abd       IF(ilev.le.57.and.ilev.ge.37) THEN
+      ! abd       IF(ilev.le.57.AND.ilev.ge.37) THEN
       ! PRINT*,'L=',ilev,'   M2=',m2(igrid,ilev),m2cstat,
       ! s     'N2=',n2(igrid,ilev)
@@ -561,7 +561,7 @@
       km(igrid, ilev) = long(igrid, ilev)*q(igrid, ilev)*sm(igrid, ilev)
       ! abd
-      ! IF(ilev.le.57.and.ilev.ge.37) THEN
+      ! IF(ilev.le.57.AND.ilev.ge.37) THEN
       ! PRINT*,'L=',ilev,'   GN=',gn,'  SM=',sm(igrid,ilev)
-      ! endif
+      ! END IF
 
       ! .......................................................................
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/write_bilKP_ave.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/write_bilKP_ave.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/write_bilKP_ave.h	(revision 5117)
@@ -149,5 +149,5 @@
 c
 C
-      if (ok_sync) THEN
+      IF (ok_sync) THEN
         CALL histsync(nid_bilKPave)
       endif
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/write_bilKP_ins.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/write_bilKP_ins.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/write_bilKP_ins.h	(revision 5117)
@@ -173,5 +173,5 @@
 cIM 280405 END
 C
-      if (ok_sync) THEN
+      IF (ok_sync) THEN
         CALL histsync(nid_bilKPins)
       endif
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/write_histREGDYN.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/write_histREGDYN.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/write_histREGDYN.h	(revision 5117)
@@ -2,6 +2,6 @@
 ! $Header$
 
-      if (ok_regdyn) THEN
-      if (is_sequential) THEN
+      IF (ok_regdyn) THEN
+      IF (is_sequential) THEN
       ndex3d = 0
       itau_w = itau_phy + itap + start_time * day_step / iphysiq
@@ -52,5 +52,5 @@
      &               kmaxm1*lmaxm1*iwmax,ndex3d)
 
-      if (ok_sync) THEN
+      IF (ok_sync) THEN
         CALL histsync(nid_regdyn)
       endif
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/write_histday_seri.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/write_histday_seri.h	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/write_histday_seri.h	(revision 5117)
@@ -157,5 +157,5 @@
 !=================================================================
 
-      if (ok_sync) THEN
+      IF (ok_sync) THEN
         CALL histsync(nid_day_seri)
       endif
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/wx_pbl_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/wx_pbl_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/wx_pbl_mod.F90	(revision 5117)
@@ -450,5 +450,5 @@
 
 !!!! DO j = 1,knon
-!!!!  IF (mod(j,20) .eq.0) THEN
+!!!!  IF (mod(j,20) .EQ.0) THEN
 !!!!   print *, '   j     dd_QQ       QQ_b  dd_HQphiQ  dd_HQphiT   dd_HQRn   HQphiQ_b   HQphiT_b     HQRn_b '
 !!!!  ENDIF
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/yamada4.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/yamada4.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/yamada4.F90	(revision 5117)
@@ -357,6 +357,6 @@
         ! else
         ! q2(ig,k)=(qpre/(1.-aa(ig,k)*qpre))**2
-        ! endif
-        ! endif
+        ! END IF
+        ! END IF
         q2(ig, k) = min(max(q2(ig, k), 1.E-10), 1.E4)
       END DO
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/yamada_c.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/yamada_c.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/yamada_c.F90	(revision 5117)
@@ -54,8 +54,8 @@
 
       REAL timestep
-      real plev(klon,klev+1)
-      real play(klon,klev)
-      real ustar(klon)
-      real kmin,qmin,pblhmin(klon),coriol(klon)
+      REAL plev(klon,klev+1)
+      REAL play(klon,klev)
+      REAL ustar(klon)
+      REAL kmin,qmin,pblhmin(klon),coriol(klon)
       REAL zlev(klon,klev+1)
       REAL zlay(klon,klev)
@@ -74,11 +74,11 @@
       REAL kn(klon,klev)
       REAL kq(klon,klev)
-      real ff(klon,klev+1),delta(klon,klev+1)
-      real aa(klon,klev+1),aa0,aa1
-      integer iflag_pbl,ngrid
-      integer nlay,nlev
-
-      logical first
-      integer ipas
+      REAL ff(klon,klev+1),delta(klon,klev+1)
+      REAL aa(klon,klev+1),aa0,aa1
+      INTEGER iflag_pbl,ngrid
+      INTEGER nlay,nlev
+
+      LOGICAL first
+      INTEGER ipas
       save first,ipas
 !FH/IM     data first,ipas/.TRUE.,0/
@@ -89,31 +89,31 @@
 
 
-      integer ig,k
-
-
-      real ri,zrif,zalpha,zsm,zsn
-      real rif(klon,klev+1),sm(klon,klev+1),alpha(klon,klev)
-
-      real m2(klon,klev+1),dz(klon,klev+1),zq,n2(klon,klev+1)
+      INTEGER ig,k
+
+
+      REAL ri,zrif,zalpha,zsm,zsn
+      REAL rif(klon,klev+1),sm(klon,klev+1),alpha(klon,klev)
+
+      REAL m2(klon,klev+1),dz(klon,klev+1),zq,n2(klon,klev+1)
       REAL, DIMENSION(klon,klev+1) :: km2,kn2,sqrtq
-      real dtetadz(klon,klev+1)
-      real m2cstat,mcstat,kmcstat
-      real l(klon,klev+1)
-      real leff(klon,klev+1)
-      real,allocatable,save :: l0(:)
+      REAL dtetadz(klon,klev+1)
+      REAL m2cstat,mcstat,kmcstat
+      REAL l(klon,klev+1)
+      REAL leff(klon,klev+1)
+      REAL,ALLOCATABLE,save :: l0(:)
 !$OMP THREADPRIVATE(l0)      
-      real sq(klon),sqz(klon),zz(klon,klev+1)
-      integer iter
-
-      real ric,rifc,b1,kap
+      REAL sq(klon),sqz(klon),zz(klon,klev+1)
+      INTEGER iter
+
+      REAL ric,rifc,b1,kap
       save ric,rifc,b1,kap
       data ric,rifc,b1,kap/0.195,0.191,16.6,0.4/
 !$OMP THREADPRIVATE(ric,rifc,b1,kap)
-      real frif,falpha,fsm
-      real fl,zzz,zl0,zq2,zn2
-
-      real rino(klon,klev+1),smyam(klon,klev),styam(klon,klev)
-      real lyam(klon,klev),knyam(klon,klev)
-      real w2yam(klon,klev),t2yam(klon,klev)
+      REAL frif,falpha,fsm
+      REAL fl,zzz,zl0,zq2,zn2
+
+      REAL rino(klon,klev+1),smyam(klon,klev),styam(klon,klev)
+      REAL lyam(klon,klev),knyam(klon,klev)
+      REAL w2yam(klon,klev),t2yam(klon,klev)
       logical,save :: firstcall=.TRUE.
 !$OMP THREADPRIVATE(firstcall)       
@@ -134,5 +134,5 @@
 
       okiophys=klon==1
-      if (firstcall) THEN
+      IF (firstcall) THEN
         CALL getin_p('iflag_tke_diff',iflag_tke_diff)
         allocate(l0(klon))
@@ -277,5 +277,5 @@
 !        n2(ig,k)=0.
          ri=n2(ig,k)/max(m2(ig,k),1.e-10)
-         if (ri<ric) THEN
+         IF (ri<ric) THEN
             rif(ig,k)=frif(ri)
          else
@@ -300,5 +300,5 @@
 
 !   Mise a jour de l0
-      if (iflag_pbl==8.or.iflag_pbl==10) THEN
+      IF (iflag_pbl==8.OR.iflag_pbl==10) THEN
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! Iterative computation of l0
@@ -438,5 +438,5 @@
 
 ! Computation of turbulent diffusivities
-!  IF (25<=iflag_pbl.and.iflag_pbl<=28) THEN
+!  IF (25<=iflag_pbl.AND.iflag_pbl<=28) THEN
 !    DO k=2,klev
 !       sqrtq(:,k)=sqrt(0.5*(q2(:,k)+q2(:,k-1)))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/yamada_ini_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/yamada_ini_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/yamada_ini_mod.F90	(revision 5117)
@@ -17,5 +17,5 @@
   !$OMP THREADPRIVATE(iflag_vdif_q2)
 
-  real, dimension(:), allocatable, save :: l0
+  REAL, DIMENSION(:), ALLOCATABLE, save :: l0
   !$OMP THREADPRIVATE(l0)
   INTEGER :: lunout,prt_level
@@ -30,7 +30,7 @@
 
 ! local
-  integer, intent(in) :: klon,lunout_in,prt_level_in
+  INTEGER, INTENT(IN) :: klon,lunout_in,prt_level_in
   REAL :: ric0
-  real frif,falpha,fsm,ri
+  REAL frif,falpha,fsm,ri
 
   lunout=lunout_in
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/add_phys_tend_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/add_phys_tend_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/add_phys_tend_mod.F90	(revision 5117)
@@ -180,5 +180,5 @@
 REAL zdxt(ntraciso,klon,klev),zdxtl(ntraciso,klon,klev) &
         ,zdxti(ntraciso,klon,klev)
-integer ixt
+INTEGER ixt
 #endif
 
@@ -188,5 +188,5 @@
 #ifdef ISO
 REAL zxt(ntraciso)
-real qprec(klon,klev)
+REAL qprec(klon,klev)
 REAL zxt_int(ntraciso), zxtp_int(ntraciso), zxtp(ntraciso,klev),zxt_new
 #endif
@@ -213,5 +213,5 @@
 LOGICAL done(klon)
 
-integer debug_level
+INTEGER debug_level
 logical, save :: first=.TRUE.
 !$OMP THREADPRIVATE(first)
@@ -268,5 +268,5 @@
 
      debug_level=10
-     if (first) THEN
+     IF (first) THEN
         print *,"TestJLD rcpv, rcw, rcs",rcpv, rcw, rcs
         first=.FALSE.
@@ -296,5 +296,5 @@
   END DO
 
-  if (fl_ebil > 0) THEN
+  IF (fl_ebil > 0) THEN
     ! ------------------------------------------------
     ! Compute vertical sum for each atmospheric column
@@ -319,5 +319,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
           CALL iso_verif_egalite_vect2D( &
                 xt_seri,q_seri, &
@@ -363,10 +363,10 @@
             qprec(i,k)=q_seri(i,k)
 #endif
-            IF ( zt>370. .or. zt<130. .or. abs(zdt(i,k))>50. ) THEN
+            IF ( zt>370. .OR. zt<130. .OR. abs(zdt(i,k))>50. ) THEN
             jbad = jbad + 1
             jadrs(jbad) = i
             kadrs(jbad) = k
             ENDIF
-            IF ( zq<0. .or. zq>0.1 .or. abs(zdq(i,k))>1.e-2 ) THEN
+            IF ( zq<0. .OR. zq>0.1 .OR. abs(zdq(i,k))>1.e-2 ) THEN
             jqbad = jqbad + 1
             jqadrs(jqbad) = i
@@ -385,5 +385,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
           CALL iso_verif_egalite_vect2D( &
                 xt_seri,q_seri, &
@@ -486,6 +486,6 @@
             DO k = 1, klev
               zq=q_seri(i,k)+zdq(i,k)
-              if (zq<1.e-15) THEN
-                 if (q_seri(i,k)<1.e-15) THEN
+              IF (zq<1.e-15) THEN
+                 IF (q_seri(i,k)<1.e-15) THEN
                   IF(prt_level>=debug_level) THEN
                    PRINT*,' cas q_seri<1.e-15 i k q_seri zq zdq :',i,k,q_seri(i,k),zq,zdq(i,k)
@@ -516,5 +516,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-     if (iso_eau.gt.0) THEN
+     IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite_vect2D( &
                 xt_seri,q_seri, &
@@ -536,5 +536,5 @@
       DO k = 1, klev
          DO i = 1, klon
-            IF ( t_seri(i,k)>370. .or. t_seri(i,k)<130. .or. abs(zdt(i,k))>50. ) THEN
+            IF ( t_seri(i,k)>370. .OR. t_seri(i,k)<130. .OR. abs(zdt(i,k))>50. ) THEN
             jbad = jbad + 1
             jadrs(jbad) = i
@@ -543,5 +543,5 @@
 !            endif
             ENDIF
-            IF ( q_seri(i,k)<0. .or. q_seri(i,k)>0.1 .or. abs(zdq(i,k))>1.e-2 ) THEN
+            IF ( q_seri(i,k)<0. .OR. q_seri(i,k)>0.1 .OR. abs(zdq(i,k))>1.e-2 ) THEN
             jqbad = jqbad + 1
             jqadrs(jqbad) = i
@@ -561,5 +561,5 @@
                  i,itap,longitude_deg(i),latitude_deg(i),text,jbad, &
                 zdt(i,k),t_seri(i,k)-zdt(i,k)
-!!!       IF(prt_level.ge.10.and.itap.GE.229.and.i.EQ.3027) THEN
+!!!       IF(prt_level.ge.10.AND.itap.GE.229.AND.i.EQ.3027) THEN
           PRINT*,'l    T     dT       Q     dQ    '
           DO k = 1, klev
@@ -579,5 +579,5 @@
                  i,itap,longitude_deg(i),latitude_deg(i),text,jqbad,&
                 zdq(i,k), q_seri(i,k)-zdq(i,k), zdql(i,k), ql_seri(i,k)-zdql(i,k)
-!!!       IF(prt_level.ge.10.and.itap.GE.229.and.i.EQ.3027) THEN
+!!!       IF(prt_level.ge.10.AND.itap.GE.229.AND.i.EQ.3027) THEN
           PRINT*,'l    T     dT       Q     dQ    '
           DO k = 1, klev
@@ -611,5 +611,5 @@
 !======================================================================
 
-  if (fl_ebil > 0) THEN
+  IF (fl_ebil > 0) THEN
     ! ------------------------------------------------
     ! Compute vertical sum for each atmospheric column
@@ -705,5 +705,5 @@
 INTEGER k, n
 
-integer debug_level
+INTEGER debug_level
 logical, save :: first=.TRUE.
 !$OMP THREADPRIVATE(first)
@@ -744,5 +744,5 @@
 
      debug_level=10
-     if (first) THEN
+     IF (first) THEN
         print *,"TestJLD rcpv, rcw, rcs",rcpv, rcw, rcs
         first=.FALSE.
@@ -758,5 +758,5 @@
   END DO
 
-  if (fl_ebil > 0) THEN
+  IF (fl_ebil > 0) THEN
     ! ------------------------------------------------
     ! Compute vertical sum for each atmospheric column
@@ -789,5 +789,5 @@
 !======================================================================
 
-  if (fl_ebil > 0) THEN
+  IF (fl_ebil > 0) THEN
     ! ------------------------------------------------
     ! Compute vertical sum for each atmospheric column
@@ -921,11 +921,11 @@
 !------------
 CHARACTER*(*) text ! text specifing the involved parametrization 
-integer itap        ! time step number
+INTEGER itap        ! time step number
 ! local variables
 ! ---------------
-real bilq_seuil,  bilh_seuil ! thresold on error in Q and H budget
-real bilq_error,  bilh_error ! erros in Q and H budget
-real bilq_bnd,  bilh_bnd     ! Q and H budget due to exchange with boundaries
-integer bilq_ok,  bilh_ok
+REAL bilq_seuil,  bilh_seuil ! thresold on error in Q and H budget
+REAL bilq_error,  bilh_error ! erros in Q and H budget
+REAL bilq_bnd,  bilh_bnd     ! Q and H budget due to exchange with boundaries
+INTEGER bilq_ok,  bilh_ok
 CHARACTER*(12) status
 
@@ -936,5 +936,5 @@
 
 !!print *,'prt_level:',prt_level,' fl_ebil:',fl_ebil,' fl_cor_ebil:',fl_cor_ebil
-IF ( (fl_ebil > 0) .and. (klon == 1)) THEN
+IF ( (fl_ebil > 0) .AND. (klon == 1)) THEN
   bilq_bnd = 0.
   bilh_bnd = 0.
@@ -967,10 +967,10 @@
   bilh_error = d_h_col(1) - bilh_bnd
 ! are the errors too large?
-  if ( abs(bilq_error) > bilq_seuil) bilq_ok=1
-  if ( abs(bilh_error) > bilh_seuil) bilh_ok=1
+  IF ( abs(bilq_error) > bilq_seuil) bilq_ok=1
+  IF ( abs(bilh_error) > bilh_seuil) bilh_ok=1
 
 ! Print diagnostics
 ! =================
-  if ( (bilq_ok == 0).and.(bilh_ok == 0) ) THEN
+  IF ( (bilq_ok == 0).AND.(bilh_ok == 0) ) THEN
     status="enerbil-OK"
   else
@@ -978,12 +978,12 @@
   end if
 
-  if ( prt_level >= 3) THEN
+  IF ( prt_level >= 3) THEN
     WRITE(*,9010) text,status," itap:",itap,"enerbilERROR: Q", bilq_error,"  H", bilh_error
 9010  format (1x,A8,2x,A12,A6,I4,A18,E15.6,A5,E15.6)
   end if
-  if ( prt_level >= 3) THEN
+  IF ( prt_level >= 3) THEN
     WRITE(*,9000) text,"enerbil: Q,H,KE budget", d_qt_col(1), d_h_col(1),d_ek_col(1)
   end if
-  if ( prt_level >= 5) THEN
+  IF ( prt_level >= 5) THEN
     WRITE(*,9000) text,"enerbil at boundaries: Q, H",bilq_bnd, bilh_bnd
     WRITE(*,9000) text,"enerbil: water budget",d_qt_col(1),d_qw_col(1),d_ql_col(1),d_qs_col(1), d_qbs_col(1)
@@ -993,15 +993,15 @@
   specific_diag: SELECT CASE (text)
   CASE("vdf") specific_diag
-    if ( prt_level >= 5) THEN
+    IF ( prt_level >= 5) THEN
       WRITE(*,9000) text,"enerbil: d_h, bilh, sens,t_seri", d_h_col(1), bilh_bnd, sens(1), t_seri(1,1)
       WRITE(*,9000) text,"enerbil: d_h_col_vdf, f_h, diff",d_h_col_vdf, f_h_bnd, bilh_bnd-sens(1)
     end if
   CASE("lsc") specific_diag
-    if ( prt_level >= 5) THEN
+    IF ( prt_level >= 5) THEN
       WRITE(*,9000) text,"enerbil: rain, bil_lat, bil_sens", rain_lsc(1), rlvtt * rain_lsc(1), -(rcw-rcpd)*t_seri(1,1) * rain_lsc(1)
       WRITE(*,9000) text,"enerbil: snow, bil_lat, bil_sens", snow_lsc(1), rlstt * snow_lsc(1), -(rcs-rcpd)*t_seri(1,1) * snow_lsc(1)
     end if
   CASE("convection") specific_diag
-    if ( prt_level >= 5) THEN
+    IF ( prt_level >= 5) THEN
       WRITE(*,9000) text,"enerbil: rain, bil_lat, bil_sens", rain_con(1), rlvtt * rain_con(1), -(rcw-rcpd)*t_seri(1,1) * rain_con(1)
       WRITE(*,9000) text,"enerbil: snow, bil_lat, bil_sens", snow_con(1), rlstt * snow_con(1), -(rcs-rcpd)*t_seri(1,1) * snow_con(1)
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/ajsec.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/ajsec.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/ajsec.F90	(revision 5117)
@@ -49,9 +49,9 @@
   INTEGER i, k, k1, k2
 #ifdef ISO
-      real xt(ntraciso,klon,klev)
-      real d_xt(ntraciso,klon,klev)
-      real zxt(ntraciso,klon,klev)
-      real xtm(ntraciso)
-      integer ixt
+      REAL xt(ntraciso,klon,klev)
+      REAL d_xt(ntraciso,klon,klev)
+      REAL zxt(ntraciso,klon,klev)
+      REAL xtm(ntraciso)
+      INTEGER ixt
 #endif
 
@@ -63,5 +63,5 @@
       do i=1,klon
          do k=1,klev         
-           if (iso_eau.gt.0) THEN
+           IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(q(i,k),xt(iso_eau,i,k), &
                  'ajsec 67',errmax,errmaxrel)
@@ -136,5 +136,5 @@
         enddo    
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(qm,xtm(iso_eau), &
                  'ajsec 126',errmax,errmaxrel)
@@ -152,5 +152,5 @@
         enddo    
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(qm,xtm(iso_eau), &
                  'ajsec 136',errmax,errmaxrel)
@@ -198,5 +198,5 @@
              CALL iso_verif_noNaN(zxt(ixt,i,k),'ajsec 173')
            enddo !do ixt=1,niso           
-           if (iso_eau.gt.0) THEN
+           IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(zq(i,k),zxt(iso_eau,i,k), &
                  'ajsec 168',errmax,errmaxrel)
@@ -228,5 +228,5 @@
       do i = 1, klon
         do k = 1, limhau
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
           CALL iso_verif_egalite_choix(d_q(i,k),d_xt(iso_eau,i,k), &
                 'ajsec 198',errmax,errmaxrel)
@@ -280,5 +280,5 @@
       do i = 1, klon
         do k = 1, klev
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
           CALL iso_verif_egalite(d_q(i,k),d_xt(iso_eau,i,k),'ajsec 270')
          endif
@@ -345,9 +345,9 @@
 
 #ifdef ISO
-      real xt(ntraciso,klon,klev)
-      real d_xt(ntraciso,klon,klev)
-      real zxt(ntraciso,klon,klev)
-      real xtm(ntraciso)
-      integer ixt
+      REAL xt(ntraciso,klon,klev)
+      REAL d_xt(ntraciso,klon,klev)
+      REAL zxt(ntraciso,klon,klev)
+      REAL xtm(ntraciso)
+      INTEGER ixt
 #endif
 
@@ -361,5 +361,5 @@
              CALL iso_verif_noNAN(xt(ixt,i,k),'ajsec 320')
            enddo !do ixt=1,niso           
-           if (iso_eau.gt.0) THEN
+           IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(q(i,k),xt(iso_eau,i,k), &
                  'ajsec 324',errmax,errmaxrel)
@@ -490,5 +490,5 @@
              CALL iso_verif_noNAN(zxt(ixt,i,k),'ajsec 428')
            enddo !do ixt=1,niso           
-           if (iso_eau.gt.0) THEN
+           IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(zq(i,k),zxt(iso_eau,i,k), &
                  'ajsec 432',errmax,errmaxrel)
@@ -563,5 +563,5 @@
       do i = 1, klon
         do k = limbas, limhau
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
           CALL iso_verif_egalite(d_q(i,k),d_xt(iso_eau,i,k),'ajsec 270')
          endif
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/calwake.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/calwake.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/calwake.F90	(revision 5117)
@@ -261,5 +261,5 @@
   DO l = 1, klev
     DO i = 1, klon
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite(qe(i,l),xte(iso_eau,i,l),'calwake 261a')
         CALL iso_verif_egalite(dqa(i,l),dxta(iso_eau,i,l),'calwake 261b')
@@ -291,5 +291,5 @@
   DO l = 1, klev
     DO i = 1, klon
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite(dqls(i,l),dxtls(iso_eau,i,l),'calwake 290a')
         CALL iso_verif_egalite(qx(i,l),xtx(iso_eau,i,l),'calwake 290b')
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/climb_hq_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/climb_hq_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/climb_hq_mod.F90	(revision 5117)
@@ -119,9 +119,9 @@
 
 #ifdef ISO
-    real, DIMENSION(klon,2:klev) :: gamaxt_tmp
-    real, DIMENSION(klon,klev) :: xt_tmp
-    real, DIMENSION(klon,klev) ::  Ccoef_XT_tmp,Dcoef_XT_tmp
-    real, DIMENSION(klon) ::  Acoef_XT_tmp,Bcoef_XT_tmp
-    integer ixt
+    REAL, DIMENSION(klon,2:klev) :: gamaxt_tmp
+    REAL, DIMENSION(klon,klev) :: xt_tmp
+    REAL, DIMENSION(klon,klev) ::  Ccoef_XT_tmp,Dcoef_XT_tmp
+    REAL, DIMENSION(klon) ::  Acoef_XT_tmp,Bcoef_XT_tmp
+    INTEGER ixt
 #endif 
 ! Include
@@ -132,5 +132,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-   if (iso_eau.gt.0) THEN
+   IF (iso_eau.gt.0) THEN
        do k = 1, klev
           DO i = 1, knon
@@ -315,5 +315,5 @@
        enddo ! do ixt=1,ntraciso
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
          do k = 1, klev
           DO i = 1, knon
@@ -375,5 +375,5 @@
 !****************************************************************************************
 !!! jyg le 07/02/2012
-!!jyg       IF (mod(iflag_pbl_split,2) .eq.1) THEN
+!!jyg       IF (mod(iflag_pbl_split,2) .EQ.1) THEN
        IF (mod(iflag_pbl_split,10) >=1) THEN
 !!! nrlmd le 02/05/2011
@@ -548,5 +548,5 @@
     REAL, DIMENSION(ntraciso,klon,klev)               :: xt_new
     REAL, DIMENSION(ntraciso,klon), INTENT(IN)        :: flx_xt1
-    integer ixt
+    INTEGER ixt
 !#ifdef ISOVERIF
 !    integer iso_verif_noNaN_nostop
@@ -571,5 +571,5 @@
        DO k = 1, klev
         DO i = 1, knon  
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
            CALL iso_verif_egalite(xt_old(iso_eau,i,k), &
                q_old(i,k),'climb_hq_mod 421')
@@ -598,5 +598,5 @@
 
 !!! jyg le 07/02/2012
-!!jyg       IF (mod(iflag_pbl_split,2) .eq.1) THEN
+!!jyg       IF (mod(iflag_pbl_split,2) .EQ.1) THEN
        IF (mod(iflag_pbl_split,10) >=1) THEN
 !!! nrlmd le 02/05/2011
@@ -674,9 +674,9 @@
        DO i = 1, knon     
         do ixt=1,ntraciso
-         if (iso_verif_noNaN_nostop(xt_new(ixt,i,k),'climb_hq 507').eq.1) THEN
+         IF (iso_verif_noNaN_nostop(xt_new(ixt,i,k),'climb_hq 507').EQ.1) THEN
              WRITE(*,*) 'Acoef_XT(ixt,i)=',Acoef_XT(ixt,i)
              WRITE(*,*) 'Bcoef_XT(ixt,i)=',Bcoef_XT(ixt,i)
              WRITE(*,*) 'flx_xt1(ixt,i)=',flx_xt1(ixt,i)
-             if (k.ge.2) THEN
+             IF (k.ge.2) THEN
                WRITE(*,*) 'Ccoef_XT(ixt,i,k)=',Ccoef_XT(ixt,i,k)
                WRITE(*,*) 'Dcoef_XT(ixt,i,k)=',Dcoef_XT(ixt,i,k)
@@ -689,17 +689,17 @@
 #endif
 #ifdef ISOVERIF
-     if (iso_eau.gt.0) THEN
+     IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite_vect2D( &
                  xt_new,q_new, &
                  'climb_hq_mod 504',ntraciso,klon,klev)
      endif !if (iso_eau.gt.0) THEN
-     if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+     IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
         do i=1,klon 
          do k=1,klev 
-            if (q_new(i,k).gt.ridicule) THEN
-               if (iso_verif_o18_aberrant_nostop( &
+            IF (q_new(i,k).gt.ridicule) THEN
+               IF (iso_verif_o18_aberrant_nostop( &
                     xt_new(iso_HDO,i,k)/q_new(i,k), &
                     xt_new(iso_O18,i,k)/q_new(i,k), &
-                    'climb_hq_mod 690').eq.1) THEN
+                    'climb_hq_mod 690').EQ.1) THEN
                   WRITE(*,*) 'i,k,q_new(i,k)=',i,k,q_new(i,k)
                   stop
@@ -708,5 +708,5 @@
           enddo !k=1,klev
          enddo  !i=1,klon
-        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+        endif !if ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
 #endif
 #endif   
@@ -770,5 +770,5 @@
 #endif
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
            CALL iso_verif_egalite(d_xt(iso_eau,i,k), &
                d_q(i,k),'climb_hq_mod 503')
@@ -787,5 +787,5 @@
 #ifdef ISOVERIF
 !        WRITE(*,*) 'climb_hq_mod 758: d_xt,d_q=',d_xt(iso_eau,1,1),d_q(1,1)
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
          CALL iso_verif_egalite_vect2D( &
                 d_xt,d_q, &
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/concvl.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/concvl.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/concvl.F90	(revision 5117)
@@ -476,5 +476,5 @@
         enddo !do i = 1, klon
        enddo !do k = 1, klev       
-       if (iso_eau.gt.0) THEN
+       IF (iso_eau.gt.0) THEN
        do k = 1, klev
         do i = 1, klon   
@@ -484,8 +484,8 @@
        enddo !do k = 1, klev   
        endif !if (iso_eau.gt.0) THEN
-       if (iso_HDO.gt.0) THEN
+       IF (iso_HDO.gt.0) THEN
        do k = 1, klev
         do i = 1, klon         
-         if (q(i,k).gt.ridicule) THEN
+         IF (q(i,k).gt.ridicule) THEN
           CALL iso_verif_aberrant(xt(iso_hdo,i,k)/q(i,k),'concvl 175')
          endif ! if (q(i,k).gt.ridicule) THEN
@@ -537,5 +537,5 @@
        do k = 1, klev
         do i = 1, klon
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite(xt(iso_eau,i,k),q(i,k),'concvl 203')
             CALL iso_verif_egalite(xt_wake(iso_eau,i,k),q_wake(i,k),'concvl 204')
@@ -653,11 +653,11 @@
   DO k = 1, klev
     DO i = 1, klon
-           if (iso_HDO.gt.0) THEN
-             if (q(i,k).gt.ridicule) THEN
+           IF (iso_HDO.gt.0) THEN
+             IF (q(i,k).gt.ridicule) THEN
                  CALL iso_verif_aberrant_encadre((xt(iso_HDO,i,k) &
               +d_xt(iso_HDO,i,k))/(q(i,k)+d_q(i,k)),'concvl 250')
              endif !if (q_seri(i,k).gt.ridicule) THEN
           endif !if (iso_HDO.gt.0) THEN
-           if (iso_eau.gt.0) THEN
+           IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(d_xt(iso_eau,i,k), &
                 d_q(i,k),'concvl 530',errmax*dtime,errmaxrel)
@@ -672,5 +672,5 @@
 
 #ifdef ISO 
-      if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) THEN
+      IF ((iso_eau.gt.0).AND.(bidouille_anti_divergence)) THEN
         do k=1,klev   
         do i=1,klon
@@ -682,5 +682,5 @@
                   klon,klev)
 #endif          
-      endif !if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) THEN
+      endif !if ((iso_eau.gt.0).AND.(bidouille_anti_divergence)) THEN
 #endif
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv30_routines.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv30_routines.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv30_routines.F90	(revision 5117)
@@ -191,5 +191,5 @@
   REAL ph(len, nd+1)
 #ifdef ISO
-  real xt(ntraciso,len,nd)      
+  REAL xt(ntraciso,len,nd)
 #endif
 
@@ -198,5 +198,5 @@
   REAL tnk(len), qnk(len), gznk(len), plcl(len)
 #ifdef ISO
-  real xtnk(ntraciso,len)      
+  REAL xtnk(ntraciso,len)
 #endif
 
@@ -204,5 +204,5 @@
   INTEGER i, k
 #ifdef ISO
-        integer ixt
+        INTEGER ixt
 #endif
   INTEGER ihmin(len)
@@ -225,5 +225,5 @@
   ! @       do 200 k=2,nlp
   ! @         do 190 i=1,len
-  ! @          if((hm(i,k).lt.work(i)).and.
+  ! @          if((hm(i,k).lt.work(i)).AND.
   ! @      &      (hm(i,k).lt.hm(i,k-1)))THEN
   ! @            work(i)=hm(i,k)
@@ -250,5 +250,5 @@
   ! @       do 240 k=minorig+1,nl
   ! @         do 230 i=1,len
-  ! @          if((hm(i,k).gt.work(i)).and.(k.le.ihmin(i)))THEN
+  ! @          if((hm(i,k).gt.work(i)).AND.(k.le.ihmin(i)))THEN
   ! @            work(i)=hm(i,k)
   ! @            nk(i)=k
@@ -270,5 +270,5 @@
   ! -------------------------------------------------------------------
   DO i = 1, len
-    IF (((t(i,nk(i))<250.0) .OR. (q(i,nk(i))<=0.0)) & ! @      &       .or.(
+    IF (((t(i,nk(i))<250.0) .OR. (q(i,nk(i))<=0.0)) & ! @      &       .OR.(
                                                       ! p(i,ihmin(i)).lt.400.0
                                                       ! )  )
@@ -320,5 +320,5 @@
   ! @      do 290 k=minorig,nl
   ! @        do 280 i=1,len
-  ! @          if((k.ge.(nk(i)+1)).and.(p(i,k).lt.plcl(i)))
+  ! @          if((k.ge.(nk(i)+1)).AND.(p(i,k).lt.plcl(i)))
   ! @     &    icb(i)=min(icb(i),k)
   ! @ 280    continue
@@ -326,5 +326,5 @@
   ! @c
   ! @      do 300 i=1,len
-  ! @        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
+  ! @        if((icb(i).ge.nlm).AND.(iflag(i).EQ.0))iflag(i)=9
   ! @ 300  continue
 
@@ -343,5 +343,5 @@
 
   DO i = 1, len
-    ! @        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
+    ! @        if((icb(i).ge.nlm).AND.(iflag(i).EQ.0))iflag(i)=9
     IF ((icb(i)==nlm) .AND. (iflag(i)==0)) iflag(i) = 9
   END DO
@@ -377,9 +377,9 @@
 USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall_trac
 #ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: iso_verif_traceur
-#endif
-#endif
-#ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif, &
+    USE isotopes_verif_mod, ONLY: iso_verif_traceur
+#endif
+#endif
+#ifdef ISOVERIF
+    USE isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif, &
         iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, &
         iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
@@ -414,5 +414,5 @@
   REAL plcl(len) ! convect3
 #ifdef ISO
-      real xt(ntraciso,len,nd)
+      REAL xt(ntraciso,len,nd)
 #endif
 
@@ -420,6 +420,6 @@
   REAL tp(len, nd), tvp(len, nd), clw(len, nd)
 #ifdef ISO
-      real xtclw(ntraciso,len,nd) 
-      real tg_save(len,nd) 
+      REAL xtclw(ntraciso,len,nd)
+      REAL tg_save(len,nd)
 #endif
 
@@ -433,7 +433,7 @@
   REAL cpinv(len) ! convect3
 #ifdef ISO
-      integer ixt
-      real zfice(len),zxtliq(ntraciso,len),zxtice(ntraciso,len)
-      real q_k(len),clw_k(len),tg_k(len),xt_k(ntraciso,len)
+      INTEGER ixt
+      REAL zfice(len),zxtliq(ntraciso,len),zxtice(ntraciso,len)
+      REAL q_k(len),clw_k(len),tg_k(len),xt_k(ntraciso,len)
 !#ifdef ISOVERIF      
 !      integer iso_verif_positif_nostop
@@ -618,7 +618,7 @@
               'cv30_routines 654')
         enddo
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
          do i=1,len
-          if (qnk(i).gt.ridicule) THEN
+          IF (qnk(i).gt.ridicule) THEN
            CALL iso_verif_aberrant(xt_k(iso_hdo,i)/qnk(i), &
                   'cv30_routines 576')
@@ -649,5 +649,5 @@
             WRITE(*,*) 'cv30_routine undilute 1 598: apres condiso'
           
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             do i=1,len
               CALL iso_verif_egalite_choix(xtclw(iso_eau,i,icbs(i)), &
@@ -785,5 +785,5 @@
 #ifdef ISOVERIF 
         WRITE(*,*) 'cv30_routines 739: avant condiso'
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
          do i=1,len
            CALL iso_verif_aberrant(xt_k(iso_hdo,i)/qnk(i), &
@@ -815,5 +815,5 @@
 !WRITE(*,*) 'DEBUG ISO B'
           do i=1,len
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(xtclw(iso_eau,i,icb(i)+1), &
                  clw(i,icb(i)+1),'cv30_routines 708',errmax,errmaxrel)
@@ -897,5 +897,5 @@
   ! oct3       ath  = th(i,icb(i)-1) - dttrig
   ! oct3
-  ! oct3       if (tdif.lt.dtcrit .or. ath.gt.ath1) THEN
+  ! oct3       if (tdif.lt.dtcrit .OR. ath.gt.ath1) THEN
   ! oct3         do 60 k=1,nl
   ! oct3            sig(i,k) = beta*sig(i,k) - 2.*alpha*tdif*tdif
@@ -947,8 +947,8 @@
   USE lmdz_print_control, ONLY: lunout
 #ifdef ISO
-    use infotrac_phy, ONLY: ntraciso=>ntiso
-    use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO
-#ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif, &
+    USE infotrac_phy, ONLY: ntraciso=>ntiso
+    USE isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO
+#ifdef ISOVERIF
+    USE isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif, &
         iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, &
         iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
@@ -975,6 +975,6 @@
 #ifdef ISO
       !integer niso
-      real xt1(ntraciso,len,nd), xtclw1(ntraciso,len,nd)
-      real xtnk1(ntraciso,len)
+      REAL xt1(ntraciso,len,nd), xtclw1(ntraciso,len,nd)
+      REAL xtnk1(ntraciso,len)
 #endif
 
@@ -992,6 +992,6 @@
   REAL tra(nloc, nd, ntra)
 #ifdef ISO
-      real xt(ntraciso,nloc,nd), xtclw(ntraciso,nloc,nd)
-      real xtnk(ntraciso,nloc)
+      REAL xt(ntraciso,nloc,nd), xtclw(ntraciso,nloc,nd)
+      REAL xtnk(ntraciso,nloc)
 #endif
 
@@ -999,5 +999,5 @@
   INTEGER i, k, nn, j
 #ifdef ISO
-      integer ixt
+      INTEGER ixt
 #endif
 
@@ -1009,5 +1009,5 @@
         do k=1,nd
           do i=1,nloc
-            if (essai_convergence) THEN
+            IF (essai_convergence) THEN
             else
               q(i,k)=0.0
@@ -1063,8 +1063,8 @@
   ! nn=0
   ! do 101 i=1,len
-  ! IF(iflag1(i).eq.0)THEN
+  ! IF(iflag1(i).EQ.0)THEN
   ! nn=nn+1
   ! tra(nn,k,j)=tra1(i,k,j)
-  ! endif
+  ! END IF
   ! 101  continue
   ! 111  continue
@@ -1101,5 +1101,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-       if (iso_eau.gt.0) THEN
+       IF (iso_eau.gt.0) THEN
         do k = 1, nd
          do i = 1, nloc  
@@ -1133,5 +1133,5 @@
     ! epmax_cape: ajout arguments
 #ifdef ISO
-use infotrac_phy, ONLY: ntraciso=>ntiso
+USE infotrac_phy, ONLY: ntraciso=>ntiso
 USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax,cond_temp_env, iso_eau,iso_HDO
 USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall
@@ -1143,5 +1143,5 @@
 #endif
 #ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif,Tmax_verif, &
+    USE isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif,Tmax_verif, &
         iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, &
         iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
@@ -1197,13 +1197,13 @@
 
 #ifdef ISO
-      real xt(ntraciso,nloc,nd), xtclw(ntraciso,nloc,nd)
-      real xtnk(ntraciso,nloc)
+      REAL xt(ntraciso,nloc,nd), xtclw(ntraciso,nloc,nd)
+      REAL xtnk(ntraciso,nloc)
 !      real xtep(ntraciso,nloc,nd) ! le 7 mai: on supprime xtep, car pas besoin
 !      la chute de precip ne fractionne pas.
-      integer ixt
-      real zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)
-      real clw_k(nloc),tg_k(nloc)
+      INTEGER ixt
+      REAL zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)
+      REAL clw_k(nloc),tg_k(nloc)
 #ifdef ISOVERIF      
-      real qg_save(nloc,nd) ! inout
+      REAL qg_save(nloc,nd) ! inout
       !integer iso_verif_positif_nostop
 #endif      
@@ -1327,5 +1327,5 @@
 #ifdef ISOVERIF
         !WRITE(*,*) 'cv30_routine 1259: avant condiso'
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
          do i=1,ncum
            CALL iso_verif_aberrant(xtnk(iso_hdo,i)/qnk(i), &
@@ -1333,5 +1333,5 @@
          enddo        
         endif !if (iso_HDO.gt.0) THEN
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
          do i=1,ncum
            CALL iso_verif_egalite(xtnk(iso_eau,i),qnk(i), &
@@ -1340,10 +1340,10 @@
         endif !if (iso_HDO.gt.0) THEN
         do i=1,ncum
-         if ((iso_verif_positif_nostop(qnk(i)-clw_k(i), &
-             'cv30_routines 1275').eq.1).or. &
+         IF ((iso_verif_positif_nostop(qnk(i)-clw_k(i), &
+             'cv30_routines 1275').EQ.1).OR. &
              (iso_verif_positif_nostop(tg_k(i)-Tmin_verif, &
-             'cv30_routines 1297a').eq.1).or.  &
+             'cv30_routines 1297a').EQ.1).OR.  &
              (iso_verif_positif_nostop(Tmax_verif-tg_k(i), &
-             'cv30_routines 1297b').eq.1)) THEN
+             'cv30_routines 1297b').EQ.1)) THEN
           WRITE(*,*) 'i,k,qnk,clw_k=',i,k,qnk(i),clw_k(i)
           WRITE(*,*) 'tg,t,qg=',tg_k(i),t(i,k),qg_save(i,k)
@@ -1376,5 +1376,5 @@
         enddo !do i=1,ncum
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
           do i=1,ncum        
            CALL iso_verif_egalite_choix(xtclw(iso_eau,i,k), &
@@ -1516,6 +1516,6 @@
   ! inb(i)=k+1
   ! capem(i)=cape(i)
-  ! endif
-  ! endif
+  ! END IF
+  ! END IF
   ! 520    continue
   ! 530  continue
@@ -1543,6 +1543,6 @@
   ! capem(i)=cape(i)
   ! byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-  ! endif
-  ! endif
+  ! END IF
+  ! END IF
   ! 520    continue
   ! 530  continue
@@ -1566,5 +1566,5 @@
   ! ori        do 520 i=1,ncum
   ! ori          IF(cape(i).lt.0.0)lcape(i)=.FALSE.
-  ! ori          if((k.ge.(icb(i)+1)).and.lcape(i))THEN
+  ! ori          if((k.ge.(icb(i)+1)).AND.lcape(i))THEN
   ! ori            by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
   ! ori            byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
@@ -1828,10 +1828,10 @@
 
 #ifdef ISO
-use infotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso
+USE infotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso
 USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax, iso_eau,iso_HDO, &
         ridicule
 USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall
 #ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif,deltalim, &
+    USE isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif,deltalim, &
         iso_verif_egalite_choix,iso_verif_aberrant_choix, iso_verif_noNaN, &
         iso_verif_aberrant, &
@@ -1841,10 +1841,10 @@
 #endif
 #ifdef ISOTRAC
-    use isotrac_mod, ONLY: option_tmin,option_traceurs,seuil_tag_tmin, &
+    USE isotrac_mod, ONLY: option_tmin,option_traceurs,seuil_tag_tmin, &
 &       option_cond,index_zone,izone_cond,index_iso
-    use isotrac_routines_mod, ONLY: iso_recolorise_condensation
-    use isotopes_routines_mod, ONLY: condiso_liq_ice_vectall_trac
-#ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: iso_verif_trac17_q_deltad,iso_verif_traceur, &
+    USE isotrac_routines_mod, ONLY: iso_recolorise_condensation
+    USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall_trac
+#ifdef ISOVERIF
+    USE isotopes_verif_mod, ONLY: iso_verif_trac17_q_deltad,iso_verif_traceur, &
 &       iso_verif_traceur_justmass
 #endif
@@ -1875,7 +1875,7 @@
   REAL m(nloc, na) ! input of convect3
 #ifdef ISO
-      real xt(ntraciso,nloc,na), xtclw(ntraciso,nloc,na)
-      real tg_save(nloc,nd)
-      real xtnk(ntraciso,nloc)
+      REAL xt(ntraciso,nloc,na), xtclw(ntraciso,nloc,na)
+      REAL tg_save(nloc,nd)
+      REAL xtnk(ntraciso,nloc)
 !      real xtep(ntraciso,nloc,na)
 #endif
@@ -1889,6 +1889,6 @@
   REAL sigij(nloc, nd, nd)
 #ifdef ISO
-      real xtent(ntraciso,nloc,nd,nd)
-      real xtelij(ntraciso,nloc,nd,nd)      
+      REAL xtent(ntraciso,nloc,nd,nd)
+      REAL xtelij(ntraciso,nloc,nd,nd)
 #endif
 
@@ -1905,12 +1905,12 @@
   LOGICAL lwork(nloc)
 #ifdef ISO
-      integer ixt
-      real xtrti(ntraciso,nloc)
-      real xtres(ntraciso)
+      INTEGER ixt
+      REAL xtrti(ntraciso,nloc)
+      REAL xtres(ntraciso)
       ! on ajoute la dimension nloc a xtrti pour verifs dans les tags: 5 fev
       ! 2010
-      real zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)
+      REAL zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)
 !      real xt_reduit(ntraciso)
-!      logical negation
+!      LOGICAL negation
 !#ifdef ISOVERIF
 !       integer iso_verif_positif_nostop
@@ -1924,5 +1924,5 @@
 #ifdef ISOVERIF
       WRITE(*,*) 'cv30_routines 1820: entree dans cv3_mixing'
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
       CALL iso_verif_egalite_vect2D( &
                  xtclw,clw, &
@@ -2051,11 +2051,11 @@
          zfice(il) = 1.0-(t(il,j)-pxtice)/(pxtmelt-pxtice)
          zfice(il) = MIN(MAX(zfice(il),0.0),1.0)        
-         IF( (i.ge.icb(il)).and.(i.le.inb(il)).and. &
-            (j.ge.(icb(il)-1)).and.(j.le.inb(il)))THEN
+         IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND. &
+            (j.ge.(icb(il)-1)).AND.(j.le.inb(il)))THEN
           do ixt=1,ntraciso
 !           xtrti(ixt)=xt(ixt,il,1)-xtep(ixt,il,i)*xtclw(ixt,il,i) ! le 7 mai: on supprime xtep
            xtrti(ixt,il)=xt(ixt,il,1)-ep(il,i)*xtclw(ixt,il,i)      
           enddo
-          IF(sij(il,i,j).gt.0.0.and.sij(il,i,j).lt.0.95)THEN
+          IF(sij(il,i,j).gt.0.0.AND.sij(il,i,j).lt.0.95)THEN
 ! temperature of condensation (within mixtures):
 !          tcond(il)=t(il,j)  
@@ -2069,6 +2069,6 @@
                              +(1.-sij(il,i,j))*xtrti(ixt,il)
           enddo !do ixt = 1, ntraciso
-         endif  !IF(sij(il,i,j).gt.0.0.and.sij(il,i,j).lt.0.95)THEN
-        endif !IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
+         endif  !IF(sij(il,i,j).gt.0.0.AND.sij(il,i,j).lt.0.95)THEN
+        endif !IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND.
        enddo  !do il=1,ncum 
 
@@ -2083,8 +2083,8 @@
         do il=1,ncum
           CALL iso_verif_traceur(xt(1,il,i),'cv30_routines 1967')
-          IF( (i.ge.icb(il)).and.(i.le.inb(il)).and. &
-            (j.ge.(icb(il)-1)).and.(j.le.inb(il)))THEN
+          IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND. &
+            (j.ge.(icb(il)-1)).AND.(j.le.inb(il)))THEN
           CALL iso_verif_traceur(xtrti(1,il),'cv30_routines 1968')
-          endif !IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
+          endif !IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND.
           CALL iso_verif_traceur(xtent(1,il,i,j),'cv30_routines 1969')
           
@@ -2099,7 +2099,7 @@
 
 #ifdef ISOVERIF
-        if ((j.eq.15).and.(i.eq.15)) THEN
+        IF ((j.EQ.15).AND.(i.EQ.15)) THEN
         il=2722
-        if (il.le.ncum) THEN
+        IF (il.le.ncum) THEN
                 WRITE(*,*) 'cv30_routines tmp 2194, il,i,j=',il,i,j
                 WRITE(*,*) 'qent,elij=',qent(il,i,j),elij(il,i,j)
@@ -2116,5 +2116,5 @@
 !        WRITE(*,*) 'cv30_routines tmp 1987,option_traceurs=',
 !     :           option_traceurs
-        if (option_tmin.ge.1) THEN
+        IF (option_tmin.ge.1) THEN
         do il=1,ncum    
 !        WRITE(*,*) 'cv3 tmp 1991 il,i,j,xtent(:,il,i,j),',
@@ -2123,16 +2123,16 @@
         ! colorier la vapeur residuelle selon temperature de
         ! condensation, et le condensat en un tag spEcifique
-          if ((elij(il,i,j).gt.0.0).and.(qent(il,i,j).gt.0.0)) THEN
-            if (option_traceurs.eq.17) THEN
+          IF ((elij(il,i,j).gt.0.0).AND.(qent(il,i,j).gt.0.0)) THEN
+            IF (option_traceurs.EQ.17) THEN
              CALL iso_recolorise_condensation(qent(il,i,j),elij(il,i,j), &
                  xtent(1,il,i,j),xtelij(1,il,i,j),t(1,j), &
                  0.0,xtres, &
                  seuil_tag_tmin)
-            else !if (option_traceurs.eq.17) THEN
+            else !if (option_traceurs.EQ.17) THEN
 !             WRITE(*,*) 'cv3 2002: il,i,j  =',il,i,j
              CALL iso_recolorise_condensation(qent(il,i,j),elij(il,i,j), &
                  xtent(1,il,i,j),xtelij(1,il,i,j),rs(il,j),0.0,xtres, &
                  seuil_tag_tmin)
-            endif !if (option_traceurs.eq.17) THEN
+            endif !if (option_traceurs.EQ.17) THEN
             do ixt=1+niso,ntraciso
                xtent(ixt,il,i,j)=xtres(ixt)
@@ -2155,8 +2155,8 @@
 !        WRITE(*,*) 'cv30_routines 2050: avant condiso'
         do il=1,ncum
-        if ((i.ge.icb(il)).and.(i.le.inb(il)).and. &
-            (j.ge.(icb(il)-1)).and.(j.le.inb(il))) THEN
-        if (sij(il,i,j).gt.0.0.and.sij(il,i,j).lt.0.95) THEN
-        if (iso_eau.gt.0) THEN
+        IF ((i.ge.icb(il)).AND.(i.le.inb(il)).AND. &
+            (j.ge.(icb(il)-1)).AND.(j.le.inb(il))) THEN
+        IF (sij(il,i,j).gt.0.0.AND.sij(il,i,j).lt.0.95) THEN
+        IF (iso_eau.gt.0) THEN
           CALL iso_verif_egalite_choix(xtent(iso_eau,il,i,j), &
               qent(il,i,j),'cv30_routines 1889',errmax,errmaxrel)
@@ -2164,5 +2164,5 @@
               elij(il,i,j),'cv30_routines 1890',errmax,errmaxrel)
         endif
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
           CALL iso_verif_aberrant_choix(xt(iso_HDO,il,i),rr(il,i), &
                   ridicule,deltalim,'cv30_routines 1997')
@@ -2182,6 +2182,6 @@
 #endif        
 
-        endif !IF(sij(il,i,j).gt.0.0.and.sij(il,i,j).lt.0.95)THEN
-        endif !IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
+        endif !IF(sij(il,i,j).gt.0.0.AND.sij(il,i,j).lt.0.95)THEN
+        endif !IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND.
         enddo !do il=1,ncum
 #endif
@@ -2196,9 +2196,9 @@
     ! do j=minorig,nl
     ! do il=1,ncum
-    ! IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
-    ! :       (j.ge.(icb(il)-1)).and.(j.le.inb(il)))THEN
+    ! IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND.
+    ! :       (j.ge.(icb(il)-1)).AND.(j.le.inb(il)))THEN
     ! traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
     ! :            +(1.-sij(il,i,j))*tra(il,nk(il),k)
-    ! endif
+    ! END IF
     ! enddo
     ! enddo
@@ -2216,5 +2216,5 @@
     DO il = 1, ncum
       IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (nent(il,i)==0)) THEN
-        ! @      IF(nent(il,i).eq.0)THEN
+        ! @      IF(nent(il,i).EQ.0)THEN
         ment(il, i, i) = m(il, i)
         qent(il, i, i) = rr(il, nk(il)) - ep(il, i)*clw(il, i)
@@ -2233,5 +2233,5 @@
 
 #ifdef ISOVERIF
-       if (iso_eau.gt.0) THEN
+       IF (iso_eau.gt.0) THEN
          CALL iso_verif_egalite_choix(xtelij(iso_eau,il,i,i), &
                elij(il,i,i),'cv30_mixing 2117',errmax,errmaxrel)
@@ -2240,11 +2240,11 @@
 
 #ifdef ISOTRAC          
-        if (option_tmin.ge.1) THEN
+        IF (option_tmin.ge.1) THEN
         ! colorier la vapeur residuelle selon temperature de
         ! condensation, et le condensat en un tag specifique
 !        WRITE(*,*) 'cv3 tmp 2095 il,i,j,xtent(:,il,i,j)=',
 !     :            il,i,j,xtent(:,il,i,j)
-          if ((elij(il,i,i).gt.0.0).and.(qent(il,i,i).gt.0.0)) THEN
-            if (option_traceurs.eq.17) THEN
+          IF ((elij(il,i,i).gt.0.0).AND.(qent(il,i,i).gt.0.0)) THEN
+            IF (option_traceurs.EQ.17) THEN
              CALL iso_recolorise_condensation(qent(il,i,i), &
                  elij(il,i,i), &
@@ -2252,5 +2252,5 @@
                  xtres, &
                  seuil_tag_tmin)
-            else !if (option_traceurs.eq.17) THEN
+            else !if (option_traceurs.EQ.17) THEN
              CALL iso_recolorise_condensation(qent(il,i,i), &
                  elij(il,i,i), &
@@ -2258,5 +2258,5 @@
                  xtres, &
                  seuil_tag_tmin)
-            endif !if (option_traceurs.eq.17) THEN
+            endif !if (option_traceurs.EQ.17) THEN
             do ixt=1+niso,ntraciso
               xtent(ixt,il,i,i)=xtres(ixt)
@@ -2288,7 +2288,7 @@
   ! do i=minorig+1,nl
   ! do il=1,ncum
-  ! if (i.ge.icb(il) .and. i.le.inb(il) .and. nent(il,i).eq.0) THEN
+  ! if (i.ge.icb(il) .AND. i.le.inb(il) .AND. nent(il,i).EQ.0) THEN
   ! traent(il,i,i,j)=tra(il,nk(il),j)
-  ! endif
+  ! END IF
   ! enddo
   ! enddo
@@ -2466,5 +2466,5 @@
 
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite_choix(xtelij(iso_eau,il,i,i), &
                elij(il,i,i),'cv30_mixing 2354',errmax,errmaxrel)
@@ -2473,11 +2473,11 @@
 
 #ifdef ISOTRAC          
-        if (option_tmin.ge.1) THEN
+        IF (option_tmin.ge.1) THEN
         ! colorier la vapeur residuelle selon temperature de
         ! condensation, et le condensat en un tag specifique
 !        WRITE(*,*) 'cv3 tmp 2314 il,i,j,xtent(:,il,i,j)=',
 !     :            il,i,j,xtent(:,il,i,j)
-          if ((elij(il,i,i).gt.0.0).and.(qent(il,i,i).gt.0.0)) THEN
-            if (option_traceurs.eq.17) THEN
+          IF ((elij(il,i,i).gt.0.0).AND.(qent(il,i,i).gt.0.0)) THEN
+            IF (option_traceurs.EQ.17) THEN
               CALL iso_recolorise_condensation(qent(il,i,i), &
                  elij(il,i,i), &
@@ -2485,5 +2485,5 @@
                  xtres, &
                  seuil_tag_tmin)
-            else !if (option_traceurs.eq.17) THEN
+            else !if (option_traceurs.EQ.17) THEN
               CALL iso_recolorise_condensation(qent(il,i,i), &
                  elij(il,i,i), &
@@ -2491,5 +2491,5 @@
                  xtres, &
                  seuil_tag_tmin)
-            endif ! if (option_traceurs.eq.17) THEN
+            endif ! if (option_traceurs.EQ.17) THEN
             do ixt=1+niso,ntraciso
               xtent(ixt,il,i,i)=xtres(ixt)
@@ -2517,8 +2517,8 @@
     ! do j=1,ntra
     ! do il=1,ncum
-    ! if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
-    ! :     .and. csum(il,i).lt.m(il,i) ) THEN
+    ! if ( i.ge.icb(il) .AND. i.le.inb(il) .AND. lwork(il)
+    ! :     .AND. csum(il,i).lt.m(il,i) ) THEN
     ! traent(il,i,i,j)=tra(il,nk(il),j)
-    ! endif
+    ! END IF
     ! enddo
     ! enddo
@@ -2560,5 +2560,5 @@
        do jm = 1, nd
         do il = 1, ncum
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(xtelij(iso_eau,il,im,jm), &
                elij(il,im,jm),'cv30_mixing 2110',errmax,errmaxrel)
@@ -2579,5 +2579,5 @@
 #ifdef ISOTRAC
         ! seulement a la fin on taggue le condensat
-        if (option_cond.ge.1) THEN
+        IF (option_cond.ge.1) THEN
          do im = 1, nd
          do jm = 1, nd
@@ -2585,9 +2585,9 @@
            ! colorier le condensat en un tag specifique
            do ixt=niso+1,ntraciso
-             if (index_zone(ixt).eq.izone_cond) THEN
+             IF (index_zone(ixt).EQ.izone_cond) THEN
                 xtelij(ixt,il,im,jm)=xtelij(index_iso(ixt),il,im,jm)
-             else !if (index_zone(ixt).eq.izone_cond) THEN
+             else !if (index_zone(ixt).EQ.izone_cond) THEN
                 xtelij(ixt,il,im,jm)=0.0
-             endif !if (index_zone(ixt).eq.izone_cond) THEN
+             endif !if (index_zone(ixt).EQ.izone_cond) THEN
            enddo !do ixt=1,ntraciso      
 #ifdef ISOVERIF
@@ -2604,9 +2604,9 @@
            ! colorier le condensat en un tag specifique
            do ixt=niso+1,ntraciso
-             if (index_zone(ixt).eq.izone_cond) THEN
+             IF (index_zone(ixt).EQ.izone_cond) THEN
                 xtclw(ixt,il,im)=xtclw(index_iso(ixt),il,im)
-             else !if (index_zone(ixt).eq.izone_cond) THEN
+             else !if (index_zone(ixt).EQ.izone_cond) THEN
                 xtclw(ixt,il,im)=0.0
-             endif !if (index_zone(ixt).eq.izone_cond) THEN
+             endif !if (index_zone(ixt).EQ.izone_cond) THEN
            enddo !do ixt=1,ntraciso      
 #ifdef ISOVERIF
@@ -2615,7 +2615,7 @@
         CALL iso_verif_traceur(xtclw(1,il,im), &
                 'condiso_liq_ice_vectiso_trac 358')
-        if (iso_verif_positif_nostop(xtclw(itZonIso( &
+        IF (iso_verif_positif_nostop(xtclw(itZonIso( &
                  izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
-                 ,'cv30_routines 909').eq.1) THEN
+                 ,'cv30_routines 909').EQ.1) THEN
                WRITE(*,*) 'i,k=',i,k
                WRITE(*,*) 'xtclw=',xtclw(:,i,k)
@@ -2628,5 +2628,5 @@
          enddo !do im = 1, nd
 !         WRITE(*,*) 'xtclw(:,1,2)=',xtclw(:,1,2)
-        endif !if (option_tmin.eq.1) THEN
+        endif !if (option_tmin.EQ.1) THEN
 #endif
 #endif
@@ -2646,9 +2646,9 @@
                 )
 #ifdef ISO
-    use infotrac_phy, ONLY: ntraciso=>ntiso, niso
-    use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO,ridicule
-    use isotopes_routines_mod, ONLY: appel_stewart_vectall,appel_stewart_debug
-#ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: errmax,errmaxrel, &
+    USE infotrac_phy, ONLY: ntraciso=>ntiso, niso
+    USE isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO,ridicule
+    USE isotopes_routines_mod, ONLY: appel_stewart_vectall,appel_stewart_debug
+#ifdef ISOVERIF
+    USE isotopes_verif_mod, ONLY: errmax,errmaxrel, &
         iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, &
         iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
@@ -2657,10 +2657,10 @@
 #endif
 #ifdef ISOTRAC
-    use isotrac_mod, ONLY: option_cond,izone_cond
-    use infotrac_phy, ONLY: itZonIso
-#ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: iso_verif_traceur_justmass, &
+    USE isotrac_mod, ONLY: option_cond,izone_cond
+    USE infotrac_phy, ONLY: itZonIso
+#ifdef ISOVERIF
+    USE isotopes_verif_mod, ONLY: iso_verif_traceur_justmass, &
 &       iso_verif_traceur
-    use isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
+    USE isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
 #endif
 #endif
@@ -2687,6 +2687,6 @@
   REAL m(nloc, na), ment(nloc, na, na), elij(nloc, na, na)
 #ifdef ISO
-      real xt(ntraciso,nloc,nd), xtclw(ntraciso,nloc,na)
-      real xtelij(ntraciso,nloc,na,na)
+      REAL xt(ntraciso,nloc,nd), xtclw(ntraciso,nloc,na)
+      REAL xtelij(ntraciso,nloc,na,na)
 !      real xtep(ntraciso,nloc,na) ! le 7 mai: on supprime xtep
 #endif
@@ -2704,7 +2704,7 @@
 
 #ifdef ISO
-      real xtp(ntraciso,nloc,na)
-      real xtwater(ntraciso,nloc,na), xtevap(ntraciso,nloc,na)
-      real xtwdtraina(ntraciso,nloc,na)
+      REAL xtp(ntraciso,nloc,na)
+      REAL xtwater(ntraciso,nloc,na), xtevap(ntraciso,nloc,na)
+      REAL xtwdtraina(ntraciso,nloc,na)
 #endif
 
@@ -2721,9 +2721,9 @@
 
 #ifdef ISO
-      integer ixt
-      real xtawat(ntraciso)
+      INTEGER ixt
+      REAL xtawat(ntraciso)
   REAL xtwdtrain(ntraciso,nloc)
-!      logical negation
-      real rpprec(nloc,na)
+!      LOGICAL negation
+      REAL rpprec(nloc,na)
 !#ifdef ISOVERIF
 !      integer iso_verif_aberrant_nostop
@@ -2852,5 +2852,5 @@
 !--debug:
 #ifdef ISOVERIF
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(xtwdtrain(iso_eau,il), &
                  wdtrain(il),'cv30_routines 2313',errmax,errmaxrel)
@@ -2886,5 +2886,5 @@
 #ifdef ISO
 ! precip mixed drafts computed from: xtawat/xtelij = awat/elij           
-            if (elij(il,j,i).ne.0.0) THEN
+            IF (elij(il,j,i).NE.0.0) THEN
              do ixt=1,ntraciso
                xtawat(ixt)=xtelij(ixt,il,j,i)*(awat/elij(il,j,i))
@@ -2899,5 +2899,5 @@
 
 #ifdef ISOVERIF
-              if (iso_eau.gt.0) THEN
+              IF (iso_eau.gt.0) THEN
                   CALL iso_verif_egalite_choix(xtawat(iso_eau), &
                  awat,'cv30_routines 2391',errmax,errmaxrel)
@@ -2928,5 +2928,5 @@
 !--debug:
 #ifdef ISOVERIF
-              if (iso_eau.gt.0) THEN
+              IF (iso_eau.gt.0) THEN
                   CALL iso_verif_egalite_choix(xtwdtrain(iso_eau,il), &
                  wdtrain(il),'cv30_routines 2366',errmax,errmaxrel)
@@ -2934,10 +2934,10 @@
 #ifdef ISOTRAC
         CALL iso_verif_traceur(xtwdtrain(1,il),'cv30_routine 2540')
-        if (option_cond.ge.1) THEN
+        IF (option_cond.ge.1) THEN
            ! on verifie que tout le detrainement est tagge condensat
-           if (iso_verif_positif_nostop( &
+           IF (iso_verif_positif_nostop( &
                 xtwdtrain(itZonIso(izone_cond,iso_eau),il) &
                 -xtwdtrain(iso_eau,il), &
-                'cv30_routines 2795').eq.1) THEN
+                'cv30_routines 2795').EQ.1) THEN
           WRITE(*,*) 'xtwdtrain(:,il)=',xtwdtrain(:,il)
           WRITE(*,*) 'xtelij(:,il,j,i)=',xtelij(:,il,j,i)
@@ -3121,5 +3121,5 @@
           END IF
 
-        END IF ! i.eq.1
+        END IF ! i.EQ.1
 
         ! ***       find mixing ratio of precipitating downdraft     ***
@@ -3191,6 +3191,6 @@
 !        WRITE(*,*) 'cv30_routines 2842 tmp: appel de appel_stewart'
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) THEN
-         if (iso_eau.gt.0) THEN
+       IF (i.le.inb(il) .AND. lwork(il)) THEN
+         IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(xt(iso_eau,il,i), &
               rr(il,i),'appel_stewart 262, cas 1.1',errmax,errmaxrel)
@@ -3208,5 +3208,5 @@
 #endif
 
-        if (1.eq.0) THEN
+        IF (1.EQ.0) THEN
         ! appel de appel_stewart_vectorise
         CALL appel_stewart_vectall(lwork,ncum, &
@@ -3220,5 +3220,5 @@
                 na,nd,nloc,cvflag_grav,ginv,1e-16)
 
-        else !if (1.eq.0) THEN
+        else !if (1.EQ.0) THEN
           ! truc simple sans fractionnement
           ! juste pour debuggage
@@ -3226,10 +3226,10 @@
                 evap,water,rpprec,rr,wdtrain, &
                 xtevap,xtwater,xtp,xt,xtwdtrain)
-        endif ! if (1.eq.0) THEN
+        endif ! if (1.EQ.0) THEN
 #ifdef ISOVERIF
 !        WRITE(*,*) 'cv30_routines 2864 tmp: sortie de appel_stewart'
 ! verif des outputs de appel stewart
        do il=1,ncum
-        if (i.le.inb(il) .and. lwork(il)) THEN
+        IF (i.le.inb(il) .AND. lwork(il)) THEN
          do ixt=1,ntraciso        
           CALL iso_verif_noNAN(xtp(ixt,il,i),'cv30_unsat 3382')
@@ -3237,5 +3237,5 @@
           CALL iso_verif_noNAN(xtevap(ixt,il,i),'cv30_unsat 2661')
          enddo  
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
           CALL iso_verif_egalite_choix(xtp(iso_eau,il,i), &
                  rpprec(il,i),'cv30_unsat 2736',errmax,errmaxrel)
@@ -3247,11 +3247,11 @@
                  evap(il,i),'cv30_unsat 2751',errmax,errmaxrel)
          endif !if (iso_eau.gt.0) THEN
-         if ((iso_HDO.gt.0).and. &
+         IF ((iso_HDO.gt.0).AND. &
                  (rp(il,i).gt.ridicule)) THEN
            CALL iso_verif_aberrant(xtp(iso_HDO,il,i)/rpprec(il,i), &
                         'cv3unsat 2756')
-           endif !if ((iso_HDO.gt.0).and.
+           endif !if ((iso_HDO.gt.0).AND.
 #ifdef ISOTRAC
-!        if (il.eq.602) THEN
+!        if (il.EQ.602) THEN
 !        WRITE(*,*) 'cv30_routine tmp: il,i=',il,i
 !        WRITE(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
@@ -3272,5 +3272,5 @@
 !        endif !if (option_tmin.ge.1) THEN
 #endif              
-        endif !if (i.le.inb(il) .and. lwork(il)) THEN
+        endif !if (i.le.inb(il) .AND. lwork(il)) THEN
        enddo !do il=1,ncum
 #endif
@@ -3278,7 +3278,7 @@
 ! equivalent isotopique de rp(il,i)=amin1(rp(il,i),rs(il,i))
        do il=1,ncum
-        if (i.lt.inb(il) .and. lwork(il)) THEN
-         if (rpprec(il,i).gt.rs(il,i)) THEN
-            if (rs(il,i).le.0) THEN
+        IF (i.lt.inb(il) .AND. lwork(il)) THEN
+         IF (rpprec(il,i).gt.rs(il,i)) THEN
+            IF (rs(il,i).le.0) THEN
                 WRITE(*,*) 'cv3unsat 2640'
                 stop
@@ -3292,5 +3292,5 @@
            CALL iso_verif_noNaN(xtp(ixt,il,i),'cv3unsat 2641')
            enddo !do ixt=1,niso
-           if (iso_eau.gt.0) THEN
+           IF (iso_eau.gt.0) THEN
 !             WRITE(*,*) 'xtp(iso_eau,il,i)=',xtp(iso_eau,il,i)
              CALL iso_verif_egalite_choix(xtp(iso_eau,il,i),rp(il,i), &
@@ -3299,8 +3299,8 @@
                   rs(il,i),'cv3unsat 2654',errmax,errmaxrel)
            endif  
-           if ((iso_HDO.gt.0).and. &
+           IF ((iso_HDO.gt.0).AND. &
                  (rp(il,i).gt.ridicule)) THEN
-             if (iso_verif_aberrant_nostop(xtp(iso_HDO,il,i)/rp(il,i), &
-                        'cv3unsat 2658').eq.1) THEN
+             IF (iso_verif_aberrant_nostop(xtp(iso_HDO,il,i)/rp(il,i), &
+                        'cv3unsat 2658').EQ.1) THEN
                 WRITE(*,*) 'rpprec(il,i),rs(il,i),rp(il,i)=', &
                          rpprec(il,i),rs(il,i),rp(il,i)
@@ -3327,5 +3327,5 @@
       do i=1,nl !nl
         do il=1,ncum
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
 !            WRITE(*,*) 'cv30_routines 2767:i,il,lwork(il),inb(il)=',
 !     :           i,il,lwork(il),inb(il)
@@ -3342,5 +3342,5 @@
 !        if (iso_verif_traceur_choix_nostop(xtwater(1,il,i),
 !     :       'cv30_routine 2982 unsat',errmax,
-!     :       errmaxrel,ridicule_trac,deltalimtrac).eq.1) THEN
+!     :       errmaxrel,ridicule_trac,deltalimtrac).EQ.1) THEN
 !              WRITE(*,*) 'il,i,inb(il),lwork(il)=',
 !     :           il,i,inb(il),lwork(il)
@@ -3376,8 +3376,8 @@
                           )
 #ifdef ISO
-    use infotrac_phy, ONLY: ntraciso=>ntiso, niso, nzone, itZonIso
-    use isotopes_mod, ONLY: essai_convergence,ridicule,iso_eau,iso_HDO,iso_O18
-#ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: errmax,errmaxrel, &
+    USE infotrac_phy, ONLY: ntraciso=>ntiso, niso, nzone, itZonIso
+    USE isotopes_mod, ONLY: essai_convergence,ridicule,iso_eau,iso_HDO,iso_O18
+#ifdef ISOVERIF
+    USE isotopes_verif_mod, ONLY: errmax,errmaxrel, &
         iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, &
         iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
@@ -3388,10 +3388,10 @@
 #endif
 #ifdef ISOTRAC
-        use isotrac_mod, ONLY: option_traceurs, &
+        USE isotrac_mod, ONLY: option_traceurs, &
         izone_revap,izone_poubelle,izone_ddft
 #ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: iso_verif_traceur_choix_nostop,deltalimtrac, &
+    USE isotopes_verif_mod, ONLY: iso_verif_traceur_choix_nostop,deltalimtrac, &
 &       iso_verif_tracpos_choix_nostop,iso_verif_traceur,iso_verif_traceur_justmass
-    use isotrac_mod, ONLY: ridicule_trac
+    USE isotrac_mod, ONLY: ridicule_trac
 #endif
 #endif
@@ -3424,9 +3424,9 @@
   REAL tv(nloc, nd), tvp(nloc, nd)
 #ifdef ISO
-      real xt(ntraciso,nloc,nd)
+      REAL xt(ntraciso,nloc,nd)
 !      real xtep(ntraciso,nloc,na) ! le 7 mai: on supprime xtep
-      real xtclw(ntraciso,nloc,na), xtp(ntraciso,nloc,na)
-      real xtwater(ntraciso,nloc,na), xtevap(ntraciso,nloc,na)
-      real xtent(ntraciso,nloc,na,na), xtelij(ntraciso,nloc,na,na)
+      REAL xtclw(ntraciso,nloc,na), xtp(ntraciso,nloc,na)
+      REAL xtwater(ntraciso,nloc,na), xtevap(ntraciso,nloc,na)
+      REAL xtent(ntraciso,nloc,na,na), xtelij(ntraciso,nloc,na,na)
 #ifdef ISOVERIF      
       CHARACTER (LEN=20) :: modname='cv30_compress'
@@ -3449,6 +3449,6 @@
   REAL wd(nloc) ! gust
 #ifdef ISO
-      real xtprecip(ntraciso,nloc), fxt(ntraciso,nloc,nd)
-      real xtVprecip(ntraciso,nloc,nd+1)
+      REAL xtprecip(ntraciso,nloc), fxt(ntraciso,nloc,nd)
+      REAL xtVprecip(ntraciso,nloc,nd+1)
 #endif
 
@@ -3466,12 +3466,12 @@
   REAL siga(nloc, nd), sax(nloc, nd), mac(nloc, nd) ! cld
 #ifdef ISO
-      integer ixt
-      real xtbx(ntraciso), xtawat(ntraciso)
+      INTEGER ixt
+      REAL xtbx(ntraciso), xtawat(ntraciso)
       ! cam debug
       ! pour l'homogeneisation sous le nuage:
-      real frsum(nloc), bxtsum(ntraciso,nloc), fxtsum(ntraciso,nloc)
+      REAL frsum(nloc), bxtsum(ntraciso,nloc), fxtsum(ntraciso,nloc)
       ! correction dans calcul tendance liee a Am:
-      real dq_tmp,k_tmp,dx_tmp,R_tmp,dqreste_tmp,dxreste_tmp,kad_tmp
-      logical correction_excess_aberrant
+      REAL dq_tmp,k_tmp,dx_tmp,R_tmp,dqreste_tmp,dxreste_tmp,kad_tmp
+      LOGICAL correction_excess_aberrant
       parameter (correction_excess_aberrant=.FALSE.)
         ! correction qui permettait d'eviter deltas et dexcess aberrants. Mais
@@ -3479,15 +3479,15 @@
 #ifdef DIAGISO
         ! diagnostiques juste: tendance des differents processus
-      real fxt_detrainement(ntraciso,nloc,nd)
-      real fxt_fluxmasse(ntraciso,nloc,nd)
-      real fxt_evapprecip(ntraciso,nloc,nd)
-      real fxt_ddft(ntraciso,nloc,nd)
-      real fq_detrainement(nloc,nd)
-      real q_detrainement(nloc,nd)
-      real xt_detrainement(ntraciso,nloc,nd)
-      real f_detrainement(nloc,nd)
-      real fq_fluxmasse(nloc,nd)
-      real fq_evapprecip(nloc,nd)
-      real fq_ddft(nloc,nd)
+      REAL fxt_detrainement(ntraciso,nloc,nd)
+      REAL fxt_fluxmasse(ntraciso,nloc,nd)
+      REAL fxt_evapprecip(ntraciso,nloc,nd)
+      REAL fxt_ddft(ntraciso,nloc,nd)
+      REAL fq_detrainement(nloc,nd)
+      REAL q_detrainement(nloc,nd)
+      REAL xt_detrainement(ntraciso,nloc,nd)
+      REAL f_detrainement(nloc,nd)
+      REAL fq_fluxmasse(nloc,nd)
+      REAL fq_evapprecip(nloc,nd)
+      REAL fq_ddft(nloc,nd)
 #endif      
 !#ifdef ISOVERIF
@@ -3498,13 +3498,13 @@
 !      integer iso_verif_traceur_choix_nostop
 !      integer iso_verif_tracpos_choix_nostop
-      real xtnew(ntraciso)
+      REAL xtnew(ntraciso)
 !      real conversion(niso)
-      real fxtYe(niso)
-      real fxtqe(niso)
-      real fxtXe(niso)
-      real fxt_revap(niso)
-      real Xe(niso)
-      integer ixt_revap,izone
-      integer ixt_poubelle, ixt_ddft,iiso 
+      REAL fxtYe(niso)
+      REAL fxtqe(niso)
+      REAL fxtXe(niso)
+      REAL fxt_revap(niso)
+      REAL Xe(niso)
+      INTEGER ixt_revap,izone
+      INTEGER ixt_poubelle, ixt_ddft,iiso
 #endif
 #endif
@@ -3596,5 +3596,5 @@
          ! cam verif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
 !              WRITE(*,*) 'cv30_yield 2952: '//
 !     :           'il,water(il,1),xtwater(iso_eau,il,1)='
@@ -3612,7 +3612,7 @@
         CALL iso_verif_traceur(xtwater(1,il,1), &
              'cv30_routine 3146')
-        if (iso_verif_traceur_choix_nostop(xtprecip(1,il), &
+        IF (iso_verif_traceur_choix_nostop(xtprecip(1,il), &
                  'cv30_routine 3147',errmax*1e2, &
-             errmaxrel,ridicule_trac,deltalimtrac).eq.1) THEN
+             errmaxrel,ridicule_trac,deltalimtrac).EQ.1) THEN
           WRITE(*,*) 'il,inb(il)=',il,inb(il)
           WRITE(*,*) 'xtwater(:,il,1)=',xtwater(:,il,1)
@@ -3633,5 +3633,5 @@
          ! cam verif
 #ifdef ISOVERIF          
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(xtprecip(iso_eau,il), &
                  precip(il),'cv30_routines 3139', &
@@ -3795,5 +3795,5 @@
         ! calcule R_tmp.
         dq_tmp=0.01*grav*am(il)*(rr(il,2)-rr(il,1))*work(il)*delt ! utile ci-dessous
-        if ((dq_tmp/rr(il,1).lt.-0.9).and.correction_excess_aberrant) THEN
+        IF ((dq_tmp/rr(il,1).lt.-0.9).AND.correction_excess_aberrant) THEN
                 ! nouvelle formulation ou on fait d'abord entrer k*q2 et ensuite
                 ! seulement on fait sortir k*q1 sans changement de composition
@@ -3810,5 +3810,5 @@
                        + dx_tmp/delt
 #ifdef ISOVERIF
-                if (ixt.eq.iso_HDO) THEN
+                IF (ixt.EQ.iso_HDO) THEN
                 WRITE(*,*) 'cv30_routines 3888: il=',il
                 WRITE(*,*) 'dq_tmp,rr(il,1)=',dq_tmp,rr(il,1)
@@ -3824,8 +3824,8 @@
                 WRITE(*,*) 'formule classique: fxt_Am=',0.01*grav*am(il)*(xt(ixt,il,2)-xt(ixt,il,1))*work(il)
                 WRITE(*,*) 'donnerait dxt=',0.01*grav*am(il)*(xt(ixt,il,2)-xt(ixt,il,1))*work(il)*delt
-                endif !if (ixt.eq.iso_HDO) THEN
+                endif !if (ixt.EQ.iso_HDO) THEN
 #endif
 #ifdef DIAGISO
-                if (ixt.le.niso) THEN
+                IF (ixt.le.niso) THEN
                         fxt_fluxmasse(ixt,il,1)=fxt_fluxmasse(ixt,il,1) &
                        + dx_tmp/delt
@@ -3840,5 +3840,5 @@
              +0.01*grav*am(il)*(xt(ixt,il,2)-xt(ixt,il,1))*work(il)
 #ifdef DIAGISO
-                if (ixt.le.niso) THEN
+                IF (ixt.le.niso) THEN
                 fxt_fluxmasse(ixt,il,1)=fxt_fluxmasse(ixt,il,1) &
             +0.01*grav*am(il)*(xt(ixt,il,2)-xt(ixt,il,1))*work(il)
@@ -3849,5 +3849,5 @@
        ! cam verif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,1), &
                  fr(il,1),'cv30_routines 3251', &
@@ -3855,9 +3855,9 @@
           endif !if (iso_eau.gt.0) THEN
           !WRITE(*,*) 'il,am(il)=',il,am(il)
-          if ((iso_HDO.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND. &
                  (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN
-            if (iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,1) &
+            IF (iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,1) &
               +delt*fxt(iso_HDO,il,1))/(rr(il,1)+delt*fr(il,1)), &
-                 'cv30_yield 3125, ddft en 1').eq.1) THEN
+                 'cv30_yield 3125, ddft en 1').EQ.1) THEN
                 WRITE(*,*) 'il,rr(il,1),delt=',il,rr(il,1),delt
                 WRITE(*,*) 'deltaDxt=',deltaD(xt(iso_HDO,il,1)/rr(il,1))
@@ -3881,6 +3881,6 @@
           xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3395',1e-5) &
-                 .eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3395',1e-5) &
+                 .EQ.1) THEN
               WRITE(*,*) 'il=',il
               WRITE(*,*) 'delt,fxt(:,il,1)=',delt,fxt(:,il,1)
@@ -3943,10 +3943,10 @@
        ! cam verif
 #ifdef ISOVERIF         
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,1), &
                  fr(il,1),'cv30_routines 3023', &
                  errmax,errmaxrel)
           endif !if (iso_eau.gt.0) THEN
-          if ((iso_HDO.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND. &
                  (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN
            CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,1) &
@@ -3961,7 +3961,7 @@
           xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew, &
+        IF (iso_verif_tracpos_choix_nostop(xtnew, &
                  'cv30_yield 3449',1e-5) &
-                 .eq.1) THEN
+                 .EQ.1) THEN
               WRITE(*,*) 'il=',il
               WRITE(*,*) 'delt,fxt(:,il,1)=',delt,fxt(:,il,1)
@@ -3991,5 +3991,5 @@
   ! :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
   ! :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
-  ! endif
+  ! END IF
   ! enddo
   ! enddo
@@ -4029,9 +4029,9 @@
        ! cam verif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,1), &
                  fr(il,1),'cv30_routines 3251',errmax,errmaxrel)
           endif !if (iso_eau.gt.0) THEN
-          if ((iso_HDO.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND. &
                  (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN
            CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,1) &
@@ -4044,6 +4044,6 @@
           xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3525',1e-5) &
-                 .eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3525',1e-5) &
+                 .EQ.1) THEN
               WRITE(*,*) 'il=',il
               WRITE(*,*) 'delt,fxt(:,il,1)=',delt,fxt(:,il,1)
@@ -4089,9 +4089,9 @@
        ! cam verif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,1), &
                  fr(il,1),'cv30_routines 3092',errmax,errmaxrel)
           endif !if (iso_eau.gt.0) THEN
-          if ((iso_HDO.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND. &
                  (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN
            CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,1) &
@@ -4104,6 +4104,6 @@
           xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3753',1e-5) &
-                 .eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3753',1e-5) &
+                 .EQ.1) THEN
               WRITE(*,*) 'il=',il
         endif
@@ -4128,7 +4128,7 @@
   ! ftra(il,1,k)=ftra(il,1,k)+0.1*work(il)*ment(il,j,1)
   ! :                *(traent(il,j,1,k)-tra(il,1,k))
-  ! endif
-
-  ! endif
+  ! END IF
+
+  ! END IF
   ! enddo
   ! enddo
@@ -4245,5 +4245,5 @@
                  -ad(il)*(rr(il,i)-rr(il,i-1)))*delt
        ! c'est equivalent a dqi= kamp1*qip1+kad*qim1-(kamp1+kad)*qi
-       if ((dq_tmp/rr(il,i).lt.-0.9).and.correction_excess_aberrant) THEN
+       IF ((dq_tmp/rr(il,i).lt.-0.9).AND.correction_excess_aberrant) THEN
         ! nouvelle formulation
         k_tmp=0.01*grav*dpinv*amp1(il)*delt
@@ -4255,5 +4255,5 @@
             fxt(ixt,il,i)= dx_tmp/delt
 #ifdef ISOVERIF
-                if ((ixt.eq.iso_HDO).or.(ixt.eq.iso_eau)) THEN
+                IF ((ixt.EQ.iso_HDO).OR.(ixt.EQ.iso_eau)) THEN
                 WRITE(*,*) 'cv30_routines 4367: il,i,ixt=',il,i,ixt
                 WRITE(*,*) 'dq_tmp,rr(il,i)=',dq_tmp,rr(il,i)
@@ -4268,5 +4268,5 @@
                          xt(ixt,il,i)+fxt(ixt,il,i)*delt
                 WRITE(*,*) 'fxt(:,il,i)=',fxt(:,il,i)
-                endif !if (ixt.eq.iso_HDO) THEN
+                endif !if (ixt.EQ.iso_HDO) THEN
 #endif 
         enddo ! do ixt = 1, ntraciso  
@@ -4293,5 +4293,5 @@
        ! cam verif
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), &
                  fr(il,i),'cv30_routines 3226',errmax,errmaxrel)
@@ -4300,5 +4300,5 @@
             CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3229')
         enddo
-        if ((iso_HDO.gt.0).and. &
+        IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
          CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,i) &
@@ -4307,5 +4307,5 @@
                  'cv30_yield 3384, flux masse')
         endif !if (iso_HDO.gt.0) THEN
-        if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
+        IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
          CALL iso_verif_O18_aberrant( &
@@ -4319,6 +4319,6 @@
           xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3727',1e-5) &
-                 .eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3727',1e-5) &
+                 .EQ.1) THEN
               WRITE(*,*) 'il,i=',il,i
               WRITE(*,*) 'fxt(:,il,i)=',fxt(:,il,i)
@@ -4362,5 +4362,5 @@
        ! cam verif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), &
                  fr(il,i),'cv30_routines 3252',errmax,errmaxrel)
@@ -4370,10 +4370,10 @@
           enddo
           ! correction 21 oct 2008
-          if ((iso_HDO.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
          CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,i) &
              +delt*fxt(iso_HDO,il,i))/(rr(il,i)+delt*fr(il,i)), &
              'cv30_yield 3384b flux masse')
-        if (iso_O18.gt.0) THEN
+        IF (iso_O18.gt.0) THEN
           CALL iso_verif_O18_aberrant( &
                  (xt(iso_HDO,il,i)+delt*fxt(iso_HDO,il,i)) &
@@ -4389,6 +4389,6 @@
           xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3775',1e-5) &
-                 .eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3775',1e-5) &
+                 .EQ.1) THEN
               WRITE(*,*) 'il,i=',il,i
         endif
@@ -4415,6 +4415,6 @@
     ! :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
     ! :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
-    ! endif
-    ! endif
+    ! END IF
+    ! END IF
     ! enddo
     ! enddo
@@ -4439,5 +4439,5 @@
         ! ce surplus a la meme compo que le elij, sans fractionnement.
         ! d'ou le nouveau traitement ci-dessous.
-      if (elij(il,k,i).gt.0.0) THEN
+      IF (elij(il,k,i).gt.0.0) THEN
         do ixt = 1, ntraciso
           xtawat(ixt)=awat*(xtelij(ixt,il,k,i)/elij(il,k,i))
@@ -4457,5 +4457,5 @@
       ! cam verif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(xtawat(iso_eau), &
                  awat,'cv30_routines 3301',errmax,errmaxrel)
@@ -4501,5 +4501,5 @@
       ! cam verif
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), &
                  fr(il,i),'cv30_routines 3325',errmax,errmaxrel)
@@ -4508,10 +4508,10 @@
             CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3328')
         enddo
-        if ((iso_HDO.gt.0).and. &
+        IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
-        if (iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,i) &
+        IF (iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,i) &
                  +delt*fxt(iso_HDO,il,i)) &
                  /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3396a, dtr mels') &
-                 .eq.1) THEN
+                 .EQ.1) THEN
            WRITE(*,*) 'il,k,i=',il,k,i
            WRITE(*,*) 'rr,delt,fr=',rr(il,i),delt,fr(il,i)
@@ -4536,5 +4536,5 @@
 !           stop
         endif
-        if (iso_O18.gt.0) THEN
+        IF (iso_O18.gt.0) THEN
           CALL iso_verif_O18_aberrant( &
                  (xt(iso_HDO,il,i)+delt*fxt(iso_HDO,il,i)) &
@@ -4550,6 +4550,6 @@
           xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3905',1e-5) &
-                 .eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3905',1e-5) &
+                 .EQ.1) THEN
               WRITE(*,*) 'il,i=',il,i
          endif
@@ -4591,5 +4591,5 @@
       ! cam verif
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), &
                  fr(il,i),'cv30_routines 3350',errmax,errmaxrel)
@@ -4598,5 +4598,5 @@
             CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3353')
         enddo
-        if ((iso_HDO.gt.0).and. &
+        IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
          CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,i) &
@@ -4604,5 +4604,5 @@
                  /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3396b, dtr mels')
         endif !if (iso_HDO.gt.0) THEN
-        if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
+        IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
          CALL iso_verif_O18_aberrant( &
@@ -4616,6 +4616,6 @@
           xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3949',1e-5) &
-                 .eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3949',1e-5) &
+                 .EQ.1) THEN
               WRITE(*,*) 'il,i=',il,i
          endif
@@ -4647,6 +4647,6 @@
     ! ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
     ! :        *(traent(il,k,i,j)-tra(il,i,j))
-    ! endif
-    ! endif
+    ! END IF
+    ! END IF
     ! enddo
     ! enddo
@@ -4689,5 +4689,5 @@
        ! cam verif
 #ifdef ISOVERIF
-        if ((il.eq.1636).and.(i.eq.9)) THEN
+        IF ((il.EQ.1636).AND.(i.EQ.9)) THEN
                 WRITE(*,*) 'cv30 4785: on ajoute le dtr ici:'
                 WRITE(*,*) 'M=',0.01*grav*dpinv*ment(il, k, i)
@@ -4703,5 +4703,5 @@
 #endif        
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), &
                  fr(il,i),'cv30_routines 3408',errmax,errmaxrel)
@@ -4710,9 +4710,9 @@
             CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3411')
         enddo
-        if (1.eq.0) THEN
-        if ((iso_HDO.gt.0).and.(delt*fr(il,i).gt.ridicule)) THEN
-              if (iso_verif_aberrant_enc_nostop( &
+        IF (1.EQ.0) THEN
+        IF ((iso_HDO.gt.0).AND.(delt*fr(il,i).gt.ridicule)) THEN
+              IF (iso_verif_aberrant_enc_nostop( &
                  fxt(iso_HDO,il,i)/fr(il,i), &
-                 'cv30_yield 3572, dtr mels').eq.1) THEN
+                 'cv30_yield 3572, dtr mels').EQ.1) THEN
                 WRITE(*,*) 'i,icb(il),inb(il)=',i,icb(il),inb(il)
                 WRITE(*,*) 'fr(il,i)=',fr(il,i)
@@ -4722,11 +4722,11 @@
                endif
         endif !if (iso_HDO.gt.0) THEN
-        endif !if (1.eq.0) THEN
-        if ((iso_HDO.gt.0).and. &
+        endif !if (1.EQ.0) THEN
+        IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
          CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,i) &
                  +delt*fxt(iso_HDO,il,i)) &
                  /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3605, dtr mels')
-        if (iso_O18.gt.0) THEN
+        IF (iso_O18.gt.0) THEN
           CALL iso_verif_O18_aberrant( &
                  (xt(iso_HDO,il,i)+delt*fxt(iso_HDO,il,i)) &
@@ -4735,5 +4735,5 @@
                  /(rr(il,i)+delt*fr(il,i)), &
                  'cv30_yield 3605O18, dtr mels')
-          if ((il.eq.1636).and.(i.eq.9)) THEN
+          IF ((il.EQ.1636).AND.(i.EQ.9)) THEN
           CALL iso_verif_O18_aberrant( &
                  (xt(iso_HDO,il,i)+delt*(fxt(iso_HDO,il,i)-xtbx(iso_HDO))) &
@@ -4742,5 +4742,5 @@
                  /(rr(il,i)+delt*(fr(il,i)-bx)), &
                  'cv30_yield 3605O18_nobx, dtr mels')
-           endif !if ((il.eq.1636).and.(i.eq.9)) THEN
+           endif !if ((il.EQ.1636).AND.(i.EQ.9)) THEN
         endif !if (iso_O18.gt.0) THEN
         endif !if (iso_HDO.gt.0) THEN
@@ -4750,6 +4750,6 @@
           xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4036',1e-5) &
-                 .eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4036',1e-5) &
+                 .EQ.1) THEN
               WRITE(*,*) 'il,i=',il,i
          endif
@@ -4790,10 +4790,10 @@
        ! cam verif
 #ifdef ISOVERIF
-          if ((il.eq.1636).and.(i.eq.9)) THEN
+          IF ((il.EQ.1636).AND.(i.EQ.9)) THEN
                 WRITE(*,*) 'cv30 4785b: on ajoute le dtr ici:'
                 WRITE(*,*) 'M=',0.1*dpinv*ment(il, k, i)
                 WRITE(*,*) 'q,qe=',rr(il,i),qent(il,k,i)
           endif
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), &
                  fr(il,i),'cv30_routines 3433',errmax,errmaxrel)
@@ -4802,13 +4802,13 @@
             CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3436')
           enddo
-          if ((iso_HDO.gt.0).and.(delt*fr(il,i).gt.ridicule)) THEN
-              if (iso_verif_aberrant_enc_nostop( &
+          IF ((iso_HDO.gt.0).AND.(delt*fr(il,i).gt.ridicule)) THEN
+              IF (iso_verif_aberrant_enc_nostop( &
                  fxt(iso_HDO,il,i)/fr(il,i), &
-                 'cv30_yield 3597').eq.1) THEN
+                 'cv30_yield 3597').EQ.1) THEN
                 WRITE(*,*) 'i,icb(il),inb(il)=',i,icb(il),inb(il)
                 stop
                endif
           endif !if (iso_HDO.gt.0) THEN
-          if ((iso_HDO.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,i) &
@@ -4821,6 +4821,6 @@
           xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4091',1e-5) &
-                 .eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4091',1e-5) &
+                 .EQ.1) THEN
               WRITE(*,*) 'il,i=',il,i
          endif
@@ -4838,5 +4838,5 @@
     ! do k=i,nl+1
     ! do il=1,ncum
-    ! if (i.le.inb(il) .and. k.le.inb(il)) THEN
+    ! if (i.le.inb(il) .AND. k.le.inb(il)) THEN
     ! dpinv=1.0/(ph(il,i)-ph(il,i+1))
     ! cpinv=1.0/cpn(il,i)
@@ -4847,6 +4847,6 @@
     ! ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
     ! :             *(traent(il,k,i,j)-tra(il,i,j))
-    ! endif
-    ! endif ! i and k
+    ! END IF
+    ! END IF ! i and k
     ! enddo
     ! enddo
@@ -4898,25 +4898,25 @@
            CALL iso_verif_noNaN(fxt(ixt,il,i),'cv30_yield 4515')
         enddo
-        if ((iso_HDO.gt.0).and. &
+        IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
-        if (iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,i) &
+        IF (iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,i) &
                  +delt*fxt(iso_HDO,il,i)) &
                  /(rr(il,i)+delt*fr(il,i)),'cv30_yield 4175') &
-                 .eq.1) THEN
+                 .EQ.1) THEN
         WRITE(*,*) 'il,i=',il,i
-        if (rr(il,i).ne.0.0) THEN
+        IF (rr(il,i).NE.0.0) THEN
         WRITE(*,*) 'il,i,rr,deltaD=',il,i,rr(il,i),deltaD &
                  (xt(iso_HDO,il,i)/rr(il,i))
         endif
-        if (fr(il,i).ne.0.0) THEN
+        IF (fr(il,i).NE.0.0) THEN
         WRITE(*,*) 'fr,fxt,deltaD=',fr(il,i),fxt(iso_HDO,il,i), &
                  deltaD(fxt(iso_HDO,il,i)/fr(il,i))
         endif
 #ifdef DIAGISO        
-        if (fq_ddft(il,i).ne.0.0) THEN
+        IF (fq_ddft(il,i).NE.0.0) THEN
         WRITE(*,*) 'fq_ddft,deltaD=',fq_ddft(il,i),deltaD( &
                  fxt_ddft(iso_HDO,il,i)/fq_ddft(il,i))
         endif
-        if (fq_evapprecip(il,i).ne.0.0) THEN
+        IF (fq_evapprecip(il,i).NE.0.0) THEN
         WRITE(*,*) 'fq_evapprecip,deltaD=',fq_evapprecip(il,i),deltaD( &
                  fxt_evapprecip(iso_HDO,il,i)/fq_evapprecip(il,i))
@@ -4937,5 +4937,5 @@
         endif
         endif !if (iso_HDO.gt.0) THEN
-        if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
+        IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
          CALL iso_verif_O18_aberrant( &
@@ -4943,5 +4943,5 @@
              (xt(iso_O18,il,i)+delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)), &
              'cv30_yield 5029,O18, evap')
-          if ((il.eq.1636).and.(i.eq.9)) THEN
+          IF ((il.EQ.1636).AND.(i.EQ.9)) THEN
             WRITE(*,*) 'cv30_yield 5057: ici, on verifie deltaD_nobx'
             WRITE(*,*) 'il,i=',il,i
@@ -4958,10 +4958,10 @@
                  /(rr(il,i)+delt*(fr(il,i)-bx)), &
                 'cv30_yield 5029_nobx,O18, evap, no bx')
-          endif !if ((il.eq.1636).and.(i.eq.9)) THEN
+          endif !if ((il.EQ.1636).AND.(i.EQ.9)) THEN
           endif !if (iso_HDO.gt.0) THEN
 #endif
 
 #ifdef ISOTRAC
-        if ((option_traceurs.ne.6).and.(option_traceurs.ne.19)) THEN
+        IF ((option_traceurs.NE.6).AND.(option_traceurs.NE.19)) THEN
             ! facile: on fait comme l'eau
             do ixt = 1+niso,ntraciso
@@ -5001,9 +5001,9 @@
 !        WRITE(*,*) 'tmp cv3_yield 4165: i,il=',i,il
 
-        if (option_traceurs.eq.6) THEN
+        IF (option_traceurs.EQ.6) THEN
           do iiso = 1, niso
              
              ixt_ddft=itZonIso(izone_ddft,iiso)  
-             if (mp(il,i).gt.mp(il,i+1)) THEN
+             IF (mp(il,i).gt.mp(il,i+1)) THEN
                 fxtYe(iiso)=0.01*grav*dpinv*mp(il,i) &
                  *(xt(ixt_ddft,il,i-1)-xt(ixt_ddft,il,i))
@@ -5023,6 +5023,6 @@
          enddo !do iiso = 1, niso
 
-         else !if (option_traceurs.eq.6) THEN
-            if (mp(il,i).gt.mp(il,i+1)) THEN
+         else !if (option_traceurs.EQ.6) THEN
+            IF (mp(il,i).gt.mp(il,i+1)) THEN
                 ! cas entrainant: faire attention
                 
@@ -5047,12 +5047,12 @@
                 Xe(iiso)=xt(iiso,il,i) &
                          -xt(ixt_ddft,il,i)-xt(ixt_revap,il,i)
-                if (Xe(iiso).gt.ridicule) THEN
+                IF (Xe(iiso).gt.ridicule) THEN
                   do izone=1,nzone
-                   if ((izone.ne.izone_revap).and. &
-                         (izone.ne.izone_ddft)) THEN
+                   IF ((izone.NE.izone_revap).AND. &
+                         (izone.NE.izone_ddft)) THEN
                     ixt=itZonIso(izone,iiso) 
                     fxt(ixt,il,i)=fxt(ixt,il,i) &
                          +xt(ixt,il,i)/Xe(iiso)*fxtXe(iiso)
-                   endif !if ((izone.ne.izone_revap).and.
+                   endif !if ((izone.NE.izone_revap).AND.
                   enddo !do izone=1,nzone   
 #ifdef ISOVERIF
@@ -5071,5 +5071,5 @@
                     
 #ifdef ISOVERIF
-                if (delt*fxtXe(iiso).gt.ridicule) THEN
+                IF (delt*fxtXe(iiso).gt.ridicule) THEN
                    WRITE(*,*) 'cv30_routines 6563: delt*fxtXe(iiso)=', &
                                 delt*fxtXe(iiso)
@@ -5078,13 +5078,13 @@
 #endif                   
                 do izone=1,nzone
-                   if ((izone.ne.izone_revap).and. &
-                         (izone.ne.izone_ddft)) THEN
+                   IF ((izone.NE.izone_revap).AND. &
+                         (izone.NE.izone_ddft)) THEN
                     ixt=itZonIso(izone,iiso) 
-                    if (izone.eq.izone_poubelle) THEN
+                    IF (izone.EQ.izone_poubelle) THEN
                       fxt(ixt,il,i)=fxt(ixt,il,i)+fxtXe(iiso)
-                    else !if (izone.eq.izone_poubelle) THEN
+                    else !if (izone.EQ.izone_poubelle) THEN
                         ! pas de tendance pour ce tag la
-                    endif !if (izone.eq.izone_poubelle) THEN
-                   endif !if ((izone.ne.izone_revap).and.
+                    endif !if (izone.EQ.izone_poubelle) THEN
+                   endif !if ((izone.NE.izone_revap).AND.
                 enddo !do izone=1,nzone
 #ifdef ISOVERIF
@@ -5108,10 +5108,10 @@
 #endif                
             endif !if (mp(il,i).gt.mp(il,i+1)) THEN
-          endif !if (option_traceurs.eq.6) THEN
+          endif !if (option_traceurs.EQ.6) THEN
 !          WRITE(*,*) 'delt*conversion=',delt*conversion(iso_eau)
 !           WRITE(*,*) 'delt*fxtYe=',delt*fxtYe(iso_eau)
 !           WRITE(*,*) 'delt*fxtqe=',delt*fxtqe(iso_eau)
 
-        endif ! if ((option_traceurs.ne.6).and.(option_traceurs.ne.19)) THEN
+        endif ! if ((option_traceurs.NE.6).AND.(option_traceurs.NE.19)) THEN
 #endif
         
@@ -5123,35 +5123,35 @@
 #endif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), &
                  fr(il,i),'cv30_routines 3493',errmax,errmaxrel)
           endif !if (iso_eau.gt.0) THEN
-          if (1.eq.0) THEN
-          if ((iso_HDO.gt.0).and.(delt*fr(il,i).gt.ridicule)) THEN
-              if (iso_verif_aberrant_enc_nostop( &
+          IF (1.EQ.0) THEN
+          IF ((iso_HDO.gt.0).AND.(delt*fr(il,i).gt.ridicule)) THEN
+              IF (iso_verif_aberrant_enc_nostop( &
                  fxt(iso_HDO,il,i)/fr(il,i), &
-                 'cv30_yield 3662').eq.1) THEN
+                 'cv30_yield 3662').EQ.1) THEN
                 WRITE(*,*) 'il,i,icb(il),inb(il)=',il,i,icb(il),inb(il)
                 WRITE(*,*) 'fr(il,i),delt=',fr(il,i),delt
 #ifdef DIAGISO                        
-                if (fq_ddft(il,i).ne.0.0) THEN
+                IF (fq_ddft(il,i).NE.0.0) THEN
                 WRITE(*,*) 'fq_ddft,deltaD=',fq_ddft(il,i),deltaD( &
                    fxt_ddft(iso_HDO,il,i)/fq_ddft(il,i))
-                endif !if (fq_ddft(il,i).ne.0.0) THEN
-                if (fq_evapprecip(il,i).ne.0.0) THEN
+                endif !if (fq_ddft(il,i).NE.0.0) THEN
+                IF (fq_evapprecip(il,i).NE.0.0) THEN
                 WRITE(*,*) 'fq_evapprecip,deltaD=',fq_evapprecip(il,i), &
                    deltaD(fxt_evapprecip(iso_HDO,il,i) &
                    /fq_evapprecip(il,i))
-                endif !if (fq_evapprecip(il,i).ne.0.0) THEN
+                endif !if (fq_evapprecip(il,i).NE.0.0) THEN
 #endif                
                endif !if (iso_verif_aberrant_enc_nostop(
           endif !if (iso_HDO.gt.0) THEN
-          endif !if (1.eq.0) THEN
-          if ((iso_HDO.gt.0).and. &
+          endif !if (1.EQ.0) THEN
+          IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
-           if (iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,i) &
+           IF (iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,i) &
                  +delt*fxt(iso_HDO,il,i)) &
                  /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3757, ddfts') &
-                 .eq.1) THEN
+                 .EQ.1) THEN
                 WRITE(*,*) 'i,il,q,deltaD=',i,il,rr(il,i),deltaD( &
                    xt(iso_HDO,il,i)/rr(il,i))
@@ -5161,5 +5161,5 @@
             endif ! if (iso_verif_aberrant_enc_nostop
         endif !if (iso_HDO.gt.0) THEN
-        if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
+        IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
          CALL iso_verif_O18_aberrant( &
@@ -5174,6 +5174,6 @@
           xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew, &
-                        'cv30_yield 4221',1e-5).eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew, &
+                        'cv30_yield 4221',1e-5).EQ.1) THEN
           WRITE(*,*) 'delt*fxt(,il,i)=',delt*fxt(1:ntraciso:2,il,i)
           WRITE(*,*) 'delt*fxt(,il,i)=',delt*fxt(:,il,i)
@@ -5213,5 +5213,5 @@
 
 #ifdef ISOTRAC        
-        if (option_traceurs.ne.6) THEN
+        IF (option_traceurs.NE.6) THEN
             ! facile: on fait comme l'eau
             do ixt = 1+niso,ntraciso
@@ -5222,5 +5222,5 @@
             enddo !do ixt = 1+niso,ntraciso
 
-        else  !if (option_traceurs.ne.6) THEN
+        else  !if (option_traceurs.NE.6) THEN
             ! taggage des ddfts:  voir blabla + haut
         do ixt = 1+niso,ntraciso
@@ -5238,5 +5238,5 @@
              ixt_poubelle=itZonIso(izone_poubelle,iiso)
              ixt_ddft=itZonIso(izone_ddft,iiso)  
-             if (mp(il,i).gt.mp(il,i+1)) THEN
+             IF (mp(il,i).gt.mp(il,i+1)) THEN
                 fxtYe(iiso)=0.01*grav*dpinv*mp(il,i) &
                  *(xt(ixt_ddft,il,i-1)-xt(ixt_ddft,il,i))
@@ -5256,5 +5256,5 @@
 !           WRITE(*,*) 'delt*fxtYe=',delt*fxtYe(iso_eau)
 !           WRITE(*,*) 'delt*fxtqe=',delt*fxtqe(iso_eau)
-        endif !if (option_traceurs.eq.6) THEN
+        endif !if (option_traceurs.EQ.6) THEN
 #endif       
 
@@ -5282,17 +5282,17 @@
 #endif        
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), &
                  fr(il,i),'cv30_routines 3522',errmax,errmaxrel)
           endif !if (iso_eau.gt.0) THEN
-          if ((iso_HDO.gt.0).and.(delt*fr(il,i).gt.ridicule)) THEN
-              if (iso_verif_aberrant_enc_nostop( &
+          IF ((iso_HDO.gt.0).AND.(delt*fr(il,i).gt.ridicule)) THEN
+              IF (iso_verif_aberrant_enc_nostop( &
                  fxt(iso_HDO,il,i)/fr(il,i), &
-                 'cv30_yield 3690').eq.1) THEN
+                 'cv30_yield 3690').EQ.1) THEN
                 WRITE(*,*) 'i,icb(il),inb(il)=',i,icb(il),inb(il)
                 stop
                endif
           endif !if (iso_HDO.gt.0) THEN
-          if ((iso_HDO.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,i) &
@@ -5300,5 +5300,5 @@
                 /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3757b, ddfts')
           endif !if (iso_HDO.gt.0) THEN
-          if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_O18_aberrant( &
@@ -5312,6 +5312,6 @@
           xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4295',1e-5) &
-                 .eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4295',1e-5) &
+                 .EQ.1) THEN
               WRITE(*,*) 'il,i=',il,i
          endif
@@ -5367,6 +5367,6 @@
     ! :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
     ! :     -mp(il,i)*(trap(il,i,j)-tra(il,i-1,j)))
-    ! endif
-    ! endif ! i
+    ! END IF
+    ! END IF ! i
     ! enddo
     ! enddo
@@ -5486,5 +5486,5 @@
         CALL iso_verif_noNaN(fxt(ixt,il,inb(il)),'cv30_yield 5083')
        enddo
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,inb(il)), &
                  fr(il,inb(il)),'cv30_routines 3638',errmax,errmaxrel)
@@ -5492,5 +5492,5 @@
                  fr(il,inb(il)-1),'cv30_routines 3640',errmax,errmaxrel)
           endif !if (iso_eau.gt.0) THEN
-          if ((iso_HDO.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND. &
              (rr(il,inb(il))+delt*fr(il,inb(il)).gt.ridicule)) THEN
            CALL iso_verif_aberrant_encadre( &
@@ -5498,11 +5498,11 @@
                /(rr(il,inb(il))+delt*fr(il,inb(il))), &
                  'cv30_yield 3921, en inb')
-              if (iso_O18.gt.0) THEN
-                if (iso_verif_O18_aberrant_nostop( &
+              IF (iso_O18.gt.0) THEN
+                IF (iso_verif_O18_aberrant_nostop( &
                  (xt(iso_HDO,il,inb(il))+delt*fxt(iso_HDO,il,inb(il))) &
                  /(rr(il,inb(il))+delt*fr(il,inb(il))), &
                  (xt(iso_O18,il,inb(il))+delt*fxt(iso_O18,il,inb(il))) &
                  /(rr(il,inb(il))+delt*fr(il,inb(il))), &
-                 'cv30_yield 3921O18, en inb').eq.1) THEN
+                 'cv30_yield 3921O18, en inb').EQ.1) THEN
                         WRITE(*,*) 'il,inb(il)=',il,inb(il)
                         k_tmp=0.1*ment(il,inb(il),inb(il))/(ph(il,inb(il))-ph(il,inb(il)+1))
@@ -5519,5 +5519,5 @@
             endif !if (iso_O18.gt.0) THEN
           endif !if (iso_HDO.gt.0) THEN
-          if ((iso_HDO.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND. &
              (rr(il,inb(il)-1)+delt*fr(il,inb(il)-1).gt.ridicule)) THEN
            CALL iso_verif_aberrant_encadre( &
@@ -5526,5 +5526,5 @@
                /(rr(il,inb(il)-1)+delt*fr(il,inb(il)-1)), &
                  'cv30_yield 3921b, en inb-1')
-              if (iso_O18.gt.0) THEN
+              IF (iso_O18.gt.0) THEN
                 CALL iso_verif_O18_aberrant( &
                  (xt(iso_HDO,il,inb(il)-1)+delt*fxt(iso_HDO,il,inb(il)-1)) &
@@ -5543,6 +5543,6 @@
           xtnew(ixt)=xt(ixt,il,inb(il))+delt*fxt(ixt,il,inb(il))
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4492',1e-5) &
-                 .eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4492',1e-5) &
+                 .EQ.1) THEN
               WRITE(*,*) 'il,i=',il,i
          endif
@@ -5615,15 +5615,15 @@
         fr(il, i) = bsum(il)/csum(il)
 #ifdef ISO
-        if (abs(csum(il)).gt.0.0) THEN
+        IF (abs(csum(il)).gt.0.0) THEN
           do ixt=1,ntraciso
             fxt(ixt,il,i)=bxtsum(ixt,il)/csum(il)            
           enddo
         else !if (frsum(il).gt.ridicule) THEN
-           if (abs(frsum(il)).gt.0.0) THEN
+           IF (abs(frsum(il)).gt.0.0) THEN
             do ixt=1,ntraciso
              fxt(ixt,il,i)=fr(il,i)*fxtsum(ixt,il)/frsum(il)        
             enddo 
            else !if (abs(frsum(il)).gt.0.0) THEN
-             if (abs(fr(il,i))*delt.gt.ridicule) THEN
+             IF (abs(fr(il,i))*delt.gt.ridicule) THEN
                WRITE(*,*) 'cv30_yield 4048: fr(il,i)=',fr(il,i)
                stop 
@@ -5632,5 +5632,5 @@
                  fxt(ixt,il,i)=0.0
                enddo
-               if (iso_eau.gt.0) THEN
+               IF (iso_eau.gt.0) THEN
                    fxt(iso_eau,il,i)=1.0
                endif
@@ -5662,15 +5662,15 @@
 !     :                           il,i,inb(il),ncum
 !                WRITE(*,*) 'cv30_routines 3974'
-                if (iso_eau.gt.0) THEN
+                IF (iso_eau.gt.0) THEN
                   CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), &
                     fr(il,i),'cv30_yield 3830',errmax,errmaxrel)
                 endif !if (iso_eau.gt.0) THEN
 !                WRITE(*,*) 'cv30_routines 3979'
-                if ((iso_HDO.gt.0).and. &
+                IF ((iso_HDO.gt.0).AND. &
                     (delt*fr(il,i).gt.ridicule)) THEN
-                    if (iso_verif_aberrant_enc_nostop( &
+                    IF (iso_verif_aberrant_enc_nostop( &
                          fxt(iso_HDO,il,i)/fr(il,i), &
-                        'cv30_yield 3834').eq.1) THEN
-                        if (fr(il,i).gt.ridicule*1e5) THEN
+                        'cv30_yield 3834').EQ.1) THEN
+                        IF (fr(il,i).gt.ridicule*1e5) THEN
                            WRITE(*,*) 'il,i,icb(il)=',il,i,icb(il)
                            WRITE(*,*) 'frsum(il)=',frsum(il)
@@ -5685,10 +5685,10 @@
                     endif   !if (iso_verif_aberrant_enc_nostop   
                 endif !if (iso_HDO.gt.0) THEN
-                if ((iso_HDO.gt.0).and. &
+                IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
-                  if (iso_verif_aberrant_enc_nostop( &
+                  IF (iso_verif_aberrant_enc_nostop( &
                 (xt(iso_HDO,il,i)+delt*fxt(iso_HDO,il,i)) &
                /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3921c, dans la CL') &
-                 .eq.1) THEN
+                 .EQ.1) THEN
                      WRITE(*,*) 'il,i,icb(il)=',il,i,icb(il)
                      WRITE(*,*) 'frsum(il)=',frsum(il)
@@ -5697,5 +5697,5 @@
                   endif
                endif !if (iso_HDO.gt.0) THEN
-        if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
+        IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
          CALL iso_verif_O18_aberrant( &
@@ -5719,9 +5719,9 @@
           do i=1,nl
              do il=1,ncum
-                if (iso_eau.gt.0) THEN
+                IF (iso_eau.gt.0) THEN
                   CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), &
                     fr(il,i),'cv30_yield 3830',errmax,errmaxrel)
                 endif !if (iso_eau.gt.0) THEN
-                if ((iso_HDO.gt.0).and. &
+                IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
                   CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,i) &
@@ -5730,5 +5730,5 @@
                  'cv30_yield 5710a, final')
                endif !if (iso_HDO.gt.0) THEN
-               if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
+               IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
                   CALL iso_verif_O18_aberrant( &
@@ -5804,5 +5804,5 @@
     DO k = i, nl
       DO il = 1, ncum
-        ! test         if (i.ge.icb(il).and.i.le.inb(il).and.k.le.inb(il))
+        ! test         if (i.ge.icb(il).AND.i.le.inb(il).AND.k.le.inb(il))
         ! THEN
         IF (i<=inb(il) .AND. k<=inb(il)) THEN
@@ -6101,7 +6101,7 @@
 
 #ifdef ISO
-    use infotrac_phy, ONLY: ntraciso=>ntiso
-#ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: Tmin_verif,iso_verif_aberrant, &
+    USE infotrac_phy, ONLY: ntraciso=>ntiso
+#ifdef ISOVERIF
+    USE isotopes_verif_mod, ONLY: Tmin_verif,iso_verif_aberrant, &
         iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
         iso_verif_egalite_nostop,iso_verif_aberrant_nostop,deltaD,iso_verif_noNaN_nostop, &
@@ -6141,6 +6141,6 @@
   REAL xtprecip(ntraciso,nloc)
   REAL xtvprecip(ntraciso,nloc, nd+1), xtevap(ntraciso,nloc, nd)
-  real fxt(ntraciso,nloc,nd)
-  real xtclw(ntraciso,nloc,nd)
+  REAL fxt(ntraciso,nloc,nd)
+  REAL xtclw(ntraciso,nloc,nd)
   REAL xtwdtraina(ntraciso,nloc, nd)
 #endif
@@ -6170,7 +6170,7 @@
   ! RomP <<<
 #ifdef ISO
-  real xtprecip1(ntraciso,len)
-  real fxt1(ntraciso,len,nd)
-  real xtVPrecip1(ntraciso,len,nd+1),xtevap1(ntraciso,len, nd)
+  REAL xtprecip1(ntraciso,len)
+  REAL fxt1(ntraciso,len,nd)
+  REAL xtVPrecip1(ntraciso,len,nd+1),xtevap1(ntraciso,len, nd)
   REAL xtwdtraina1(ntraciso,len, nd)
   REAL xtclw1(ntraciso,len, nd)
@@ -6180,37 +6180,37 @@
   INTEGER i, k, j
 #ifdef ISO
-      integer ixt
+      INTEGER ixt
 #endif
 
 #ifdef DIAGISO
-      real water(nloc,nd)
-      real xtwater(ntraciso,nloc,nd)
-      real qp(nloc,nd),xtp(ntraciso,nloc,nd)
-      real fq_detrainement(nloc,nd)
-      real f_detrainement(nloc,nd)
-      real q_detrainement(nloc,nd)
-      real fq_ddft(nloc,nd)
-      real fq_fluxmasse(nloc,nd)
-      real fq_evapprecip(nloc,nd)
-      real fxt_detrainement(ntraciso,nloc,nd)
-      real xt_detrainement(ntraciso,nloc,nd)
-      real fxt_ddft(ntraciso,nloc,nd)
-      real fxt_fluxmasse(ntraciso,nloc,nd)
-      real fxt_evapprecip(ntraciso,nloc,nd)
-
-      real water1(len,nd)
-      real xtwater1(ntraciso,len,nd)
-      real qp1(len,nd),xtp1(ntraciso,len,nd)
-      real fq_detrainement1(len,nd)
-      real f_detrainement1(len,nd)
-      real q_detrainement1(len,nd)
-      real fq_ddft1(len,nd)
-      real fq_fluxmasse1(len,nd)
-      real fq_evapprecip1(len,nd)
-      real fxt_detrainement1(ntraciso,len,nd)
-      real xt_detrainement1(ntraciso,len,nd)
-      real fxt_ddft1(ntraciso,len,nd)
-      real fxt_fluxmasse1(ntraciso,len,nd)
-      real fxt_evapprecip1(ntraciso,len,nd)
+      REAL water(nloc,nd)
+      REAL xtwater(ntraciso,nloc,nd)
+      REAL qp(nloc,nd),xtp(ntraciso,nloc,nd)
+      REAL fq_detrainement(nloc,nd)
+      REAL f_detrainement(nloc,nd)
+      REAL q_detrainement(nloc,nd)
+      REAL fq_ddft(nloc,nd)
+      REAL fq_fluxmasse(nloc,nd)
+      REAL fq_evapprecip(nloc,nd)
+      REAL fxt_detrainement(ntraciso,nloc,nd)
+      REAL xt_detrainement(ntraciso,nloc,nd)
+      REAL fxt_ddft(ntraciso,nloc,nd)
+      REAL fxt_fluxmasse(ntraciso,nloc,nd)
+      REAL fxt_evapprecip(ntraciso,nloc,nd)
+
+      REAL water1(len,nd)
+      REAL xtwater1(ntraciso,len,nd)
+      REAL qp1(len,nd),xtp1(ntraciso,len,nd)
+      REAL fq_detrainement1(len,nd)
+      REAL f_detrainement1(len,nd)
+      REAL q_detrainement1(len,nd)
+      REAL fq_ddft1(len,nd)
+      REAL fq_fluxmasse1(len,nd)
+      REAL fq_evapprecip1(len,nd)
+      REAL fxt_detrainement1(ntraciso,len,nd)
+      REAL xt_detrainement1(ntraciso,len,nd)
+      REAL fxt_ddft1(ntraciso,len,nd)
+      REAL fxt_fluxmasse1(ntraciso,len,nd)
+      REAL fxt_evapprecip1(ntraciso,len,nd)
 #endif
 
@@ -6345,17 +6345,17 @@
 
 ! inputs:
-      integer ncum, nd, nloc
-      integer icb(nloc), inb(nloc)
-      real cape(nloc)
-      real clw(nloc,nd),lv(nloc,nd),t(nloc,nd),h(nloc,nd)
-      integer nk(nloc)
+      INTEGER ncum, nd, nloc
+      INTEGER icb(nloc), inb(nloc)
+      REAL cape(nloc)
+      REAL clw(nloc,nd),lv(nloc,nd),t(nloc,nd),h(nloc,nd)
+      INTEGER nk(nloc)
 ! inouts:
-      real ep(nloc,nd)
-      real hp(nloc,nd)
+      REAL ep(nloc,nd)
+      REAL hp(nloc,nd)
 ! outputs ou local
-      real epmax_diag(nloc)
+      REAL epmax_diag(nloc)
 ! locals
-      integer i,k    
-      real hp_bak(nloc,nd)
+      INTEGER i,k
+      REAL hp_bak(nloc,nd)
       CHARACTER (LEN=20) :: modname='cv30_epmax_fn_cape'
       CHARACTER (LEN=80) :: abort_message
@@ -6363,5 +6363,5 @@
         ! on recalcule ep et hp
         
-        if (coef_epmax_cape.gt.1e-12) THEN
+        IF (coef_epmax_cape.gt.1e-12) THEN
         do i=1,ncum
            epmax_diag(i)=epmax-coef_epmax_cape*sqrt(cape(i))
@@ -6386,5 +6386,5 @@
       do k=minorig+1,nl
        do i=1,ncum
-        if((k.ge.icb(i)).and.(k.le.inb(i)))THEN
+        IF((k.ge.icb(i)).AND.(k.le.inb(i)))THEN
           hp(i,k)=h(i,nk(i))+(lv(i,k)+(cpd-cpv)*t(i,k))*ep(i,k)*clw(i,k)
         endif
@@ -6394,5 +6394,5 @@
       do i=1,ncum  
        do k=1,nl
-        if (abs(hp_bak(i,k)-hp(i,k)).gt.0.01) THEN
+        IF (abs(hp_bak(i,k)-hp(i,k)).gt.0.01) THEN
            WRITE(*,*) 'i,k=',i,k
            WRITE(*,*) 'coef_epmax_cape=',coef_epmax_cape
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_enthalpmix.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_enthalpmix.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_enthalpmix.F90	(revision 5117)
@@ -7,5 +7,5 @@
                        )
 #ifdef ISO
-    use infotrac_phy, ONLY: ntiso
+    USE infotrac_phy, ONLY: ntiso
 #endif
   ! **************************************************************
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_estatmix.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_estatmix.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_estatmix.F90	(revision 5117)
@@ -7,5 +7,5 @@
                        )
 #ifdef ISO
-    use infotrac_phy, ONLY: ntiso
+    USE infotrac_phy, ONLY: ntiso
 #endif
   ! **************************************************************
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_routines.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_routines.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_routines.F90	(revision 5117)
@@ -8,5 +8,5 @@
 
   USE lmdz_ioipsl_getin_p, ONLY: getin_p
-  use lmdz_phys_para
+  USE lmdz_phys_para
 
   IMPLICIT NONE
@@ -314,8 +314,8 @@
          )
 #ifdef ISO
-    use infotrac_phy, ONLY: ntraciso=>ntiso
+    USE infotrac_phy, ONLY: ntraciso=>ntiso
 #ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: iso_verif_positif,iso_verif_noNaN,iso_verif_egalite
-    use isotopes_mod, ONLY: iso_eau
+    USE isotopes_verif_mod, ONLY: iso_verif_positif,iso_verif_noNaN,iso_verif_egalite
+    USE isotopes_mod, ONLY: iso_eau
 #endif
 #endif
@@ -375,7 +375,7 @@
 
 #ifdef ISO
-      real xt(ntraciso,len,nd)
-      real xtnk(ntraciso,len) 
-      integer ixt  
+      REAL xt(ntraciso,len,nd)
+      REAL xtnk(ntraciso,len)
+      INTEGER ixt
 #endif
 !jyg20140217<
@@ -395,5 +395,5 @@
              CALL iso_verif_noNaN(xt(ixt,i,k),'cv3_feed 241')
            enddo ! do ixt=1,ntraciso 
-           if (iso_eau.gt.0) THEN
+           IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite(xt(iso_eau,i,k),q(i,k), &
                   'cv3_feed 399')
@@ -551,5 +551,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-       if (iso_eau.gt.0) THEN
+       IF (iso_eau.gt.0) THEN
          do i=1,len
             CALL iso_verif_egalite(xtnk(iso_eau,i),qnk(i), &
@@ -628,5 +628,5 @@
 !@      do 290 k=minorig,nl
 !@        do 280 i=1,len
-!@          if((k.ge.(nk(i)+1)).and.(p(i,k).lt.plcl(i)))
+!@          if((k.ge.(nk(i)+1)).AND.(p(i,k).lt.plcl(i)))
 !@     &    icb(i)=min(icb(i),k)
 !@ 280    continue
@@ -634,5 +634,5 @@
 !@c
 !@      do 300 i=1,len
-!@        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
+!@        if((icb(i).ge.nlm).AND.(iflag(i).EQ.0))iflag(i)=9
 !@ 300  continue
 
@@ -656,5 +656,5 @@
 
   DO i = 1, len
-!@        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
+!@        if((icb(i).ge.nlm).AND.(iflag(i).EQ.0))iflag(i)=9
     IF ((icb(i)==nlm) .AND. (iflag(i)==0)) iflag(i) = 9
   END DO
@@ -689,9 +689,9 @@
 USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall_trac
 #ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: iso_verif_traceur
+    USE isotopes_verif_mod, ONLY: iso_verif_traceur
 #endif
 #endif
 #ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif, &
+    USE isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif, &
         iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, &
         iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
@@ -726,5 +726,5 @@
 #ifdef ISO
       !integer niso
-      real xtnk(ntraciso,len)
+      REAL xtnk(ntraciso,len)
 #endif
 
@@ -733,5 +733,5 @@
   REAL, DIMENSION (len, nd), INTENT (OUT)           :: tp, tvp, clw
 #ifdef ISO
-      real xtclw(ntraciso,len,nd) 
+      REAL xtclw(ntraciso,len,nd)
 #endif
 
@@ -745,7 +745,7 @@
   REAL cpinv(len)                                                        ! convect3                                                      ! convect3
 #ifdef ISO
-      integer ixt
-      real zfice(len),zxtliq(ntraciso,len),zxtice(ntraciso,len)
-      real q_k(len),clw_k(len),tg_k(len),xt_k(ntraciso,len)
+      INTEGER ixt
+      REAL zfice(len),zxtliq(ntraciso,len),zxtice(ntraciso,len)
+      REAL q_k(len),clw_k(len),tg_k(len),xt_k(ntraciso,len)
 #endif
 
@@ -920,7 +920,7 @@
 #ifdef ISOVERIF
         WRITE(*,*) 'cv3_routine undilute 1 573: avant condiso'
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
          do i=1,len
-          if (qnk(i).gt.ridicule) THEN
+          IF (qnk(i).gt.ridicule) THEN
            CALL iso_verif_aberrant(xtnk(iso_hdo,i)/qnk(i), &
                   'cv3_routines 576')
@@ -928,5 +928,5 @@
          enddo !do i=1,len       
         endif !if (iso_HDO.gt.0) THEN
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
          do i=1,len
            CALL iso_verif_egalite(xtnk(iso_eau,i),qnk(i), &
@@ -958,5 +958,5 @@
             WRITE(*,*) 'cv3_routine undilute 1 598: apres condiso'
           
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             do i=1,len
               CALL iso_verif_egalite_choix(xtclw(iso_eau,i,icbs(i)), &
@@ -1095,5 +1095,5 @@
 #ifdef ISOVERIF 
         WRITE(*,*) 'cv3_routines 739: avant condiso'
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
          do i=1,len
            CALL iso_verif_aberrant(xtnk(iso_hdo,i)/qnk(i), &
@@ -1129,5 +1129,5 @@
 !WRITE(*,*) 'DEBUG ISO B'
           do i=1,len
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(xtclw(iso_eau,i,icb(i)+1), &
                  clw(i,icb(i)+1),'cv3_routines 708',errmax,errmaxrel)
@@ -1209,5 +1209,5 @@
 ! oct3       ath  = th(i,icb(i)-1) - dttrig
 ! oct3
-! oct3       if (tdif.lt.dtcrit .or. ath.gt.ath1) THEN
+! oct3       if (tdif.lt.dtcrit .OR. ath.gt.ath1) THEN
 ! oct3         do 60 k=1,nl
 ! oct3            sig(i,k) = beta*sig(i,k) - 2.*alpha*tdif*tdif
@@ -1267,8 +1267,8 @@
   USE lmdz_print_control, ONLY: lunout
 #ifdef ISO
-    use infotrac_phy, ONLY: ntraciso=>ntiso
-    use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO
+    USE infotrac_phy, ONLY: ntraciso=>ntiso
+    USE isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO
 #ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: errmax,errmaxrel, &
+    USE isotopes_verif_mod, ONLY: errmax,errmaxrel, &
         iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, &
         iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
@@ -1294,6 +1294,6 @@
 #ifdef ISO
       !integer niso
-      real xtnk1(ntraciso,len)
-      real xt1(ntraciso,len,nd), xtclw1(ntraciso,len,nd)
+      REAL xtnk1(ntraciso,len)
+      REAL xt1(ntraciso,len,nd), xtclw1(ntraciso,len,nd)
 #endif
 
@@ -1311,6 +1311,6 @@
   REAL tra(nloc, nd, ntra)
 #ifdef ISO
-      real xtnk(ntraciso,nloc)
-      real xt(ntraciso,nloc,nd), xtclw(ntraciso,nloc,nd)
+      REAL xtnk(ntraciso,nloc)
+      REAL xt(ntraciso,nloc,nd), xtclw(ntraciso,nloc,nd)
 #endif
 
@@ -1318,6 +1318,6 @@
   INTEGER i, k, nn, j
 #ifdef ISO
-      integer ixt
-!      logical negation
+      INTEGER ixt
+!      LOGICAL negation
 #endif
 
@@ -1363,5 +1363,5 @@
 !AC!       nn=0
 !AC!      do 101 i=1,len
-!AC!      IF(iflag1(i).eq.0)THEN
+!AC!      IF(iflag1(i).EQ.0)THEN
 !AC!       nn=nn+1
 !AC!       tra(nn,k,j)=tra1(i,k,j)
@@ -1401,5 +1401,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-       if (iso_eau.gt.0) THEN
+       IF (iso_eau.gt.0) THEN
         do k = 1, nd
          do i = 1, ncum                      
@@ -1465,5 +1465,5 @@
   USE lmdz_print_control, ONLY: prt_level
 #ifdef ISO
-use infotrac_phy, ONLY: ntraciso=>ntiso
+USE infotrac_phy, ONLY: ntraciso=>ntiso
 USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax,cond_temp_env, &
         iso_eau,iso_HDO
@@ -1476,5 +1476,5 @@
 #endif
 #ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: errmax,errmaxrel, &
+    USE isotopes_verif_mod, ONLY: errmax,errmaxrel, &
         iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, &
         iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
@@ -1576,7 +1576,7 @@
 
 #ifdef ISO
-      integer ixt
-      real zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)
-      real clw_k(nloc),tg_k(nloc),xt_k(ntraciso,nloc)
+      INTEGER ixt
+      REAL zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)
+      REAL clw_k(nloc),tg_k(nloc),xt_k(ntraciso,nloc)
 #endif
   IF (prt_level >= 10) THEN
@@ -2110,5 +2110,5 @@
         !WRITE(*,*) 'cv3_routine 1259: avant condiso'
         do i=1,ncum
-           if (iso_HDO.gt.0) THEN
+           IF (iso_HDO.gt.0) THEN
              CALL iso_verif_aberrant(xtnk(iso_hdo,i)/qnk(i), &
                   'cv3_routines 1231')
@@ -2143,5 +2143,5 @@
         enddo !do i=1,ncum
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
           do i=1,ncum        
            CALL iso_verif_egalite_choix(xtclw(iso_eau,i,k), &
@@ -2338,5 +2338,5 @@
 !  ENDDO
 
-  endif
+  ENDIF
 
 ! -- end convect3
@@ -2411,5 +2411,5 @@
 ! ori        do 520 i=1,ncum
 ! ori          IF(cape(i).lt.0.0)lcape(i)=.FALSE.
-! ori          if((k.ge.(icb(i)+1)).and.lcape(i))THEN
+! ori          if((k.ge.(icb(i)+1)).AND.lcape(i))THEN
 ! ori            by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
 ! ori            byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
@@ -2694,5 +2694,5 @@
 ! c      do k= 1,nl
 ! c       do i = 1,ncum
-! c        IF (k .ge. icb(i) .and. k .le. inb(i)) THEN
+! c        IF (k .ge. icb(i) .AND. k .le. inb(i)) THEN
 ! c         cbmflast(i) = cbmflast(i)+M(i,k)
 ! c        ENDIF
@@ -2758,10 +2758,10 @@
 
 #ifdef ISO
-use infotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso
+USE infotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso
 USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax, iso_eau,iso_HDO, &
         ridicule
 USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall
 #ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: errmax,errmaxrel,deltalim, &
+    USE isotopes_verif_mod, ONLY: errmax,errmaxrel,deltalim, &
         iso_verif_egalite_choix,iso_verif_aberrant_choix, iso_verif_noNaN,&
         iso_verif_aberrant, &
@@ -2770,10 +2770,10 @@
 #endif
 #ifdef ISOTRAC
-    use isotrac_mod, ONLY: option_tmin,option_traceurs,seuil_tag_tmin, &
+    USE isotrac_mod, ONLY: option_tmin,option_traceurs,seuil_tag_tmin, &
 &       option_cond,index_zone,izone_cond,index_iso
-    use isotrac_routines_mod, ONLY: iso_recolorise_condensation
-    use isotopes_routines_mod, ONLY: condiso_liq_ice_vectall_trac
+    USE isotrac_routines_mod, ONLY: iso_recolorise_condensation
+    USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall_trac
 #ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: iso_verif_trac17_q_deltad,iso_verif_traceur, &
+    USE isotopes_verif_mod, ONLY: iso_verif_trac17_q_deltad,iso_verif_traceur, &
 &       iso_verif_traceur_justmass
 #endif
@@ -2806,6 +2806,6 @@
 #ifdef ISO
       !integer niso
-      real xt(ntraciso,nloc,na), xtclw(ntraciso,nloc,na)
-      real xtnk(ntraciso,nloc) 
+      REAL xt(ntraciso,nloc,na), xtclw(ntraciso,nloc,na)
+      REAL xtnk(ntraciso,nloc)
 #endif
 
@@ -2818,6 +2818,6 @@
   INTEGER, DIMENSION (nloc, nd), INTENT (OUT)         :: nent
 #ifdef ISO
-      real xtent(ntraciso,nloc,nd,nd)
-      real xtelij(ntraciso,nloc,nd,nd)      
+      REAL xtent(ntraciso,nloc,nd,nd)
+      REAL xtelij(ntraciso,nloc,nd,nd)
 #endif
 
@@ -2834,12 +2834,12 @@
   LOGICAL lwork(nloc)
 #ifdef ISO
-      integer ixt
-      real xtrti(ntraciso,nloc)
-      real xtres(ntraciso)
+      INTEGER ixt
+      REAL xtrti(ntraciso,nloc)
+      REAL xtres(ntraciso)
       ! on ajoute la dimension nloc a xtrti pour verifs dans les tags: 5 fev
       ! 2010
-      real zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)
+      REAL zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)
 !      real xt_reduit(ntraciso)
-!      logical negation
+!      LOGICAL negation
 !#ifdef ISOVERIF
 !       integer iso_verif_positif_nostop
@@ -2978,11 +2978,11 @@
          zfice(il) = 1.0-(t(il,j)-pxtice)/(pxtmelt-pxtice)
          zfice(il) = MIN(MAX(zfice(il),0.0),1.0)        
-         IF( (i.ge.icb(il)).and.(i.le.inb(il)).and. &
-            (j.ge.(icb(il)-1)).and.(j.le.inb(il)))THEN
+         IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND. &
+            (j.ge.(icb(il)-1)).AND.(j.le.inb(il)))THEN
           do ixt=1,ntraciso
 !           xtrti(ixt)=xt(ixt,il,1)-xtep(ixt,il,i)*xtclw(ixt,il,i) ! le 7 mai: on supprime xtep
            xtrti(ixt,il)=xtnk(ixt,il)-ep(il,i)*xtclw(ixt,il,i)      
           enddo
-          IF(sij(il,i,j).gt.0.0.and.sij(il,i,j).lt.0.95)THEN
+          IF(sij(il,i,j).gt.0.0.AND.sij(il,i,j).lt.0.95)THEN
 ! temperature of condensation (within mixtures):
 !          tcond(il)=t(il,j)  
@@ -2996,6 +2996,6 @@
                              +(1.-sij(il,i,j))*xtrti(ixt,il)
           enddo !do ixt = 1, ntraciso
-         endif  !IF(sij(il,i,j).gt.0.0.and.sij(il,i,j).lt.0.95)THEN
-        endif !IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
+         endif  !IF(sij(il,i,j).gt.0.0.AND.sij(il,i,j).lt.0.95)THEN
+        endif !IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND.
        enddo  !do il=1,ncum 
 
@@ -3013,8 +3013,8 @@
            CALL iso_verif_positif(qent(il,i,j)-elij(il,i,j), &
                   'cv3_routines 2085')
-          if (iso_eau.gt.0) THEN
-              if (iso_verif_egalite_nostop(qent(il,i,j), &
+          IF (iso_eau.gt.0) THEN
+              IF (iso_verif_egalite_nostop(qent(il,i,j), &
                     xtent(iso_eau,il,i,j), &
-                    'cv3_routine 2126').eq.1) THEN
+                    'cv3_routine 2126').EQ.1) THEN
                   WRITE(*,*) 'il,i,j=',il,i,j
                   WRITE(*,*) 'sij(il,i,j)=',sij(il,i,j)
@@ -3040,8 +3040,8 @@
         do il=1,ncum
           CALL iso_verif_traceur(xt(1,il,i),'cv3_routines 1967')
-          IF( (i.ge.icb(il)).and.(i.le.inb(il)).and. &
-            (j.ge.(icb(il)-1)).and.(j.le.inb(il)))THEN
+          IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND. &
+            (j.ge.(icb(il)-1)).AND.(j.le.inb(il)))THEN
           CALL iso_verif_traceur(xtrti(1,il),'cv3_routines 1968')
-          endif !IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
+          endif !IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND.
           CALL iso_verif_traceur(xtent(1,il,i,j),'cv3_routines 1969')
           
@@ -3058,5 +3058,5 @@
 !        WRITE(*,*) 'cv3_routines tmp 1987,option_traceurs=',
 !     :           option_traceurs
-        if (option_tmin.ge.1) THEN
+        IF (option_tmin.ge.1) THEN
         do il=1,ncum    
 !        WRITE(*,*) 'cv3 tmp 1991 il,i,j,xtent(:,il,i,j),',
@@ -3065,16 +3065,16 @@
         ! colorier la vapeur residuelle selon temperature de
         ! condensation, et le condensat en un tag specifique
-          if ((elij(il,i,j).gt.0.0).and.(qent(il,i,j).gt.0.0)) THEN
-            if (option_traceurs.eq.17) THEN
+          IF ((elij(il,i,j).gt.0.0).AND.(qent(il,i,j).gt.0.0)) THEN
+            IF (option_traceurs.EQ.17) THEN
              CALL iso_recolorise_condensation(qent(il,i,j),elij(il,i,j), &
                  xtent(1,il,i,j),xtelij(1,il,i,j),t(1,j), &
                  0.0,xtres, &
                  seuil_tag_tmin)
-            else !if (option_traceurs.eq.17) THEN
+            else !if (option_traceurs.EQ.17) THEN
 !             WRITE(*,*) 'cv3 2002: il,i,j  =',il,i,j
              CALL iso_recolorise_condensation(qent(il,i,j),elij(il,i,j), &
                  xtent(1,il,i,j),xtelij(1,il,i,j),rs(il,j),0.0,xtres, &
                  seuil_tag_tmin)
-            endif !if (option_traceurs.eq.17) THEN
+            endif !if (option_traceurs.EQ.17) THEN
             do ixt=1+niso,ntraciso
                xtent(ixt,il,i,j)=xtres(ixt)
@@ -3097,8 +3097,8 @@
 !        WRITE(*,*) 'cv3_routines 2050: avant condiso'
         do il=1,ncum
-        if ((i.ge.icb(il)).and.(i.le.inb(il)).and. &
-            (j.ge.(icb(il)-1)).and.(j.le.inb(il))) THEN
-        if (sij(il,i,j).gt.0.0.and.sij(il,i,j).lt.0.95) THEN
-        if (iso_eau.gt.0) THEN
+        IF ((i.ge.icb(il)).AND.(i.le.inb(il)).AND. &
+            (j.ge.(icb(il)-1)).AND.(j.le.inb(il))) THEN
+        IF (sij(il,i,j).gt.0.0.AND.sij(il,i,j).lt.0.95) THEN
+        IF (iso_eau.gt.0) THEN
           CALL iso_verif_egalite_choix(xtent(iso_eau,il,i,j), &
               qent(il,i,j),'cv3_routines 1889',errmax,errmaxrel)
@@ -3106,5 +3106,5 @@
               elij(il,i,j),'cv3_routines 1890',errmax,errmaxrel)
         endif
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
           CALL iso_verif_aberrant_choix(xt(iso_HDO,il,i),rr(il,i), &
                   ridicule,deltalim,'cv3_routines 1997')
@@ -3124,6 +3124,6 @@
 #endif        
 
-        endif !IF(sij(il,i,j).gt.0.0.and.sij(il,i,j).lt.0.95)THEN
-        endif !IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
+        endif !IF(sij(il,i,j).gt.0.0.AND.sij(il,i,j).lt.0.95)THEN
+        endif !IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND.
         enddo !do il=1,ncum
 #endif
@@ -3135,6 +3135,6 @@
 !AC!        do j=minorig,nl
 !AC!         do il=1,ncum
-!AC!          IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
-!AC!     :       (j.ge.(icb(il)-1)).and.(j.le.inb(il)))THEN
+!AC!          IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND.
+!AC!     :       (j.ge.(icb(il)-1)).AND.(j.le.inb(il)))THEN
 !AC!            traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
 !AC!     :            +(1.-sij(il,i,j))*tra(il,nk(il),k)
@@ -3153,5 +3153,5 @@
     DO il = 1, ncum
       IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (nent(il,i)==0)) THEN
-! @      IF(nent(il,i).eq.0)THEN
+! @      IF(nent(il,i).EQ.0)THEN
         ment(il, i, i) = m(il, i)
         qent(il, i, i) = qnk(il) - ep(il, i)*clw(il, i)
@@ -3170,11 +3170,11 @@
 
 #ifdef ISOTRAC          
-        if (option_tmin.ge.1) THEN
+        IF (option_tmin.ge.1) THEN
         ! colorier la vapeur residuelle selon temperature de
         ! condensation, et le condensat en un tag specifique
 !        WRITE(*,*) 'cv3 tmp 2095 il,i,j,xtent(:,il,i,j)=',
 !     :            il,i,j,xtent(:,il,i,j)
-          if ((elij(il,i,i).gt.0.0).and.(qent(il,i,i).gt.0.0)) THEN
-            if (option_traceurs.eq.17) THEN
+          IF ((elij(il,i,i).gt.0.0).AND.(qent(il,i,i).gt.0.0)) THEN
+            IF (option_traceurs.EQ.17) THEN
              CALL iso_recolorise_condensation(qent(il,i,i), &
                  elij(il,i,i), &
@@ -3182,5 +3182,5 @@
                  xtres, &
                  seuil_tag_tmin)
-            else !if (option_traceurs.eq.17) THEN
+            else !if (option_traceurs.EQ.17) THEN
              CALL iso_recolorise_condensation(qent(il,i,i), &
                  elij(il,i,i), &
@@ -3188,5 +3188,5 @@
                  xtres, &
                  seuil_tag_tmin)
-            endif !if (option_traceurs.eq.17) THEN
+            endif !if (option_traceurs.EQ.17) THEN
             do ixt=1+niso,ntraciso
               xtent(ixt,il,i,i)=xtres(ixt)
@@ -3218,5 +3218,5 @@
 !AC!       do i=minorig+1,nl
 !AC!        do il=1,ncum
-!AC!         if (i.ge.icb(il) .and. i.le.inb(il) .and. nent(il,i).eq.0) THEN
+!AC!         if (i.ge.icb(il) .AND. i.le.inb(il) .AND. nent(il,i).EQ.0) THEN
 !AC!          traent(il,i,i,j)=tra(il,nk(il),j)
 !AC!         endif
@@ -3405,11 +3405,11 @@
 
 #ifdef ISOTRAC          
-        if (option_tmin.ge.1) THEN
+        IF (option_tmin.ge.1) THEN
         ! colorier la vapeur residuelle selon temperature de
         ! condensation, et le condensat en un tag specifique
 !        WRITE(*,*) 'cv3 tmp 2314 il,i,j,xtent(:,il,i,j)=',
 !     :            il,i,j,xtent(:,il,i,j)
-          if ((elij(il,i,i).gt.0.0).and.(qent(il,i,i).gt.0.0)) THEN
-            if (option_traceurs.eq.17) THEN
+          IF ((elij(il,i,i).gt.0.0).AND.(qent(il,i,i).gt.0.0)) THEN
+            IF (option_traceurs.EQ.17) THEN
               CALL iso_recolorise_condensation(qent(il,i,i), &
                  elij(il,i,i), &
@@ -3417,5 +3417,5 @@
                  xtres, &
                  seuil_tag_tmin)
-            else !if (option_traceurs.eq.17) THEN
+            else !if (option_traceurs.EQ.17) THEN
               CALL iso_recolorise_condensation(qent(il,i,i), &
                  elij(il,i,i), &
@@ -3423,5 +3423,5 @@
                  xtres,&
                  seuil_tag_tmin)
-            endif ! if (option_traceurs.eq.17) THEN
+            endif ! if (option_traceurs.EQ.17) THEN
             do ixt=1+niso,ntraciso
               xtent(ixt,il,i,i)=xtres(ixt)
@@ -3449,6 +3449,6 @@
 !AC!      do j=1,ntra
 !AC!       do il=1,ncum
-!AC!        if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
-!AC!     :     .and. csum(il,i).lt.m(il,i) ) THEN
+!AC!        if ( i.ge.icb(il) .AND. i.le.inb(il) .AND. lwork(il)
+!AC!     :     .AND. csum(il,i).lt.m(il,i) ) THEN
 !AC!         traent(il,i,i,j)=tra(il,nk(il),j)
 !AC!        endif
@@ -3492,10 +3492,10 @@
        do jm = 1, nd
         do il = 1, ncum
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(xtelij(iso_eau,il,im,jm), &
                elij(il,im,jm),'cv3_mixing 2110',errmax,errmaxrel)
-            if (iso_verif_egalite_choix_nostop(xtent(iso_eau,il,im,jm),  &
+            IF (iso_verif_egalite_choix_nostop(xtent(iso_eau,il,im,jm),  &
                qent(il,im,jm),'cv3_mixing 2112',errmax,errmaxrel) &
-               .eq.1) THEN
+               .EQ.1) THEN
                 WRITE(*,*) 'il,im,jm=',il,im,jm
                 WRITE(*,*) 'xtnk(:,il),qnk(il)=',xtnk(:,il),qnk(il)
@@ -3516,5 +3516,5 @@
 #ifdef ISOTRAC
         ! seulement a la fin on taggue le condensat
-        if (option_cond.ge.1) THEN
+        IF (option_cond.ge.1) THEN
          do im = 1, nd
          do jm = 1, nd
@@ -3522,9 +3522,9 @@
            ! colorier le condensat en un tag specifique
            do ixt=niso+1,ntraciso
-             if (index_zone(ixt).eq.izone_cond) THEN
+             IF (index_zone(ixt).EQ.izone_cond) THEN
                 xtelij(ixt,il,im,jm)=xtelij(index_iso(ixt),il,im,jm)
-             else !if (index_zone(ixt).eq.izone_cond) THEN
+             else !if (index_zone(ixt).EQ.izone_cond) THEN
                 xtelij(ixt,il,im,jm)=0.0
-             endif !if (index_zone(ixt).eq.izone_cond) THEN
+             endif !if (index_zone(ixt).EQ.izone_cond) THEN
            enddo !do ixt=1,ntraciso      
 #ifdef ISOVERIF
@@ -3541,9 +3541,9 @@
            ! colorier le condensat en un tag specifique
            do ixt=niso+1,ntraciso
-             if (index_zone(ixt).eq.izone_cond) THEN
+             IF (index_zone(ixt).EQ.izone_cond) THEN
                 xtclw(ixt,il,im)=xtclw(index_iso(ixt),il,im)
-             else !if (index_zone(ixt).eq.izone_cond) THEN
+             else !if (index_zone(ixt).EQ.izone_cond) THEN
                 xtclw(ixt,il,im)=0.0
-             endif !if (index_zone(ixt).eq.izone_cond) THEN
+             endif !if (index_zone(ixt).EQ.izone_cond) THEN
            enddo !do ixt=1,ntraciso      
 #ifdef ISOVERIF
@@ -3552,7 +3552,7 @@
         CALL iso_verif_traceur(xtclw(1,il,im), &
                 'condiso_liq_ice_vectiso_trac 358')
-        if (iso_verif_positif_nostop(xtclw(itZonIso( &
+        IF (iso_verif_positif_nostop(xtclw(itZonIso( &
                  izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
-                 ,'cv3_routines 909').eq.1) THEN
+                 ,'cv3_routines 909').EQ.1) THEN
                WRITE(*,*) 'i,k=',i,k
                WRITE(*,*) 'xtclw=',xtclw(:,i,k)
@@ -3565,5 +3565,5 @@
          enddo !do im = 1, nd
 !         WRITE(*,*) 'xtclw(:,1,2)=',xtclw(:,1,2)
-        endif !if (option_tmin.eq.1) THEN
+        endif !if (option_tmin.EQ.1) THEN
 #endif
 #endif
@@ -3585,10 +3585,10 @@
   USE lmdz_print_control, ONLY: prt_level, lunout
 #ifdef ISO
-    use infotrac_phy, ONLY: ntraciso=>ntiso
-    use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO, &
+    USE infotrac_phy, ONLY: ntraciso=>ntiso
+    USE isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO, &
         ridicule
-    use isotopes_routines_mod, ONLY: appel_stewart_vectall_np
+    USE isotopes_routines_mod, ONLY: appel_stewart_vectall_np
 #ifdef ISOVERIF
-    use isotopes_verif_mod
+    USE isotopes_verif_mod
 !, ONLY: errmax,errmaxrel, &
 !        iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, &
@@ -3597,10 +3597,10 @@
 #endif
 #ifdef ISOTRAC
-    use isotrac_mod, ONLY: option_cond,izone_cond
-    use infotrac_phy, ONLY: itZonIso
+    USE isotrac_mod, ONLY: option_cond,izone_cond
+    USE infotrac_phy, ONLY: itZonIso
 #ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: iso_verif_traceur_justmass, &
+    USE isotopes_verif_mod, ONLY: iso_verif_traceur_justmass, &
 &       iso_verif_traceur, iso_verif_positif_choix
-    use isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
+    USE isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
 #endif
 #endif
@@ -3681,8 +3681,8 @@
   LOGICAL lwork(nloc), mplus(nloc)
 #ifdef ISO
-      integer ixt
-      real xtwdtrain(ntraciso,nloc), xtawat(ntraciso)
-!      logical negation
-      real rpprec(nloc,na)
+      INTEGER ixt
+      REAL xtwdtrain(ntraciso,nloc), xtawat(ntraciso)
+!      LOGICAL negation
+      REAL rpprec(nloc,na)
 !#ifdef ISOVERIF
 !      integer iso_verif_aberrant_nostop
@@ -3891,5 +3891,5 @@
           enddo
 #ifdef ISOVERIF
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(xtwdtrain(iso_eau,il), &
                  wdtrain(il),'cv3_routines 2313',errmax,errmaxrel)
@@ -3914,5 +3914,5 @@
 #ifdef ISO
 ! precip mixed drafts computed from: xtawat/xtelij = awat/elij           
-            if (elij(il,j,i).gt.0.0) THEN
+            IF (elij(il,j,i).gt.0.0) THEN
              do ixt=1,ntraciso
                xtawat(ixt)=xtelij(ixt,il,j,i)*(awat/elij(il,j,i))
@@ -3926,5 +3926,5 @@
             endif  !if (elij(il,j,i).gt.0.0) THEN
 #ifdef ISOVERIF
-              if (iso_eau.gt.0) THEN
+              IF (iso_eau.gt.0) THEN
                   CALL iso_verif_egalite_choix(xtawat(iso_eau), &
                  awat,'cv3_routines 2391',errmax,errmaxrel)
@@ -3948,5 +3948,5 @@
 #endif
 #ifdef ISOVERIF
-              if (iso_eau.gt.0) THEN
+              IF (iso_eau.gt.0) THEN
                   CALL iso_verif_egalite_choix(xtwdtrain(iso_eau,il), &
                  wdtrain(il),'cv3_routines 2366',errmax,errmaxrel)
@@ -3954,10 +3954,10 @@
 #ifdef ISOTRAC
         CALL iso_verif_traceur(xtwdtrain(1,il),'cv3_routine 2540')
-        if (option_cond.ge.1) THEN
+        IF (option_cond.ge.1) THEN
           ! on verifie que tout le detrainement est tagge condensat
-          if (iso_verif_positif_nostop( &
+          IF (iso_verif_positif_nostop( &
                 xtwdtrain(itZonIso(izone_cond,iso_eau),il) &
                 -xtwdtrain(iso_eau,il), &
-                'cv3_routines 2795').eq.1) THEN
+                'cv3_routines 2795').EQ.1) THEN
           WRITE(*,*) 'xtwdtrain(:,il)=',xtwdtrain(:,il)
           WRITE(*,*) 'xtelij(:,il,j,i)=',xtelij(:,il,j,i)
@@ -4159,5 +4159,5 @@
 !JYG----   Correction : si c6 <= 0, water(il,i)=0.
 ! prec(il,i)=0.
-! endif
+! END IF
 
 !JYG---   Dans tous les cas, evaporation = [tt ce qui entre dans la couche i]
@@ -4232,5 +4232,5 @@
 
         END IF
-      END IF !(i.le.inb(il) .and. lwork(il))
+      END IF !(i.le.inb(il) .AND. lwork(il))
     END DO
 ! ----------------------------------------------------------------
@@ -4273,5 +4273,5 @@
         END IF
 
-      END IF !(i.le.inb(il) .and. lwork(il) .and. i.ne.1)
+      END IF !(i.le.inb(il) .AND. lwork(il) .AND. i.NE.1)
       IF (prt_level >= 20) THEN
         PRINT *,'cv3_unsat, mp hydrostatic ', i, mp(il,i)
@@ -4394,5 +4394,5 @@
 !>jyg
 
-      END IF ! (i.le.inb(il) .and. lwork(il) .and. i.ne.1)
+      END IF ! (i.le.inb(il) .AND. lwork(il) .AND. i.NE.1)
     END DO
 ! ----------------------------------------------------------------
@@ -4408,5 +4408,5 @@
       IF (i<inb(il) .AND. lwork(il)) THEN
         mplus(il) = mp(il, i) > mp(il, i+1)
-      END IF ! (i.lt.inb(il) .and. lwork(il))
+      END IF ! (i.lt.inb(il) .AND. lwork(il))
     END DO
 
@@ -4446,5 +4446,5 @@
             vp(il, i) = vp(il, i+1)
           END IF ! (mp(il,i+1).gt.1.0e-16)
-        END IF ! (mplus(il)) else if (.not.mplus(il))
+        END IF ! (mplus(il)) ELSE IF (.NOT.mplus(il))
 
 #ifdef ISO 
@@ -4456,5 +4456,5 @@
         rp(il, i) = max(rp(il,i), 0.0)
 
-      END IF ! (i.lt.inb(il) .and. lwork(il))
+      END IF ! (i.lt.inb(il) .AND. lwork(il))
     END DO
 ! ----------------------------------------------------------------
@@ -4464,5 +4464,5 @@
 !AC!      do j=1,ntra
 !AC!       do il = 1,ncum
-!AC!       if (i.lt.inb(il) .and. lwork(il)) THEN
+!AC!       if (i.lt.inb(il) .AND. lwork(il)) THEN
 !AC!c
 !AC!         IF(mplus(il))THEN
@@ -4474,7 +4474,7 @@
 !AC!           trap(il,i,j)=trap(il,i+1,j)
 !AC!          endif
-!AC!         endif ! (mplus(il)) else if (.not.mplus(il))
+!AC!         endif ! (mplus(il)) ELSE IF (.NOT.mplus(il))
 !AC!c
-!AC!        endif ! (i.lt.inb(il) .and. lwork(il))
+!AC!        endif ! (i.lt.inb(il) .AND. lwork(il))
 !AC!       enddo
 !AC!      END DO
@@ -4484,6 +4484,6 @@
 ! verif des inputs a appel stewart
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) THEN
-         if (iso_eau.gt.0) THEN
+       IF (i.le.inb(il) .AND. lwork(il)) THEN
+         IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(xt(iso_eau,il,i), &
               rr(il,i),'appel_stewart 262, cas 1.1',errmax,errmaxrel)
@@ -4515,5 +4515,5 @@
 ! verif des outputs de appel stewart
        do il=1,ncum
-        if (i.le.inb(il) .and. lwork(il)) THEN
+        IF (i.le.inb(il) .AND. lwork(il)) THEN
          do ixt=1,ntraciso        
           CALL iso_verif_noNAN(xtp(ixt,il,i),'cv3_unsat 3382')
@@ -4526,6 +4526,6 @@
 #ifdef ISOVERIF
        do il=1,ncum
-        if (i.le.inb(il) .and. lwork(il)) THEN
-         if (iso_eau.gt.0) THEN
+        IF (i.le.inb(il) .AND. lwork(il)) THEN
+         IF (iso_eau.gt.0) THEN
           CALL iso_verif_egalite_choix(xtp(iso_eau,il,i), &
                  rpprec(il,i),'cv3_unsat 2736',errmax,errmaxrel)
@@ -4539,11 +4539,11 @@
                  evap(il,i),'cv3_unsat 2751',errmax,errmaxrel)
          endif !if (iso_eau.gt.0) THEN
-         if ((iso_HDO.gt.0).and. &
+         IF ((iso_HDO.gt.0).AND. &
                  (rp(il,i).gt.ridicule)) THEN
            CALL iso_verif_aberrant(xtp(iso_HDO,il,i)/rpprec(il,i), &
                         'cv3unsat 2756')
-           endif !if ((iso_HDO.gt.0).and.
+           endif !if ((iso_HDO.gt.0).AND.
 #ifdef ISOTRAC
-!        if (il.eq.602) THEN
+!        if (il.EQ.602) THEN
 !        WRITE(*,*) 'cv3_routine tmp: il,i=',il,i
 !        WRITE(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
@@ -4564,5 +4564,5 @@
 !        endif !if (option_tmin.ge.1) THEN
 #endif              
-        endif !if (i.le.inb(il) .and. lwork(il)) THEN
+        endif !if (i.le.inb(il) .AND. lwork(il)) THEN
        enddo !do il=1,ncum
 #endif
@@ -4570,7 +4570,7 @@
 ! equivalent isotopique de rp(il,i)=amin1(rp(il,i),rs(il,i))
        do il=1,ncum
-        if (i.lt.inb(il) .and. lwork(il)) THEN
-         if (rpprec(il,i).gt.rs(il,i)) THEN
-            if (rs(il,i).le.0) THEN
+        IF (i.lt.inb(il) .AND. lwork(il)) THEN
+         IF (rpprec(il,i).gt.rs(il,i)) THEN
+            IF (rs(il,i).le.0) THEN
                 WRITE(*,*) 'cv3unsat 2640'
                 stop
@@ -4586,5 +4586,5 @@
 #endif
 #ifdef ISOVERIF
-           if (iso_eau.gt.0) THEN
+           IF (iso_eau.gt.0) THEN
 !             WRITE(*,*) 'xtp(iso_eau,il,i)=',xtp(iso_eau,il,i)
              CALL iso_verif_egalite_choix(xtp(iso_eau,il,i),rp(il,i), &
@@ -4593,8 +4593,8 @@
                   rs(il,i),'cv3unsat 2654',errmax,errmaxrel)
            endif  
-           if ((iso_HDO.gt.0).and. &
+           IF ((iso_HDO.gt.0).AND. &
                  (rp(il,i).gt.ridicule)) THEN
-             if (iso_verif_aberrant_nostop(xtp(iso_HDO,il,i)/rp(il,i), &
-                        'cv3unsat 2658').eq.1) THEN
+             IF (iso_verif_aberrant_nostop(xtp(iso_HDO,il,i)/rp(il,i), &
+                        'cv3unsat 2658').EQ.1) THEN
                 WRITE(*,*) 'rpprec(il,i),rs(il,i),rp(il,i)=', &
                          rpprec(il,i),rs(il,i),rp(il,i)
@@ -4608,5 +4608,5 @@
           rpprec(il,i)=rs(il,i)      
          ! sous cas rajoute le 11dec 2011. Normalement, pas utile 
-         else if (rp(il,i).eq.0.0) THEN
+         ELSE IF (rp(il,i).EQ.0.0) THEN
             do ixt=1,ntraciso
               xtp(ixt,il,i)=0.0
@@ -4622,5 +4622,5 @@
       do i=1,nl!nl
         do il=1,ncum
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
 !            WRITE(*,*) 'cv3_routines 2767:i,il,lwork(il),inb(il)=',
 !     :           i,il,lwork(il),inb(il)
@@ -4637,5 +4637,5 @@
 !        if (iso_verif_traceur_choix_nostop(xtwater(1,il,i),
 !     :       'cv3_routine 2982 unsat',errmax,
-!     :       errmaxrel,ridicule_trac,deltalimtrac).eq.1) THEN
+!     :       errmaxrel,ridicule_trac,deltalimtrac).EQ.1) THEN
 !              WRITE(*,*) 'il,i,inb(il),lwork(il)=',
 !     :           il,i,inb(il),lwork(il)
@@ -4693,8 +4693,8 @@
 
 #ifdef ISO
-    use infotrac_phy, ONLY: ntraciso=>ntiso, niso, nzone, itZonIso
-    use isotopes_mod, ONLY: essai_convergence,ridicule,iso_eau,iso_HDO,iso_O18
+    USE infotrac_phy, ONLY: ntraciso=>ntiso, niso, nzone, itZonIso
+    USE isotopes_mod, ONLY: essai_convergence,ridicule,iso_eau,iso_HDO,iso_O18
 #ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: errmax,errmaxrel, &
+    USE isotopes_verif_mod, ONLY: errmax,errmaxrel, &
         iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant,iso_verif_O18_aberrant, &
         iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
@@ -4703,10 +4703,10 @@
 #endif
 #ifdef ISOTRAC
-        use isotrac_mod, ONLY: option_traceurs, &
+        USE isotrac_mod, ONLY: option_traceurs, &
         izone_revap,izone_poubelle,izone_ddft
 #ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: iso_verif_traceur_choix_nostop,deltalimtrac, &
+    USE isotopes_verif_mod, ONLY: iso_verif_traceur_choix_nostop,deltalimtrac, &
 &       iso_verif_tracpos_choix_nostop,iso_verif_traceur,iso_verif_traceur_justmass
-    use isotrac_mod, ONLY: ridicule_trac
+    USE isotrac_mod, ONLY: ridicule_trac
 #endif
 #endif
@@ -4751,9 +4751,9 @@
       REAL, INTENT(IN)                                   :: tau_cld_cv, coefw_cld_cv
 #ifdef ISO
-      real, DIMENSION (ntraciso,nloc,nd), INTENT (IN)            ::  xt
-      real, DIMENSION (ntraciso,nloc,nd), INTENT (IN)            ::  xt_wake
-      real, DIMENSION (ntraciso,nloc,na), INTENT (IN)            ::  xtclw, xtp
-      real, DIMENSION (ntraciso,nloc,na), INTENT (IN)            ::  xtwater, xtevap
-      real, DIMENSION (ntraciso,nloc,na,na), INTENT (IN)         ::  xtent, xtelij
+      REAL, DIMENSION (ntraciso,nloc,nd), INTENT (IN)            ::  xt
+      REAL, DIMENSION (ntraciso,nloc,nd), INTENT (IN)            ::  xt_wake
+      REAL, DIMENSION (ntraciso,nloc,na), INTENT (IN)            ::  xtclw, xtp
+      REAL, DIMENSION (ntraciso,nloc,na), INTENT (IN)            ::  xtwater, xtevap
+      REAL, DIMENSION (ntraciso,nloc,na,na), INTENT (IN)         ::  xtent, xtelij
       REAL, DIMENSION (ntraciso,nloc, na), INTENT (IN)            :: xtice
 #endif
@@ -4784,5 +4784,5 @@
       REAL, DIMENSION (ntraciso,nloc), INTENT (OUT)               :: xtprecip
       REAL, DIMENSION (ntraciso,nloc, nd), INTENT (OUT)           :: fxt,fxtd
-      real, DIMENSION (ntraciso,nloc, nd+1), INTENT (OUT) :: xtVprecip, xtVprecipi
+      REAL, DIMENSION (ntraciso,nloc, nd+1), INTENT (OUT) :: xtVprecip, xtVprecipi
 #endif
 
@@ -4813,22 +4813,22 @@
       REAL sumdq !jyg
 #ifdef ISO
-      integer ixt
-      real xtbx(ntraciso), xtawat(ntraciso,nloc)
+      INTEGER ixt
+      REAL xtbx(ntraciso), xtawat(ntraciso,nloc)
       ! cam debug
       ! pour l'homogeneisation sous le nuage:
-      real bxtsum(ntraciso,nloc), fxtsum(ntraciso,nloc)
+      REAL bxtsum(ntraciso,nloc), fxtsum(ntraciso,nloc)
 #ifdef DIAGISO
         ! diagnostiques juste: tendance des differents processus
-      real fxt_detrainement(niso,nloc,nd)
-      real fxt_fluxmasse(niso,nloc,nd)
-      real fxt_evapprecip(niso,nloc,nd)
-      real fxt_ddft(niso,nloc,nd)
-      real fq_detrainement(nloc,nd)
-      real q_detrainement(nloc,nd)
-      real xt_detrainement(niso,nloc,nd)
-      real f_detrainement(nloc,nd)
-      real fq_fluxmasse(nloc,nd)
-      real fq_evapprecip(nloc,nd)
-      real fq_ddft(nloc,nd)
+      REAL fxt_detrainement(niso,nloc,nd)
+      REAL fxt_fluxmasse(niso,nloc,nd)
+      REAL fxt_evapprecip(niso,nloc,nd)
+      REAL fxt_ddft(niso,nloc,nd)
+      REAL fq_detrainement(nloc,nd)
+      REAL q_detrainement(nloc,nd)
+      REAL xt_detrainement(niso,nloc,nd)
+      REAL f_detrainement(nloc,nd)
+      REAL fq_fluxmasse(nloc,nd)
+      REAL fq_evapprecip(nloc,nd)
+      REAL fq_ddft(nloc,nd)
 #endif           
 !#ifdef ISOVERIF
@@ -4844,13 +4844,13 @@
       !integer iso_verif_traceur_choix_nostop
       !integer iso_verif_tracpos_choix_nostop  
-      real xtnew(ntraciso)
+      REAL xtnew(ntraciso)
 !      real conversion(niso)
-      real fxtYe(niso)
-      real fxtqe(niso)
-      real fxtXe(niso)
-      real fxt_revap(niso)
-      real Xe(niso)
-      integer ixt_revap,izone
-      integer ixt_poubelle, ixt_ddft,iiso 
+      REAL fxtYe(niso)
+      REAL fxtqe(niso)
+      REAL fxtXe(niso)
+      REAL fxt_revap(niso)
+      REAL Xe(niso)
+      INTEGER ixt_revap,izone
+      INTEGER ixt_poubelle, ixt_ddft,iiso
 #endif
 #endif
@@ -4968,5 +4968,5 @@
          ! cam verif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
 !              WRITE(*,*) 'cv3_yield 2952: '//
 !     :           'il,water(il,1),xtwater(iso_eau,il,1)='
@@ -4984,7 +4984,7 @@
         CALL iso_verif_traceur(xtwater(1,il,1), &
              'cv3_routine 3146')
-        if (iso_verif_traceur_choix_nostop(xtprecip(1,il), &
+        IF (iso_verif_traceur_choix_nostop(xtprecip(1,il), &
                  'cv3_routine 3147',errmax*1e2, &
-             errmaxrel,ridicule_trac,deltalimtrac).eq.1) THEN
+             errmaxrel,ridicule_trac,deltalimtrac).EQ.1) THEN
           WRITE(*,*) 'il,inb(il)=',il,inb(il)
           WRITE(*,*) 'xtwater(:,il,1)=',xtwater(:,il,1)
@@ -5007,5 +5007,5 @@
          ! cam verif
 #ifdef ISOVERIF          
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(xtprecip(iso_eau,il), &
                  precip(il),'cv3_routines 3139', &
@@ -5233,5 +5233,5 @@
        ! cam verif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,1), &
                  fr(il,1),'cv3_routines 3251', &
@@ -5241,5 +5241,5 @@
                  errmax*0.1,errmaxrel)
           endif !if (iso_eau.gt.0) THEN
-          if ((iso_HDO.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND. &
                  (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN
            CALL iso_verif_aberrant((xt(iso_HDO,il,1) &
@@ -5247,5 +5247,5 @@
                  'cv3_yield 3125, ddft en 1')
           endif !if (iso_HDO.gt.0) THEN
-          if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. &
                  (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN
            CALL iso_verif_O18_aberrant((xt(iso_HDO,il,1) &
@@ -5259,6 +5259,6 @@
           xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew,'cv3_yield 3395',1e-5) &
-                 .eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew,'cv3_yield 3395',1e-5) &
+                 .EQ.1) THEN
               WRITE(*,*) 'il=',il
               WRITE(*,*) 'delt,fxt(:,il,1)=',delt,fxt(:,il,1)
@@ -5336,9 +5336,9 @@
        ! cam verif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,1), &
                  fr(il,1),'cv3_routines 3251',errmax*0.1,errmaxrel)
           endif !if (iso_eau.gt.0) THEN
-          if ((iso_HDO.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND. &
                  (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN
            CALL iso_verif_aberrant((xt(iso_HDO,il,1) &
@@ -5346,5 +5346,5 @@
                'cv3_yield 3127, dtr melanges')
           endif !if (iso_HDO.gt.0) THEN
-          if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. &
                  (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN
            CALL iso_verif_O18_aberrant((xt(iso_HDO,il,1) &
@@ -5358,6 +5358,6 @@
           xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew,'cv3_yield 3525',1e-5) &
-                 .eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew,'cv3_yield 3525',1e-5) &
+                 .EQ.1) THEN
               WRITE(*,*) 'il=',il
               WRITE(*,*) 'delt,fxt(:,il,1)=',delt,fxt(:,il,1)
@@ -5380,5 +5380,5 @@
 !AC!       do j=2,nl
 !AC!        do il=1,ncum
-!AC!         if (j.le.inb(il) .and. iflag(il) .le. 1) THEN
+!AC!         if (j.le.inb(il) .AND. iflag(il) .le. 1) THEN
 !AC!
 !AC!          if (cvflag_grav) THEN
@@ -5733,6 +5733,6 @@
 #ifdef ISOVERIF
         do ixt=1,ntraciso
-          if (iso_verif_noNaN_nostop(fxtd(ixt,il,i),'cv3_yield 4428') &
-                 .eq.1) THEN
+          IF (iso_verif_noNaN_nostop(fxtd(ixt,il,i),'cv3_yield 4428') &
+                 .EQ.1) THEN
             WRITE(*,*) 'xtevap(ixt,il,i)=',xtevap(ixt,il,i)
             WRITE(*,*) 'xtp(ixt,il,i+1)=',xtp(ixt,il,i+1)
@@ -5748,34 +5748,34 @@
 #endif             
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), &
                  fr(il,i),'cv3_routines 4162',errmax*0.1,errmaxrel)
-            if (iso_verif_egalite_choix_nostop(fxtd(iso_eau,il,i), &
+            IF (iso_verif_egalite_choix_nostop(fxtd(iso_eau,il,i), &
                  fqd(il,i),'cv3_routines 4164', &
-                 errmax*0.1,errmaxrel).eq.1) THEN
+                 errmax*0.1,errmaxrel).EQ.1) THEN
                 WRITE(*,*) 'i,il=',i,il
                 stop
             endif !if (iso_verif_egalite_choix_nostop(fxtd(iso_eau,il,i),
         endif
-        if ((iso_HDO.gt.0).and. &
+        IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
-        if (iso_verif_aberrant_nostop((xt(iso_HDO,il,i) &
+        IF (iso_verif_aberrant_nostop((xt(iso_HDO,il,i) &
                  +delt*fxt(iso_HDO,il,i)) &
                  /(rr(il,i)+delt*fr(il,i)),'cv3_yield 4175') &
-                 .eq.1) THEN
-        if (rr(il,i).ne.0.0) THEN
+                 .EQ.1) THEN
+        IF (rr(il,i).NE.0.0) THEN
         WRITE(*,*) 'il,i,rr,deltaD=',il,i,rr(il,i),deltaD &
                  (xt(iso_HDO,il,i)/rr(il,i))
         endif
-        if (fr(il,i).ne.0.0) THEN
+        IF (fr(il,i).NE.0.0) THEN
         WRITE(*,*) 'fr,fxt,deltaD=',fr(il,i),fxt(iso_HDO,il,i), &
                  deltaD(fxt(iso_HDO,il,i)/fr(il,i))
         endif
 #ifdef DIAGISO
-        if (fq_ddft(il,i).ne.0.0) THEN
+        IF (fq_ddft(il,i).NE.0.0) THEN
         WRITE(*,*) 'fq_ddft,deltaD=',fq_ddft(il,i),deltaD( &
                  fxt_ddft(iso_HDO,il,i)/fq_ddft(il,i))
         endif
-        if (fq_evapprecip(il,i).ne.0.0) THEN
+        IF (fq_evapprecip(il,i).NE.0.0) THEN
         WRITE(*,*) 'fq_evapprecip,deltaD=',fq_evapprecip(il,i),deltaD( &
                  fxt_evapprecip(iso_HDO,il,i)/fq_evapprecip(il,i))
@@ -5799,5 +5799,5 @@
 
 #ifdef ISOTRAC
-        if ((option_traceurs.ne.6).and.(option_traceurs.ne.19)) THEN
+        IF ((option_traceurs.NE.6).AND.(option_traceurs.NE.19)) THEN
             ! facile: on fait comme l'eau
             do ixt = 1+niso,ntraciso
@@ -5837,9 +5837,9 @@
 !        WRITE(*,*) 'tmp cv3_yield 4165: i,il=',i,il
 
-        if (option_traceurs.eq.6) THEN
+        IF (option_traceurs.EQ.6) THEN
           do iiso = 1, niso
              
              ixt_ddft=itZonIso(izone_ddft,iiso)  
-             if (mp(il,i).gt.mp(il,i+1)) THEN
+             IF (mp(il,i).gt.mp(il,i+1)) THEN
                 fxtYe(iiso)=0.01*grav*dpinv*mp(il,i) &
                  *(xt(ixt_ddft,il,i-1)-xt(ixt_ddft,il,i))
@@ -5859,6 +5859,6 @@
          enddo !do iiso = 1, niso
 
-         else !if (option_traceurs.eq.6) THEN
-            if (mp(il,i).gt.mp(il,i+1)) THEN
+         else !if (option_traceurs.EQ.6) THEN
+            IF (mp(il,i).gt.mp(il,i+1)) THEN
                 ! cas entrainant: faire attention
                 
@@ -5883,12 +5883,12 @@
                 Xe(iiso)=xt(iiso,il,i) &
                          -xt(ixt_ddft,il,i)-xt(ixt_revap,il,i)
-                if (Xe(iiso).gt.ridicule) THEN
+                IF (Xe(iiso).gt.ridicule) THEN
                   do izone=1,nzone
-                   if ((izone.ne.izone_revap).and. &
-                         (izone.ne.izone_ddft)) THEN
+                   IF ((izone.NE.izone_revap).AND. &
+                         (izone.NE.izone_ddft)) THEN
                     ixt=itZonIso(izone,iiso) 
                     fxt(ixt,il,i)=fxt(ixt,il,i) &
                          +xt(ixt,il,i)/Xe(iiso)*fxtXe(iiso)
-                   endif !if ((izone.ne.izone_revap).and.
+                   endif !if ((izone.NE.izone_revap).AND.
                   enddo !do izone=1,nzone   
 #ifdef ISOVERIF
@@ -5907,5 +5907,5 @@
                     
 #ifdef ISOVERIF
-                if (delt*fxtXe(iiso).gt.ridicule) THEN
+                IF (delt*fxtXe(iiso).gt.ridicule) THEN
                    WRITE(*,*) 'cv3_routines 6563: delt*fxtXe(iiso)=', &
                                 delt*fxtXe(iiso)
@@ -5914,13 +5914,13 @@
 #endif                   
                 do izone=1,nzone
-                   if ((izone.ne.izone_revap).and. &
-                         (izone.ne.izone_ddft)) THEN
+                   IF ((izone.NE.izone_revap).AND. &
+                         (izone.NE.izone_ddft)) THEN
                     ixt=itZonIso(izone,iiso) 
-                    if (izone.eq.izone_poubelle) THEN
+                    IF (izone.EQ.izone_poubelle) THEN
                       fxt(ixt,il,i)=fxt(ixt,il,i)+fxtXe(iiso)
-                    else !if (izone.eq.izone_poubelle) THEN
+                    else !if (izone.EQ.izone_poubelle) THEN
                         ! pas de tendance pour ce tag la
-                    endif !if (izone.eq.izone_poubelle) THEN
-                   endif !if ((izone.ne.izone_revap).and.
+                    endif !if (izone.EQ.izone_poubelle) THEN
+                   endif !if ((izone.NE.izone_revap).AND.
                 enddo !do izone=1,nzone
 #ifdef ISOVERIF
@@ -5944,10 +5944,10 @@
 #endif                
             endif !if (mp(il,i).gt.mp(il,i+1)) THEN
-          endif !if (option_traceurs.eq.6) THEN
+          endif !if (option_traceurs.EQ.6) THEN
 !          WRITE(*,*) 'delt*conversion=',delt*conversion(iso_eau)
 !           WRITE(*,*) 'delt*fxtYe=',delt*fxtYe(iso_eau)
 !           WRITE(*,*) 'delt*fxtqe=',delt*fxtqe(iso_eau)
 
-        endif ! if ((option_traceurs.ne.6).and.(option_traceurs.ne.19)) THEN
+        endif ! if ((option_traceurs.NE.6).AND.(option_traceurs.NE.19)) THEN
 #endif
         
@@ -5959,33 +5959,33 @@
 #endif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), &
                  fr(il,i),'cv3_routines 3493',errmax*0.1,errmaxrel)
           endif !if (iso_eau.gt.0) THEN
-          if ((iso_HDO.gt.0).and.(delt*fr(il,i).gt.ridicule)) THEN
-              if (iso_verif_aberrant_nostop( &
+          IF ((iso_HDO.gt.0).AND.(delt*fr(il,i).gt.ridicule)) THEN
+              IF (iso_verif_aberrant_nostop( &
                  fxt(iso_HDO,il,i)/fr(il,i), &
-                 'cv3_yield 3662').eq.1) THEN
+                 'cv3_yield 3662').EQ.1) THEN
 !                WRITE(*,*) 'il,i,icb(il),inb(il)=',il,i,icb(il),inb(il)
 !                WRITE(*,*) 'fr(il,i),delt=',fr(il,i),delt
 #ifdef DIAGISO
-                if (fq_ddft(il,i).ne.0.0) THEN
+                IF (fq_ddft(il,i).NE.0.0) THEN
                 WRITE(*,*) 'fq_ddft,deltaD=',fq_ddft(il,i),deltaD( &
                    fxt_ddft(iso_HDO,il,i)/fq_ddft(il,i))
-                endif !if (fq_ddft(il,i).ne.0.0) THEN
-                if (fq_evapprecip(il,i).ne.0.0) THEN
+                endif !if (fq_ddft(il,i).NE.0.0) THEN
+                IF (fq_evapprecip(il,i).NE.0.0) THEN
                 WRITE(*,*) 'fq_evapprecip,deltaD=',fq_evapprecip(il,i), &
                    deltaD(fxt_evapprecip(iso_HDO,il,i) &
                    /fq_evapprecip(il,i))
-                endif !if (fq_evapprecip(il,i).ne.0.0) THEN
+                endif !if (fq_evapprecip(il,i).NE.0.0) THEN
 #endif                
                endif !if (iso_verif_aberrant_nostop(
           endif !if (iso_HDO.gt.0) THEN
-          if ((iso_HDO.gt.0).and.& 
+          IF ((iso_HDO.gt.0).AND.&
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
-           if (iso_verif_aberrant_nostop((xt(iso_HDO,il,i) &
+           IF (iso_verif_aberrant_nostop((xt(iso_HDO,il,i) &
                  +delt*fxt(iso_HDO,il,i)) &
                  /(rr(il,i)+delt*fr(il,i)),'cv3_yield 3757, ddfts') &
-                 .eq.1) THEN
+                 .EQ.1) THEN
                 WRITE(*,*) 'i,il,q,deltaD=',i,il,rr(il,i),deltaD( &
                    xt(iso_HDO,il,i)/rr(il,i))
@@ -6001,6 +6001,6 @@
           xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew, &
-                        'cv3_yield 4221',1e-5).eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew, &
+                        'cv3_yield 4221',1e-5).EQ.1) THEN
           WRITE(*,*) 'delt*fxt(,il,i)=',delt*fxt(1:ntraciso:2,il,i)
           WRITE(*,*) 'delt*fxt(,il,i)=',delt*fxt(:,il,i)
@@ -6059,9 +6059,9 @@
 #endif
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), &
                  fr(il,i),'cv3_routines 3226',errmax*0.1,errmaxrel)
         endif !if (iso_eau.gt.0) THEN
-        if ((iso_HDO.gt.0).and. &
+        IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
          CALL iso_verif_aberrant((xt(iso_HDO,il,i) &
@@ -6069,5 +6069,5 @@
                  /(rr(il,i)+delt*fr(il,i)),'cv3_yield 3384, flux masse')
         endif !if (iso_HDO.gt.0) THEN
-        if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
+        IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_O18_aberrant((xt(iso_HDO,il,i) &
@@ -6081,6 +6081,6 @@
           xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew,'cv3_yield 3727',1e-5) &
-                 .eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew,'cv3_yield 3727',1e-5) &
+                 .EQ.1) THEN
               WRITE(*,*) 'il,i=',il,i
               WRITE(*,*) 'fxt(:,il,i)=',fxt(:,il,i)
@@ -6106,5 +6106,5 @@
 !AC!      do k=1,ntra
 !AC!       do il=1,ncum
-!AC!        if (i.le.inb(il) .and. iflag(il) .le. 1) THEN
+!AC!        if (i.le.inb(il) .AND. iflag(il) .le. 1) THEN
 !AC!         dpinv=1.0/(ph(il,i)-ph(il,i+1))
 !AC!         cpinv=1.0/cpn(il,i)
@@ -6147,5 +6147,5 @@
         ! ce surplus a la meme compo que le elij, sans fractionnement.
         ! d'ou le nouveau traitement ci-dessous.
-      if (elij(il,k,i).gt.0.0) THEN
+      IF (elij(il,k,i).gt.0.0) THEN
         do ixt = 1, ntraciso
           xtawat(ixt,il)=awat(il)*(xtelij(ixt,il,k,i)/elij(il,k,i))
@@ -6164,5 +6164,5 @@
       ! cam verif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(xtawat(iso_eau,il), &
                  awat(il),'cv3_routines 3301',errmax,errmaxrel)
@@ -6216,14 +6216,14 @@
 #endif  
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), &
                  fr(il,i),'cv3_routines 3325',errmax,errmaxrel)
         endif !if (iso_eau.gt.0) THEN
-        if ((iso_HDO.gt.0).and. &
+        IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
-        if (iso_verif_aberrant_nostop((xt(iso_HDO,il,i) &
+        IF (iso_verif_aberrant_nostop((xt(iso_HDO,il,i) &
                  +delt*fxt(iso_HDO,il,i)) &
                  /(rr(il,i)+delt*fr(il,i)),'cv3_yield 3396a, dtr mels') &
-                 .eq.1) THEN
+                 .EQ.1) THEN
            WRITE(*,*) 'rr,delt,fr=',rr(il,i),delt,fr(il,i)
            WRITE(*,*) 'qent,awat=',qent(il,k,i),awat(il)
@@ -6241,6 +6241,6 @@
           xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew,'cv3_yield 3905',1e-5) &
-                 .eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew,'cv3_yield 3905',1e-5) &
+                 .EQ.1) THEN
               WRITE(*,*) 'il,i=',il,i
          endif
@@ -6264,5 +6264,5 @@
 !AC!       do k=1,i-1
 !AC!        do il=1,ncum
-!AC!         if (i.le.inb(il) .and. iflag(il) .le. 1) THEN
+!AC!         if (i.le.inb(il) .AND. iflag(il) .le. 1) THEN
 !AC!          dpinv=1.0/(ph(il,i)-ph(il,i+1))
 !AC!          cpinv=1.0/cpn(il,i)
@@ -6331,17 +6331,17 @@
 #endif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), &
                  fr(il,i),'cv3_routines 3433',errmax,errmaxrel)
           endif !if (iso_eau.gt.0) THEN
-!          if ((iso_HDO.gt.0).and.(delt*fr(il,i).gt.ridicule)) THEN
+!          if ((iso_HDO.gt.0).AND.(delt*fr(il,i).gt.ridicule)) THEN
 !              if (iso_verif_aberrant_nostop( &
 !     &           fxt(iso_HDO,il,i)/fr(il,i), &
-!     &           'cv3_yield 3597').eq.1) THEN
+!     &           'cv3_yield 3597').EQ.1) THEN
 !                WRITE(*,*) 'i,icb(il),inb(il)=',i,icb(il),inb(il)
 !                stop
 !               endif
 !          endif !if (iso_HDO.gt.0) THEN
-          if ((iso_HDO.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_aberrant((xt(iso_HDO,il,i) &
@@ -6349,5 +6349,5 @@
                  /(rr(il,i)+delt*fr(il,i)),'cv3_yield 3605b, dtr mels')
           endif !if (iso_HDO.gt.0) THEN
-          if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_O18_aberrant((xt(iso_HDO,il,i) &
@@ -6361,6 +6361,6 @@
           xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
         enddo
-        if (iso_verif_tracpos_choix_nostop(xtnew,'cv3_yield 4091',1e-5) &
-                 .eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(xtnew,'cv3_yield 4091',1e-5) &
+                 .EQ.1) THEN
               WRITE(*,*) 'il,i=',il,i
          endif
@@ -6379,6 +6379,6 @@
 !AC!       do k=i,nl+1
 !AC!        do il=1,ncum
-!AC!         if (i.le.inb(il) .and. k.le.inb(il)
-!AC!     $                .and. iflag(il) .le. 1) THEN
+!AC!         if (i.le.inb(il) .AND. k.le.inb(il)
+!AC!     $                .AND. iflag(il) .le. 1) THEN
 !AC!          dpinv=1.0/(ph(il,i)-ph(il,i+1))
 !AC!          cpinv=1.0/cpn(il,i)
@@ -6448,5 +6448,5 @@
 !AC!      do j=1,ntra
 !AC!       do il=1,ncum
-!AC!        if (i.le.inb(il) .and. iflag(il) .le. 1) THEN
+!AC!        if (i.le.inb(il) .AND. iflag(il) .le. 1) THEN
 !AC!         dpinv=1.0/(ph(il,i)-ph(il,i+1))
 !AC!         cpinv=1.0/cpn(il,i)
@@ -6524,9 +6524,9 @@
 #ifdef ISOVERIF
         do i=inb(il)-1,inb(il)
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite(fxt(iso_eau,il,i), &
                  fr(il,i),'cv3_routines 5308')
         endif !if (iso_eau.gt.0) THEN
-        if ((iso_HDO.gt.0).and. &
+        IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_aberrant((xt(iso_HDO,il,i) &
@@ -6534,10 +6534,10 @@
                  /(rr(il,i)+delt*fr(il,i)),'cv3_yield 6555')
         endif !if (iso_HDO.gt.0) THEN
-          if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
-           if (iso_verif_O18_aberrant_nostop((xt(iso_HDO,il,i) &
+           IF (iso_verif_O18_aberrant_nostop((xt(iso_HDO,il,i) &
               +delt*fxt(iso_HDO,il,i))/(rr(il,i)+delt*fr(il,i)),(xt(iso_O18,il,i) &
               +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)), &
-              'cv3_yield 6555b').eq.1) THEN
+              'cv3_yield 6555b').EQ.1) THEN
                 WRITE(*,*) 'il,i=',il,i
                 WRITE(*,*) 'deltaOavant=',deltaO(xt(iso_O18,il,i)/rr(il,i))
@@ -6696,5 +6696,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite(fxt(iso_eau,il,i), &
                  fr(il,i),'cv3_routines 5415')
@@ -6703,6 +6703,6 @@
               CALL iso_verif_egalite(bxtsum(iso_eau,il), &
                  bsum(il),'cv3_routines 5419')
-              if (iso_verif_egalite_nostop(fxtsum(iso_eau,il), &
-                 fsum(il),'cv3_routines 5421').eq.1) THEN
+              IF (iso_verif_egalite_nostop(fxtsum(iso_eau,il), &
+                 fsum(il),'cv3_routines 5421').EQ.1) THEN
                 WRITE(*,*) 'i,il=',i,il
                 WRITE(*,*) 'fxtd(iso_eau,il,:)=',fxtd(iso_eau,il,:)
@@ -6735,5 +6735,5 @@
            CALL iso_verif_noNaN(fxtd(ixt,il,i),'cv3_yield 5661')
         enddo
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite(fxt(iso_eau,il,i), &
                  fr(il,i),'cv3_routines 5437')
@@ -6741,5 +6741,5 @@
                  fqd(il,i),'cv3_routines 5439',errmax*0.1,errmaxrel)
         endif !if (iso_eau.gt.0) THEN
-        if ((iso_HDO.gt.0).and. &
+        IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_aberrant((xt(iso_HDO,il,i) &
@@ -6747,5 +6747,5 @@
                  /(rr(il,i)+delt*fr(il,i)),'cv3_yield 6744')
         endif !if (iso_HDO.gt.0) THEN
-          if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_O18_aberrant((xt(iso_HDO,il,i) &
@@ -6833,9 +6833,9 @@
            CALL iso_verif_noNaN(fxtd(ixt,il,i),'cv3_yield 5731b')
         enddo
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite(fxt(iso_eau,il,i), &
                  fr(il,i),'cv3_routines 5502')
         endif !if (iso_eau.gt.0) THEN
-        if ((iso_HDO.gt.0).and. &
+        IF ((iso_HDO.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_aberrant((xt(iso_HDO,il,i) &
@@ -6843,10 +6843,10 @@
                  /(rr(il,i)+delt*fr(il,i)),'cv3_yield 6835a')
         endif !if (iso_HDO.gt.0) THEN
-          if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
+          IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. &
                  (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
-           if (iso_verif_O18_aberrant_nostop((xt(iso_HDO,il,i) &
+           IF (iso_verif_O18_aberrant_nostop((xt(iso_HDO,il,i) &
               +delt*fxt(iso_HDO,il,i))/(rr(il,i)+delt*fr(il,i)),(xt(iso_O18,il,i) &
               +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)), &
-              'cv3_yield 6835b').eq.1) THEN
+              'cv3_yield 6835b').EQ.1) THEN
                 WRITE(*,*) 'il,i=',il,i
                 WRITE(*,*) 'deltaOavant=',deltaO(xt(iso_O18,il,i)/rr(il,i))
@@ -7030,5 +7030,5 @@
     DO k = i, nl
       DO il = 1, ncum
-! test         if (i.ge.icb(il).and.i.le.inb(il).and.k.le.inb(il)) THEN
+! test         if (i.ge.icb(il).AND.i.le.inb(il).AND.k.le.inb(il)) THEN
         IF (i<=inb(il) .AND. k<=inb(il)) THEN
           upwd(il, i) = upwd(il, i) + up1(il, k, i)
@@ -7243,5 +7243,5 @@
         do i=1,nl  
           do il=1,ncum
-            if (f_detrainement(il,i).gt.0.0) THEN
+            IF (f_detrainement(il,i).gt.0.0) THEN
               q_detrainement(il,i)=q_detrainement(il,i) &
                   /f_detrainement(il,i)
@@ -7314,5 +7314,5 @@
       DO i = 1, ncum
         IF (k>=icb(i) .AND. k<=inb(i) .AND. & 
-!!jyg              j.ge.k.and.j.le.inb(i)) THEN
+!!jyg              j.ge.k.AND.j.le.inb(i)) THEN
 !!jyg             epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/elij(i,k,j)
             j>k .AND. j<=inb(i)) THEN
@@ -7397,7 +7397,7 @@
            )
 #ifdef ISO
-    use infotrac_phy, ONLY: ntraciso=>ntiso
+    USE infotrac_phy, ONLY: ntraciso=>ntiso
 #ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: Tmin_verif,iso_verif_aberrant, &
+    USE isotopes_verif_mod, ONLY: Tmin_verif,iso_verif_aberrant, &
         iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
         iso_verif_egalite_nostop,iso_verif_aberrant_nostop,deltaD,iso_verif_noNaN_nostop, &
@@ -7424,7 +7424,7 @@
 #ifdef ISO
       !integer niso
-      real xtprecip(ntraciso,nloc)
-      real fxt(ntraciso,nloc,nd)
-      real xtVPrecip(ntraciso,nloc,nd+1)
+      REAL xtprecip(ntraciso,nloc)
+      REAL fxt(ntraciso,nloc,nd)
+      REAL xtVPrecip(ntraciso,nloc,nd+1)
 #endif
 
@@ -7441,7 +7441,7 @@
   REAL epmax_diag1(len) ! epmax_cape
 #ifdef ISO
-      real xtprecip1(ntraciso,len)
-      real fxt1(ntraciso,len,nd)
-      real xtVPrecip1(ntraciso,len,nd+1)
+      REAL xtprecip1(ntraciso,len)
+      REAL fxt1(ntraciso,len,nd)
+      REAL xtVPrecip1(ntraciso,len,nd+1)
 #endif
 
@@ -7449,48 +7449,48 @@
   INTEGER i, k, j
 #ifdef ISO
-      integer ixt
+      INTEGER ixt
 #endif
 
 #ifdef DIAGISO
-      real water(nloc,nd)
-      real xtwater(ntraciso,nloc,nd)
-      real qp(nloc,nd),xtp(ntraciso,nloc,nd)
-      real evap(nloc,nd),xtevap(ntraciso,nloc,nd)
-      real wdtrainA(nloc,nd)
-      real xtwdtrainA(ntraciso,nloc,nd)
-      real clw(nloc,nd)
-      real xtclw(ntraciso,nloc,nd)
-      real fq_detrainement(nloc,nd)
-      real f_detrainement(nloc,nd)
-      real q_detrainement(nloc,nd)
-      real fq_ddft(nloc,nd)
-      real fq_fluxmasse(nloc,nd)
-      real fq_evapprecip(nloc,nd)
-      real fxt_detrainement(ntraciso,nloc,nd)
-      real xt_detrainement(ntraciso,nloc,nd)
-      real fxt_ddft(ntraciso,nloc,nd)
-      real fxt_fluxmasse(ntraciso,nloc,nd)
-      real fxt_evapprecip(ntraciso,nloc,nd)
-
-      real water1(len,nd)
-      real xtwater1(ntraciso,len,nd)
-      real qp1(len,nd),xtp1(ntraciso,len,nd)
-      real evap1(nloc,nd)
-      real xtevap1(ntraciso,nloc,nd)
-      real wdtrainA1(len,nd)
-      real xtwdtrainA1(ntraciso,len,nd)
-      real clw1(len,nd)
-      real xtclw1(ntraciso,len,nd)
-      real fq_detrainement1(len,nd)
-      real f_detrainement1(len,nd)
-      real q_detrainement1(len,nd)
-      real fq_ddft1(len,nd)
-      real fq_fluxmasse1(len,nd)
-      real fq_evapprecip1(len,nd)
-      real fxt_detrainement1(ntraciso,len,nd)
-      real xt_detrainement1(ntraciso,len,nd)
-      real fxt_ddft1(ntraciso,len,nd)
-      real fxt_fluxmasse1(ntraciso,len,nd)
-      real fxt_evapprecip1(ntraciso,len,nd)
+      REAL water(nloc,nd)
+      REAL xtwater(ntraciso,nloc,nd)
+      REAL qp(nloc,nd),xtp(ntraciso,nloc,nd)
+      REAL evap(nloc,nd),xtevap(ntraciso,nloc,nd)
+      REAL wdtrainA(nloc,nd)
+      REAL xtwdtrainA(ntraciso,nloc,nd)
+      REAL clw(nloc,nd)
+      REAL xtclw(ntraciso,nloc,nd)
+      REAL fq_detrainement(nloc,nd)
+      REAL f_detrainement(nloc,nd)
+      REAL q_detrainement(nloc,nd)
+      REAL fq_ddft(nloc,nd)
+      REAL fq_fluxmasse(nloc,nd)
+      REAL fq_evapprecip(nloc,nd)
+      REAL fxt_detrainement(ntraciso,nloc,nd)
+      REAL xt_detrainement(ntraciso,nloc,nd)
+      REAL fxt_ddft(ntraciso,nloc,nd)
+      REAL fxt_fluxmasse(ntraciso,nloc,nd)
+      REAL fxt_evapprecip(ntraciso,nloc,nd)
+
+      REAL water1(len,nd)
+      REAL xtwater1(ntraciso,len,nd)
+      REAL qp1(len,nd),xtp1(ntraciso,len,nd)
+      REAL evap1(nloc,nd)
+      REAL xtevap1(ntraciso,nloc,nd)
+      REAL wdtrainA1(len,nd)
+      REAL xtwdtrainA1(ntraciso,len,nd)
+      REAL clw1(len,nd)
+      REAL xtclw1(ntraciso,len,nd)
+      REAL fq_detrainement1(len,nd)
+      REAL f_detrainement1(len,nd)
+      REAL q_detrainement1(len,nd)
+      REAL fq_ddft1(len,nd)
+      REAL fq_fluxmasse1(len,nd)
+      REAL fq_evapprecip1(len,nd)
+      REAL fxt_detrainement1(ntraciso,len,nd)
+      REAL xt_detrainement1(ntraciso,len,nd)
+      REAL fxt_ddft1(ntraciso,len,nd)
+      REAL fxt_fluxmasse1(ntraciso,len,nd)
+      REAL fxt_evapprecip1(ntraciso,len,nd)
 #endif
 
@@ -7618,14 +7618,14 @@
 
 ! local
-      integer i,k    
+      INTEGER i,k
 !      real hp_bak(nloc,nd)
 !      real ep_bak(nloc,nd)
-      real m_loc(nloc,nd)
-      real sig_loc(nloc,nd)
-      real w0_loc(nloc,nd)
-      integer iflag_loc(nloc)
-      real cape(nloc)
+      REAL m_loc(nloc,nd)
+      REAL sig_loc(nloc,nd)
+      REAL w0_loc(nloc,nd)
+      INTEGER iflag_loc(nloc)
+      REAL cape(nloc)
         
-        if (coef_epmax_cape>1e-12) THEN
+        IF (coef_epmax_cape>1e-12) THEN
         ! il faut calculer la cape: on fait un calcule simple car tant qu'on ne
         ! connait pas ep, on ne connait pas les melanges, ddfts etc... qui sont
@@ -7680,5 +7680,5 @@
       do k=minorig+1,nl
        do i=1,ncum
-        if((k>=icb(i)).and.(k<=inb(i)))THEN
+        IF((k>=icb(i)).AND.(k<=inb(i)))THEN
           hp(i, k) = hnk(i) + (lv(i,k)+(cpd-cpv)*t(i,k)+frac(i,k)*lf(i,k))* &
                               ep(i, k)*clw(i, k)
@@ -7700,6 +7700,6 @@
 !      do i=1,ncum  
 !       do k=1,nl
-!        if ((abs(hp_bak(i,k)-hp(i,k))/hp_bak(i,k).gt.1e-1).or. &
-!            ((abs(hp_bak(i,k)-hp(i,k))/hp_bak(i,k).gt.1e-4).and. &
+!        if ((abs(hp_bak(i,k)-hp(i,k))/hp_bak(i,k).gt.1e-1).OR. &
+!            ((abs(hp_bak(i,k)-hp(i,k))/hp_bak(i,k).gt.1e-4).AND. &
 !            (ep(i,k)-ep_bak(i,k).lt.1e-4))) THEN
 !           WRITE(*,*) 'i,k=',i,k
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3a_compress.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3a_compress.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3a_compress.F90	(revision 5117)
@@ -34,8 +34,8 @@
   ! **************************************************************
 #ifdef ISO
-    use infotrac_phy, ONLY: ntraciso=>ntiso
-    use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO
+    USE infotrac_phy, ONLY: ntraciso=>ntiso
+    USE isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO
 #ifdef ISOVERIF
-    use isotopes_verif_mod
+    USE isotopes_verif_mod
 #endif
 #endif
@@ -116,5 +116,5 @@
   INTEGER i, k, nn, j
 #ifdef ISO  
-      integer ixt  
+      INTEGER ixt
 #endif
 
@@ -181,5 +181,5 @@
   ! AC!       nn=0
   ! AC!      do 101 i=1,len
-  ! AC!      IF(iflag1(i).eq.0)THEN
+  ! AC!      IF(iflag1(i).EQ.0)THEN
   ! AC!       nn=nn+1
   ! AC!       tra(nn,k,j)=tra1(i,k,j)
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3a_uncompress.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3a_uncompress.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3a_uncompress.F90	(revision 5117)
@@ -103,12 +103,12 @@
 
 #ifdef ISO
-      real, DIMENSION (ntraciso,nloc), INTENT (IN)      :: xtprecip
-      real, DIMENSION (ntraciso,nloc,nd), INTENT (IN)   :: fxt
-      real, DIMENSION(ntraciso,nloc,nd), INTENT (IN)   ::   fxtd
-      real, DIMENSION(ntraciso,nloc,nd+1), INTENT (IN)   ::   xtvprecip
-      real, DIMENSION(ntraciso,nloc,nd+1), INTENT (IN)   ::   xtvprecipi
-      real xtevap(ntraciso,nloc,nd)
-      real xtwdtraina(ntraciso,nloc,nd)
-      real xtclw(ntraciso,nloc,nd)
+      REAL, DIMENSION (ntraciso,nloc), INTENT (IN)      :: xtprecip
+      REAL, DIMENSION (ntraciso,nloc,nd), INTENT (IN)   :: fxt
+      REAL, DIMENSION(ntraciso,nloc,nd), INTENT (IN)   ::   fxtd
+      REAL, DIMENSION(ntraciso,nloc,nd+1), INTENT (IN)   ::   xtvprecip
+      REAL, DIMENSION(ntraciso,nloc,nd+1), INTENT (IN)   ::   xtvprecipi
+      REAL xtevap(ntraciso,nloc,nd)
+      REAL xtwdtraina(ntraciso,nloc,nd)
+      REAL xtclw(ntraciso,nloc,nd)
 #endif
 
@@ -152,8 +152,8 @@
 #ifdef ISO
   REAL, DIMENSION (ntraciso,len), INTENT (OUT)                :: xtprecip1
-  real, DIMENSION (ntraciso,len,nd), INTENT (OUT)             :: fxt1
-  real, DIMENSION (ntraciso,len,nd), INTENT (OUT)             :: fxtd1
-  real, DIMENSION (ntraciso,len,nd+1), INTENT (OUT)           :: xtvprecip1
-  real, DIMENSION (ntraciso,len,nd+1), INTENT (OUT)           :: xtvprecipi1
+  REAL, DIMENSION (ntraciso,len,nd), INTENT (OUT)             :: fxt1
+  REAL, DIMENSION (ntraciso,len,nd), INTENT (OUT)             :: fxtd1
+  REAL, DIMENSION (ntraciso,len,nd+1), INTENT (OUT)           :: xtvprecip1
+  REAL, DIMENSION (ntraciso,len,nd+1), INTENT (OUT)           :: xtvprecipi1
   REAL, DIMENSION (ntraciso,len, nd), INTENT (OUT)            :: xtevap1
   REAL, DIMENSION (ntraciso,len, nd), INTENT (OUT)            :: xtwdtrainA1
@@ -167,40 +167,40 @@
 
 #ifdef ISO
-      integer ixt
+      INTEGER ixt
 #endif
 
 #ifdef DIAGISO
-      real water(nloc,nd)
-      real xtwater(ntraciso,nloc,nd)
-      real qp(nloc,nd),xtp(ntraciso,nloc,nd)
-      real fq_detrainement(nloc,nd)
-      real f_detrainement(nloc,nd)
-      real q_detrainement(nloc,nd)
-      real xt_detrainement(ntraciso,nloc,nd)
-      real fq_ddft(nloc,nd)
-      real fq_fluxmasse(nloc,nd)
-      real Amp_diag(nloc,nd)
-      real tg_save(nloc,nd) ! temperature de cond pour les isos
-      real fq_evapprecip(nloc,nd)
-      real fxt_detrainement(ntraciso,nloc,nd)
-      real fxt_ddft(ntraciso,nloc,nd)
-      real fxt_fluxmasse(ntraciso,nloc,nd)
-      real fxt_evapprecip(ntraciso,nloc,nd)
-      real m(nloc,nd)
-
-      real water1(len,nd)
-      real xtwater1(ntraciso,len,nd)
-      real qp1(len,nd),xtp1(ntraciso,len,nd)
-      real fq_detrainement1(len,nd)
-      real f_detrainement1(len,nd)
-      real q_detrainement1(len,nd)
-      real xt_detrainement1(ntraciso,len,nd)
-      real fq_ddft1(len,nd)
-      real fq_fluxmasse1(len,nd)
-      real fq_evapprecip1(len,nd)
-      real fxt_detrainement1(ntraciso,len,nd)
-      real fxt_ddft1(ntraciso,len,nd)
-      real fxt_fluxmasse1(ntraciso,len,nd)
-      real fxt_evapprecip1(ntraciso,len,nd)
+      REAL water(nloc,nd)
+      REAL xtwater(ntraciso,nloc,nd)
+      REAL qp(nloc,nd),xtp(ntraciso,nloc,nd)
+      REAL fq_detrainement(nloc,nd)
+      REAL f_detrainement(nloc,nd)
+      REAL q_detrainement(nloc,nd)
+      REAL xt_detrainement(ntraciso,nloc,nd)
+      REAL fq_ddft(nloc,nd)
+      REAL fq_fluxmasse(nloc,nd)
+      REAL Amp_diag(nloc,nd)
+      REAL tg_save(nloc,nd) ! temperature de cond pour les isos
+      REAL fq_evapprecip(nloc,nd)
+      REAL fxt_detrainement(ntraciso,nloc,nd)
+      REAL fxt_ddft(ntraciso,nloc,nd)
+      REAL fxt_fluxmasse(ntraciso,nloc,nd)
+      REAL fxt_evapprecip(ntraciso,nloc,nd)
+      REAL m(nloc,nd)
+
+      REAL water1(len,nd)
+      REAL xtwater1(ntraciso,len,nd)
+      REAL qp1(len,nd),xtp1(ntraciso,len,nd)
+      REAL fq_detrainement1(len,nd)
+      REAL f_detrainement1(len,nd)
+      REAL q_detrainement1(len,nd)
+      REAL xt_detrainement1(ntraciso,len,nd)
+      REAL fq_ddft1(len,nd)
+      REAL fq_fluxmasse1(len,nd)
+      REAL fq_evapprecip1(len,nd)
+      REAL fxt_detrainement1(ntraciso,len,nd)
+      REAL fxt_ddft1(ntraciso,len,nd)
+      REAL fxt_fluxmasse1(ntraciso,len,nd)
+      REAL fxt_evapprecip1(ntraciso,len,nd)
 #endif
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3p_mixing.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3p_mixing.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3p_mixing.F90	(revision 5117)
@@ -132,10 +132,10 @@
 
 #ifdef ISO
-      integer ixt
-      real xtrti(ntraciso)
-      real xtres(ntraciso)
-      real zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)
-      real qent_diag(nloc,nd,nd)
-      real xtent_diag(ntraciso,nloc,nd,nd)
+      INTEGER ixt
+      REAL xtrti(ntraciso)
+      REAL xtres(ntraciso)
+      REAL zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)
+      REAL qent_diag(nloc,nd,nd)
+      REAL xtent_diag(ntraciso,nloc,nd,nd)
 #endif   
 
@@ -295,7 +295,7 @@
          zfice(il) = MIN(MAX(zfice(il),0.0),1.0)
 
-         IF( (i.ge.icb(il)).and.(i.le.inb(il)).and. &
-           (j.ge.(icb(il)-1)).and.(j.le.inb(il))) THEN
-          if (sij(il,i,j).gt.0.0) THEN
+         IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND. &
+           (j.ge.(icb(il)-1)).AND.(j.le.inb(il))) THEN
+          IF (sij(il,i,j).gt.0.0) THEN
            do ixt=1,ntraciso
             xtrti(ixt)=xtta(ixt,il,i-1)-ep(il,i)*xtclw(ixt,il,i) 
@@ -304,5 +304,5 @@
            enddo ! do ixt=1,ntraciso 
 #ifdef ISOVERIF 
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
           CALL iso_verif_egalite(xtta(iso_eau,il,i-1), &
                 qta(il,i-1),'cv3p_mixing 256a')
@@ -318,5 +318,5 @@
 #endif           
 #endif           
-           if (qent_diag(il,i,j).lt.elij(il,i,j)) THEN
+           IF (qent_diag(il,i,j).lt.elij(il,i,j)) THEN
              do ixt=1,ntraciso
                xtent_diag(ixt,il,i,j)=  xtent_diag(ixt,il,i,j) &
@@ -329,7 +329,7 @@
 #endif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
-           if (iso_verif_egalite_nostop(xtent_diag(iso_eau,il,i,j), &
-                qent_diag(il,i,j),'cv3p_mixing 258').eq.1) THEN
+          IF (iso_eau.gt.0) THEN
+           IF (iso_verif_egalite_nostop(xtent_diag(iso_eau,il,i,j), &
+                qent_diag(il,i,j),'cv3p_mixing 258').EQ.1) THEN
              WRITE(*,*) 'il,i,j=',il,i,j
              WRITE(*,*) 'qent_diag(il,i,j),elij(il,i,j)=', &
@@ -353,5 +353,5 @@
             enddo !do ixt=1,ntraciso
          endif  !IF(sij(il,i,j).gt.0.0)THEN
-        else  !IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
+        else  !IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND.
             ! ajout le 4 mai 2012: initialiser au cas où
             elij(il,i,j)=0.0 
@@ -360,5 +360,5 @@
               xtent_diag(ixt,il,i,j)=xt(ixt,il,i)
             enddo !do ixt=1,ntraciso
-        endif !IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
+        endif !IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND.
 #ifdef ISOVERIF
 #ifdef VERIFNEGATIF
@@ -395,11 +395,11 @@
 !        WRITE(*,*) 'cv3p_mixing tmp 1987,option_traceurs=',
 !     :           option_traceurs
-        if (option_tmin.ge.1) THEN
+        IF (option_tmin.ge.1) THEN
         do il=1,ncum    
         ! colorier la vapeur résiduelle selon température de
         ! condensation, et le condensat en un tag spécifique
-          if ((elij(il,i,j).gt.0.0).and. &
+          IF ((elij(il,i,j).gt.0.0).AND. &
                 (qent_diag(il,i,j).gt.0.0)) THEN
-            if (option_traceurs.eq.17) THEN
+            IF (option_traceurs.EQ.17) THEN
              CALL iso_recolorise_condensation(qent_diag(il,i,j), &
                 elij(il,i,j), &
@@ -407,5 +407,5 @@
                 0.0,xtres, &
                 seuil_tag_tmin)
-            else !if (option_traceurs.eq.17) THEN
+            else !if (option_traceurs.EQ.17) THEN
 !             WRITE(*,*) 'cv3 2002: il,i,j  =',il,i,j
              CALL iso_recolorise_condensation(qent_diag(il,i,j), &
@@ -413,5 +413,5 @@
                 xtent_diag(1,il,i,j),xtelij(1,il,i,j),rs(il,j), &
                 0.0,xtres,seuil_tag_tmin)
-            endif !if (option_traceurs.eq.17) THEN
+            endif !if (option_traceurs.EQ.17) THEN
             do ixt=1+niso,ntraciso
                xtent_diag(ixt,il,i,j)=xtres(ixt)
@@ -433,8 +433,8 @@
 #ifdef ISOVERIF                 
         do il=1,ncum
-        if ((i.ge.icb(il)).and.(i.le.inb(il)).and. &
-           (j.ge.(icb(il)-1)).and.(j.le.inb(il))) THEN
-        if (sij(il,i,j).gt.0.0.and.sij(il,i,j).lt.scut) THEN
-        if (iso_eau.gt.0) THEN
+        IF ((i.ge.icb(il)).AND.(i.le.inb(il)).AND. &
+           (j.ge.(icb(il)-1)).AND.(j.le.inb(il))) THEN
+        IF (sij(il,i,j).gt.0.0.AND.sij(il,i,j).lt.scut) THEN
+        IF (iso_eau.gt.0) THEN
           CALL iso_verif_egalite_choix(xtent(iso_eau,il,i,j), &
              qent(il,i,j),'cv3p_mixing 1889',errmax,errmaxrel)   
@@ -442,5 +442,5 @@
              elij(il,i,j),'cv3p_mixing 1890',errmax,errmaxrel) 
         endif
-        if (iso_hdo.gt.0) THEN
+        IF (iso_hdo.gt.0) THEN
           CALL iso_verif_aberrant_choix(xt(iso_HDO,il,i),rr(il,i), &
                  ridicule,deltalim,'cv3p_mixing 1997')         
@@ -461,5 +461,5 @@
 
         endif !IF(sij(il,i,j).gt.0.0)THEN
-        endif !IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
+        endif !IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND.
         enddo !do il=1,ncum
 #endif
@@ -491,5 +491,5 @@
     DO il = 1, ncum
       IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (nent(il,i)==0)) THEN
-! @      IF(nent(il,i).eq.0)THEN
+! @      IF(nent(il,i).EQ.0)THEN
 !!!       Ment(il,i,i)=m(il,i)
         Ment(il, i, i) = 1.
@@ -511,5 +511,5 @@
       enddo ! do ixt = 1, ntraciso 
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
           CALL iso_verif_egalite_choix(xtent(iso_eau,il,i,i), &
              qent(il,i,i),'cv3p_mixing 414',errmax,errmaxrel)
@@ -517,11 +517,11 @@
 #endif
 #ifdef ISOTRAC          
-        if (option_tmin.ge.1) THEN
+        IF (option_tmin.ge.1) THEN
         ! colorier la vapeur résiduelle selon température de
         ! condensation, et le condensat en un tag spécifique
 !        WRITE(*,*) 'cv3 tmp 2095 il,i,j,xtent(:,il,i,j)=',
 !     :            il,i,j,xtent(:,il,i,j)
-          if ((elij(il,i,i).gt.0.0).and.(qent(il,i,i).gt.0.0)) THEN
-            if (option_traceurs.eq.17) THEN
+          IF ((elij(il,i,i).gt.0.0).AND.(qent(il,i,i).gt.0.0)) THEN
+            IF (option_traceurs.EQ.17) THEN
              CALL iso_recolorise_condensation(qent(il,i,i), &
                 elij(il,i,i), &
@@ -529,5 +529,5 @@
                 xtres, &
                 seuil_tag_tmin)
-            else !if (option_traceurs.eq.17) THEN
+            else !if (option_traceurs.EQ.17) THEN
              CALL iso_recolorise_condensation(qent(il,i,i), &
                 elij(il,i,i), &
@@ -535,5 +535,5 @@
                 xtres, &
                 seuil_tag_tmin)
-            endif !if (option_traceurs.eq.17) THEN
+            endif !if (option_traceurs.EQ.17) THEN
             do ixt=1+niso,ntraciso
               xtent(ixt,il,i,i)=xtres(ixt)
@@ -556,7 +556,7 @@
         endif !if (option_tmin.ge.1) THEN
 #endif
-! endif ISOTRAC
-#endif
-! endif ISO
+! END IF ISOTRAC
+#endif
+! END IF ISO
 
       END IF ! IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (nent(il,i)==0)) THEN
@@ -819,5 +819,5 @@
     cpm = cpd+Qent(il,i,j)*(cpv-cpd)
 
-    IF (cvflag_ice .and. frac(il,j) > 0.) THEN
+    IF (cvflag_ice .AND. frac(il,j) > 0.) THEN
             elij(il, i, j) = Qent(il, i, j) - rs(il, j)
             elij(il, i, j) = elij(il, i, j) + &
@@ -854,5 +854,5 @@
 !            hent(il, i, j) = hent(il, i, j) + (lv(il,j)+(cpd-cpv)*t(il,j))*awat
 ! Mixed draught temperature at level j
-    IF (cvflag_ice .and. frac(il,j) > 0.) THEN
+    IF (cvflag_ice .AND. frac(il,j) > 0.) THEN
           Tm = t(il,j) + (Qent(il,i,j)-elij(il,i,j)-rs(il,j))*rrv*t(il,j)*t(il,j)/(lv(il,j)*rs(il,j))
           hent(il, i, j) = hent(il, i, j) + (lv(il,j)+frac(il,j)*lf(il,j)+(cpd-cpv)*Tm)*awat
@@ -882,7 +882,7 @@
           zfice(il) = 1.0-(t(il,j)-pxtice)/(pxtmelt-pxtice)
           zfice(il) = MIN(MAX(zfice(il),0.0),1.0)  
-       if ( i.ge.icb(il) .and. i.le.inb(il) .and. &
-           j.ge.(icb(il)-1) .and. j.le.inb(il) &
-           .and. lwork(il) ) THEN
+       IF ( i.ge.icb(il) .AND. i.le.inb(il) .AND. &
+           j.ge.(icb(il)-1) .AND. j.le.inb(il) &
+           .AND. lwork(il) ) THEN
         IF(sij(il,i,j).gt.0.0)THEN
           do ixt=1,ntraciso           
@@ -896,5 +896,5 @@
           CALL iso_verif_traceur(xtent(1,il,i,j),'cv3p_routines 714')
 #endif          
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite(xtent(iso_eau,il,i,j), &
                 qent(il,i,j),'cv3p_routines 718')    
@@ -902,5 +902,5 @@
 #endif              
          endif  !IF(sij(il,i,j).gt.0.0)THEN
-        endif !IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
+        endif !IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND.
        enddo  !do il=1,ncum
    
@@ -911,5 +911,5 @@
 #endif     
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
          do il=1,ncum   
             CALL iso_verif_egalite(xtent(iso_eau,il,i,j), &
@@ -933,7 +933,7 @@
 #endif    
         do il=1,ncum
-        if ( i.ge.icb(il) .and. i.le.inb(il) .and. &
-           j.ge.(icb(il)-1) .and. j.le.inb(il) &
-           .and. lwork(il) ) THEN
+        IF ( i.ge.icb(il) .AND. i.le.inb(il) .AND. &
+           j.ge.(icb(il)-1) .AND. j.le.inb(il) &
+           .AND. lwork(il) ) THEN
         IF(sij(il,i,j).gt.0.0)THEN
          do ixt = 1, ntraciso
@@ -941,9 +941,9 @@
          enddo !do ixt = 1, ntraciso
         endif !IF(sij(il,i,j).gt.0.0)THEN
-        endif !if ( i.ge.icb(il) .and. i.le.inb(il) .and.
+        endif !if ( i.ge.icb(il) .AND. i.le.inb(il) .AND.
         enddo !do il=1,ncum
 
 #ifdef ISOVERIF  
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
             do il=1,ncum
             CALL iso_verif_egalite(xtent(iso_eau,il,i,j), &
@@ -959,5 +959,5 @@
 !        WRITE(*,*) 'cv3_routines tmp 1987,option_traceurs=',
 !     :           option_traceurs
-        if (option_tmin.ge.1) THEN
+        IF (option_tmin.ge.1) THEN
         do il=1,ncum    
 !        WRITE(*,*) 'cv3 tmp 1991 il,i,j,xtent(:,il,i,j),',
@@ -966,16 +966,16 @@
         ! colorier la vapeur résiduelle selon température de
         ! condensation, et le condensat en un tag spécifique
-          if ((elij(il,i,j).gt.0.0).and.(qent(il,i,j).gt.0.0)) THEN
-            if (option_traceurs.eq.17) THEN
+          IF ((elij(il,i,j).gt.0.0).AND.(qent(il,i,j).gt.0.0)) THEN
+            IF (option_traceurs.EQ.17) THEN
              CALL iso_recolorise_condensation(qent(il,i,j),elij(il,i,j), &
                 xtent(1,il,i,j),xtelij(1,il,i,j),t(1,j), &
                 0.0,xtres, &
                 seuil_tag_tmin)
-            else !if (option_traceurs.eq.17) THEN
+            else !if (option_traceurs.EQ.17) THEN
 !             WRITE(*,*) 'cv3 2002: il,i,j  =',il,i,j
              CALL iso_recolorise_condensation(qent(il,i,j),elij(il,i,j), &
                 xtent(1,il,i,j),xtelij(1,il,i,j),rs(il,j),0.0,xtres, &
                 seuil_tag_tmin)
-            endif !if (option_traceurs.eq.17) THEN
+            endif !if (option_traceurs.EQ.17) THEN
             do ixt=1+niso,ntraciso
                xtent(ixt,il,i,j)=xtres(ixt)
@@ -993,5 +993,5 @@
         endif !if (option_tmin.ge.1) THEN
 #endif
-! endif ISOTRAC
+! END IF ISOTRAC
 
 #endif
@@ -1040,7 +1040,7 @@
           zfice(il) = 1.0-(t(il,j)-pxtice)/(pxtmelt-pxtice)
           zfice(il) = MIN(MAX(zfice(il),0.0),1.0)  
-       if ( i.ge.icb(il) .and. i.le.inb(il) .and. &
-           j.ge.(icb(il)-1) .and. j.le.inb(il) &
-           .and. lwork(il) ) THEN
+       IF ( i.ge.icb(il) .AND. i.le.inb(il) .AND. &
+           j.ge.(icb(il)-1) .AND. j.le.inb(il) &
+           .AND. lwork(il) ) THEN
         IF(sij(il,i,j).gt.0.0)THEN
           do ixt=1,ntraciso           
@@ -1056,5 +1056,5 @@
           CALL iso_verif_traceur(xtent(1,il,i,j),'cv3p_routines 714')
 #endif          
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite(xtent(iso_eau,il,i,j), &
                 qent(il,i,j),'cv3p_routines 718')    
@@ -1064,5 +1064,5 @@
 #endif
          endif  !IF(sij(il,i,j).gt.0.0)THEN
-        endif !IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
+        endif !IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND.
        enddo  !do il=1,ncum
       
@@ -1077,5 +1077,5 @@
          enddo !do ixt = 1, ntraciso
 #ifdef ISOVERIF
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
            CALL iso_verif_egalite(xtelij(iso_eau,il,i,j), &
                 elij(il,i,j),'cv3p_routines 1074')
@@ -1095,5 +1095,5 @@
 #endif   
         
-       if (option_tmin.ge.1) THEN
+       IF (option_tmin.ge.1) THEN
         do il=1,ncum    
 !        WRITE(*,*) 'cv3 tmp 1991 il,i,j,xtent(:,il,i,j),',
@@ -1102,16 +1102,16 @@
         ! colorier la vapeur résiduelle selon température de
         ! condensation, et le condensat en un tag spécifique
-          if ((elij(il,i,j).gt.0.0).and.(qent(il,i,j).gt.0.0)) THEN
-            if (option_traceurs.eq.17) THEN
+          IF ((elij(il,i,j).gt.0.0).AND.(qent(il,i,j).gt.0.0)) THEN
+            IF (option_traceurs.EQ.17) THEN
              CALL iso_recolorise_condensation(qent(il,i,j),elij(il,i,j), &
                 xtent(1,il,i,j),xtelij(1,il,i,j),t(1,j), &
                 0.0,xtres, &
                 seuil_tag_tmin)
-            else !if (option_traceurs.eq.17) THEN
+            else !if (option_traceurs.EQ.17) THEN
 !             WRITE(*,*) 'cv3 2002: il,i,j  =',il,i,j
              CALL iso_recolorise_condensation(qent(il,i,j),elij(il,i,j), &
                 xtent(1,il,i,j),xtelij(1,il,i,j),rs(il,j),0.0,xtres, &
                 seuil_tag_tmin)
-            endif !if (option_traceurs.eq.17) THEN
+            endif !if (option_traceurs.EQ.17) THEN
             do ixt=1+niso,ntraciso
                xtent(ixt,il,i,j)=xtres(ixt)
@@ -1132,5 +1132,5 @@
 !#ifdef ISOTRAC        
 #ifdef ISOVERIF        
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
             do il=1,ncum
             CALL iso_verif_egalite(xtent(iso_eau,il,i,j), &
@@ -1198,5 +1198,5 @@
     DO il = 1, ncum
       IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. csum(il,i)<1.) THEN
-! cc     :     .and. csum(il,i).lt.m(il,i) ) THEN
+! cc     :     .AND. csum(il,i).lt.m(il,i) ) THEN
         nent(il, i) = 0
 ! cc        Ment(il,i,i)=m(il,i)
@@ -1214,5 +1214,5 @@
       enddo
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite(xtelij(iso_eau,il,i,j), &
                 elij(il,i,j),'cv3p_routines 1204')
@@ -1222,11 +1222,11 @@
 
 #ifdef ISOTRAC          
-        if (option_tmin.ge.1) THEN
+        IF (option_tmin.ge.1) THEN
         ! colorier la vapeur résiduelle selon température de
         ! condensation, et le condensat en un tag spécifique
 !        WRITE(*,*) 'cv3 tmp 2314 il,i,j,xtent(:,il,i,j)=',
 !     :            il,i,j,xtent(:,il,i,j)
-          if ((elij(il,i,i).gt.0.0).and.(qent(il,i,i).gt.0.0)) THEN
-            if (option_traceurs.eq.17) THEN
+          IF ((elij(il,i,i).gt.0.0).AND.(qent(il,i,i).gt.0.0)) THEN
+            IF (option_traceurs.EQ.17) THEN
               CALL iso_recolorise_condensation(qent(il,i,i), &
                 elij(il,i,i), &
@@ -1234,5 +1234,5 @@
                 xtres, &
                 seuil_tag_tmin)
-            else !if (option_traceurs.eq.17) THEN
+            else !if (option_traceurs.EQ.17) THEN
               CALL iso_recolorise_condensation(qent(il,i,i), &
                 elij(il,i,i), &
@@ -1240,5 +1240,5 @@
                 xtres, &
                 seuil_tag_tmin)
-            endif ! if (option_traceurs.eq.17) THEN
+            endif ! if (option_traceurs.EQ.17) THEN
             do ixt=1+niso,ntraciso
               xtent(ixt,il,i,i)=xtres(ixt)
@@ -1275,5 +1275,5 @@
 !jyg!      DO il = 1, ncum
 !jyg!        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. csum(il,i)<1.) THEN
-!jyg!! cc     :     .and. csum(il,i).lt.m(il,i) ) THEN
+!jyg!! cc     :     .AND. csum(il,i).lt.m(il,i) ) THEN
 !jyg!          traent(il, i, i, j) = tra(il, nk(il), j)
 !jyg!        END IF
@@ -1293,5 +1293,5 @@
        do jm = 1, nd
         do il = 1, ncum
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(xtelij(iso_eau,il,im,jm), &
               elij(il,im,jm),'cv3p_mixing 2110',errmax,errmaxrel)
@@ -1312,5 +1312,5 @@
 #ifdef ISOTRAC
         ! seulement à la fin on taggue le condensat
-        if (option_cond.ge.1) THEN
+        IF (option_cond.ge.1) THEN
          do im = 1, nd
          do jm = 1, nd
@@ -1318,9 +1318,9 @@
            ! colorier le condensat en un tag spécifique
            do ixt=niso+1,ntraciso
-             if (index_zone(ixt).eq.izone_cond) THEN
+             IF (index_zone(ixt).EQ.izone_cond) THEN
                 xtelij(ixt,il,im,jm)=xtelij(index_iso(ixt),il,im,jm)
-             else !if (index_zone(ixt).eq.izone_cond) THEN
+             else !if (index_zone(ixt).EQ.izone_cond) THEN
                 xtelij(ixt,il,im,jm)=0.0
-             endif !if (index_zone(ixt).eq.izone_cond) THEN
+             endif !if (index_zone(ixt).EQ.izone_cond) THEN
            enddo !do ixt=1,ntraciso      
 #ifdef ISOVERIF
@@ -1339,9 +1339,9 @@
 !           ! colorier le condensat en un tag spécifique
 !           do ixt=niso+1,ntraciso
-!             if (index_zone(ixt).eq.izone_cond) THEN
+!             if (index_zone(ixt).EQ.izone_cond) THEN
 !                xtclw(ixt,il,im)=xtclw(index_iso(ixt),il,im)
-!             else !if (index_zone(ixt).eq.izone_cond) THEN
+!             else !if (index_zone(ixt).EQ.izone_cond) THEN
 !                xtclw(ixt,il,im)=0.0
-!             endif !if (index_zone(ixt).eq.izone_cond) THEN
+!             endif !if (index_zone(ixt).EQ.izone_cond) THEN
 !           enddo !do ixt=1,ntraciso      
 !#ifdef ISOVERIF
@@ -1352,5 +1352,5 @@
 !        if (iso_verif_positif_nostop(xtclw(itZonIso( &
 !                izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
-!                ,'cv3p_mixing 909').eq.1) THEN
+!                ,'cv3p_mixing 909').EQ.1) THEN
 !               WRITE(*,*) 'i,k=',i,k
 !               WRITE(*,*) 'xtclw=',xtclw(:,i,k)
@@ -1363,5 +1363,5 @@
 !         enddo !do im = 1, nd
 !         WRITE(*,*) 'xtclw(:,1,2)=',xtclw(:,1,2)
-        endif !if (option_tmin.eq.1) THEN
+        endif !if (option_tmin.EQ.1) THEN
 #endif
 #endif         
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv_driver.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv_driver.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv_driver.F90	(revision 5117)
@@ -28,15 +28,15 @@
   USE isotopes_mod, ONLY: iso_eau,iso_HDO,ridicule,bidouille_anti_divergence
 #ifdef ISOVERIF
-    use isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif,deltalim, &
+    USE isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif,deltalim, &
         iso_verif_egalite_choix,iso_verif_aberrant_choix, &
         iso_verif_aberrant, iso_verif_positif,iso_verif_positif_nostop
 #endif
 #ifdef ISOTRAC
-    use isotrac_mod, ONLY: option_traceurs,izone_ddft,izone_revap, &
+    USE isotrac_mod, ONLY: option_traceurs,izone_ddft,izone_revap, &
 &        izone_poubelle, index_zone,option_tmin,izone_cond
 #ifdef ISOVERIF
   USE isotopes_verif_mod, ONLY: iso_verif_traceur,iso_verif_traceur_justmass, &
 &       iso_verif_trac_masse_vect
-    use isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
+    USE isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
 #endif
 #endif
@@ -179,29 +179,29 @@
 
 #ifdef ISO
-      real xt1(ntraciso,len,nd)
-      real fxt1(ntraciso,len,nd)
-      real xtprecip1(ntraciso,len)
-      real xtvprecip1(ntraciso,len,nd+1)
-      real xtevap1(ntraciso,len,nd)
-      real xtwdtraina1(ntraciso,len,nd)
-      real xtelij1(ntraciso,len, nd, nd)
+      REAL xt1(ntraciso,len,nd)
+      REAL fxt1(ntraciso,len,nd)
+      REAL xtprecip1(ntraciso,len)
+      REAL xtvprecip1(ntraciso,len,nd+1)
+      REAL xtevap1(ntraciso,len,nd)
+      REAL xtwdtraina1(ntraciso,len,nd)
+      REAL xtelij1(ntraciso,len, nd, nd)
 #ifdef DIAGISO
-      real water1(len,nd)
-      real xtwater1(ntraciso,len,nd)
-      real qp1(len,nd),xtp1(ntraciso,len,nd)
-      real fq_detrainement1(len,nd)
-      real f_detrainement1(len,nd)
-      real q_detrainement1(len,nd)
-      real fq_ddft1(len,nd)
-      real fq_fluxmasse1(len,nd)
-      real fq_evapprecip1(len,nd)
-      real fxt_detrainement1(ntraciso,len,nd)
-      real xt_detrainement1(ntraciso,len,nd)
-      real fxt_ddft1(ntraciso,len,nd)
-      real fxt_fluxmasse1(ntraciso,len,nd)
-      real fxt_evapprecip1(ntraciso,len,nd)
+      REAL water1(len,nd)
+      REAL xtwater1(ntraciso,len,nd)
+      REAL qp1(len,nd),xtp1(ntraciso,len,nd)
+      REAL fq_detrainement1(len,nd)
+      REAL f_detrainement1(len,nd)
+      REAL q_detrainement1(len,nd)
+      REAL fq_ddft1(len,nd)
+      REAL fq_fluxmasse1(len,nd)
+      REAL fq_evapprecip1(len,nd)
+      REAL fxt_detrainement1(ntraciso,len,nd)
+      REAL xt_detrainement1(ntraciso,len,nd)
+      REAL fxt_ddft1(ntraciso,len,nd)
+      REAL fxt_fluxmasse1(ntraciso,len,nd)
+      REAL fxt_evapprecip1(ntraciso,len,nd)
 #endif
 #ifdef ISOVERIF      
-      real deltaD
+      REAL deltaD
 #endif      
 #endif
@@ -352,6 +352,6 @@
 
 #ifdef ISO
-      integer ixt
-      real xtclw1(ntraciso,klon,klev)
+      INTEGER ixt
+      REAL xtclw1(ntraciso,klon,klev)
       REAL xtnk1(ntraciso,klon)
 #endif
@@ -411,33 +411,33 @@
   REAL epmax_diag(nloc) ! epmax_cape
 #ifdef ISO
-      real xt(ntraciso,nloc,klev)
-      real xtnk(ntraciso,nloc)
-      real xtclw(ntraciso,nloc,klev)
-      real xtp(ntraciso,nloc,klev)
-      real xtent(ntraciso,nloc,klev,klev)
-      real xtelij(ntraciso,nloc,klev,klev)
+      REAL xt(ntraciso,nloc,klev)
+      REAL xtnk(ntraciso,nloc)
+      REAL xtclw(ntraciso,nloc,klev)
+      REAL xtp(ntraciso,nloc,klev)
+      REAL xtent(ntraciso,nloc,klev,klev)
+      REAL xtelij(ntraciso,nloc,klev,klev)
 !      real xtep(ntraciso,nloc,klev) ! le 7 mai: on supprime xtep
-      real xtwater(ntraciso,nloc,klev)
-      real xtevap(ntraciso,nloc,klev)
-      real fxt(ntraciso,nloc,klev)
-      real xtprecip(ntraciso,nloc)
-      real xtvprecip(ntraciso,nloc,klev+1)
-      real xtwdtraina(ntraciso,nloc,klev)
+      REAL xtwater(ntraciso,nloc,klev)
+      REAL xtevap(ntraciso,nloc,klev)
+      REAL fxt(ntraciso,nloc,klev)
+      REAL xtprecip(ntraciso,nloc)
+      REAL xtvprecip(ntraciso,nloc,klev+1)
+      REAL xtwdtraina(ntraciso,nloc,klev)
 #ifdef DIAGISO
-      real fxt_detrainement(ntraciso,nloc,klev)
-      real fxt_fluxmasse(ntraciso,nloc,klev)
-      real fxt_evapprecip(ntraciso,nloc,klev)
-      real fxt_ddft(ntraciso,nloc,klev)
-      real fq_detrainement(nloc,klev)
-      real f_detrainement(nloc,klev)
-      real q_detrainement(nloc,klev)
-      real xt_detrainement(ntraciso,nloc,klev)
-      real fq_fluxmasse(nloc,klev)
-      real fq_evapprecip(nloc,klev)
-      real fq_ddft(nloc,klev)
+      REAL fxt_detrainement(ntraciso,nloc,klev)
+      REAL fxt_fluxmasse(ntraciso,nloc,klev)
+      REAL fxt_evapprecip(ntraciso,nloc,klev)
+      REAL fxt_ddft(ntraciso,nloc,klev)
+      REAL fq_detrainement(nloc,klev)
+      REAL f_detrainement(nloc,klev)
+      REAL q_detrainement(nloc,klev)
+      REAL xt_detrainement(ntraciso,nloc,klev)
+      REAL fq_fluxmasse(nloc,klev)
+      REAL fq_evapprecip(nloc,klev)
+      REAL fq_ddft(nloc,klev)
 #endif
 #ifdef ISOTRAC
-      integer iiso,ixt_ddft,ixt_poubelle,ixt_revap
-      integer izone 
+      INTEGER iiso,ixt_ddft,ixt_poubelle,ixt_revap
+      INTEGER izone
 !#ifdef ISOVERIF
 !      integer iso_verif_positif_nostop
@@ -452,5 +452,5 @@
        WRITE(*,*) 'cv_driver 391: ENTREE dans cv_driver'
 !        WRITE(*,*) 'nloc=',nloc
-       if (iso_eau.gt.0) THEN
+       IF (iso_eau.gt.0) THEN
         do k = 1, klev
          do i = 1, nloc          
@@ -460,8 +460,8 @@
         enddo
        endif !if (iso_eau.gt.0) THEN
-       if (iso_HDO.gt.0) THEN
+       IF (iso_HDO.gt.0) THEN
         do k = 1, klev
          do i = 1, nloc  
-           if (q1(i,k).gt.ridicule) THEN
+           IF (q1(i,k).gt.ridicule) THEN
             CALL iso_verif_aberrant(xt1(iso_hdo,i,k)/q1(i,k), &
                  'cv_driver 362')
@@ -662,6 +662,6 @@
        do k=1,klev       
          do i=1,klon 
-          if (iso_HDO.gt.0) THEN
-           if (q1(i,k).gt.ridicule) THEN
+          IF (iso_HDO.gt.0) THEN
+           IF (q1(i,k).gt.ridicule) THEN
             CALL iso_verif_aberrant(xt1(iso_hdo,i,k)/q1(i,k), &
                   'cv_driver 502')
@@ -690,5 +690,5 @@
        do k = 1, klev
         do i = 1, klon
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
          CALL iso_verif_egalite_choix(xtclw1(iso_eau,i,k),clw1(i,k), &
                  'undil1',errmax,errmaxrel)
@@ -754,5 +754,5 @@
        do k = 1, klev
         do i = 1, nloc
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(xtclw1(iso_eau,i,k),clw1(i,k), &
                   'cv_driver 541a',errmax,errmaxrel)
@@ -785,5 +785,5 @@
        do k = 1, klev
         do i = 1, ncum
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
                   'cv_driver 598',errmax,errmaxrel)
@@ -791,5 +791,5 @@
                   'cv_driver 600',errmax,errmaxrel)
          endif !  if (iso_eau.gt.0) THEN
-         if (iso_HDO.gt.0) THEN
+         IF (iso_HDO.gt.0) THEN
               CALL iso_verif_aberrant_choix( &
                   xt(iso_HDO,i,k),q(i,k), &
@@ -801,5 +801,5 @@
         enddo
        enddo
-       if (iso_eau.gt.0) THEN
+       IF (iso_eau.gt.0) THEN
        do i = 1, ncum
             CALL iso_verif_egalite_choix(xtnk(iso_eau,i),qnk(i), &
@@ -843,5 +843,5 @@
        do k = 1, klev
         do i = 1, ncum
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
                   'cv_driver 650',errmax,errmaxrel)
@@ -849,5 +849,5 @@
                   'cv_driver 652',errmax,errmaxrel)
          endif !  if (iso_eau.gt.0) THEN
-         if (iso_HDO.gt.0) THEN
+         IF (iso_HDO.gt.0) THEN
               CALL iso_verif_aberrant_choix( &
                   xt(iso_HDO,i,k),q(i,k), &
@@ -913,5 +913,5 @@
        do j = 1, klev
         do i = 1, ncum
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(xtelij(iso_eau,i,j,k), &
                   elij(i,j,k),'cv_driver 881',errmax,errmaxrel)
@@ -932,5 +932,5 @@
        do k = 1, klev
         do i = 1, ncum
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
                   'cv_driver 709',errmax,errmaxrel)
@@ -938,13 +938,13 @@
 #ifdef ISOTRAC
            CALL iso_verif_traceur(xt(1,i,k),'cv_driver 856')
-           if (option_tmin.eq.1) THEN
-             if (iso_verif_positif_nostop(xtclw(itZonIso( &
+           IF (option_tmin.EQ.1) THEN
+             IF (iso_verif_positif_nostop(xtclw(itZonIso( &
                  izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
-                 ,'cv_driver 909').eq.1) THEN
+                 ,'cv_driver 909').EQ.1) THEN
                WRITE(*,*) 'i,k=',i,k
                WRITE(*,*) 'xtclw=',xtclw(:,i,k)
                stop
              endif !if (iso_verif_positif_nostop(xtclw(itZonIso(
-           endif !if ((option_traceurs.eq.17).or.
+           endif !if ((option_traceurs.EQ.17).OR.
 #endif  
         enddo
@@ -972,5 +972,5 @@
        do k = 1, klev
         do i = 1, ncum
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
                   'cv_driver 753',errmax,errmaxrel)
@@ -1002,5 +1002,5 @@
        do k = 1, klev
         do i = 1, ncum
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
             !    WRITE(*,*) 'i,k=',i,k
             CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
@@ -1020,5 +1020,5 @@
            CALL iso_verif_traceur_justmass(xtevap(1,i,k), &
                  'cv_driver 942')
-           if (bidouille_anti_divergence) THEN
+           IF (bidouille_anti_divergence) THEN
              CALL iso_verif_traceur_pbidouille( &
                  xtp(1,i,k),'cv_driver 956')
@@ -1042,5 +1042,5 @@
 #ifdef ISO
 #ifdef ISOTRAC
-      if (option_traceurs.eq.6) THEN
+      IF (option_traceurs.EQ.6) THEN
           ! on colorie les ddfts en rouge, le reste est en blanc.
           do k = 1, klev
@@ -1058,10 +1058,10 @@
             enddo !do i = 1, ncum
           enddo !do k = 1, klev
-      else if (option_traceurs.eq.19) THEN
+      ELSE IF (option_traceurs.EQ.19) THEN
           ! on colorie les ddfts, mais on sauve la revap
           do k = 1, klev
             do i = 1, ncum
                do izone=1,nzone
-                 if (izone.eq.izone_ddft) THEN
+                 IF (izone.EQ.izone_ddft) THEN
                    do iiso=1,niso
                      ixt_ddft=itZonIso(izone,iiso)
@@ -1069,12 +1069,12 @@
                      xtp(ixt_ddft,i,k)=xtp(iiso,i,k)-xtp(ixt_revap,i,k)
                    enddo !do iiso=1,niso
-                 elseif (izone.eq.izone_ddft) THEN
+                 elseif (izone.EQ.izone_ddft) THEN
                     ! rien a faire
-                 else !if (izone.eq.izone_ddft) THEN
+                 else !if (izone.EQ.izone_ddft) THEN
                    do iiso=1,niso
                      ixt=itZonIso(izone,iiso)
                      xtp(ixt,i,k)=0.0
                    enddo !do iiso=1,niso
-                 endif !if (izone.eq.izone_ddft) THEN
+                 endif !if (izone.EQ.izone_ddft) THEN
                enddo !do izone=1,nzone
 #ifdef ISOVERIF
@@ -1083,5 +1083,5 @@
             enddo !do i = 1, ncum
           enddo !do k = 1, klev
-      endif !if (option_traceurs.eq.6) THEN
+      endif !if (option_traceurs.EQ.6) THEN
 #endif
 #endif   
@@ -1114,10 +1114,10 @@
       DO k = 1, nd
        DO i = 1, ncum      
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(fxt(iso_eau,i,k), &
                  fq(i,k),'cv_driver 1086',errmax,errmaxrel)
         endif !if (iso_HDO.gt.0) THEN
-        if (iso_HDO.gt.0) THEN
-          if (q(i,k).gt.ridicule) THEN
+        IF (iso_HDO.gt.0) THEN
+          IF (q(i,k).gt.ridicule) THEN
             CALL iso_verif_aberrant( &
                 (xt(iso_HDO,i,k)+delt*fxt(iso_HDO,i,k)) &
@@ -1192,10 +1192,10 @@
       DO k = 1, nd
        DO i = 1, len        
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(fxt1(iso_eau,i,k), &
                 fq1(i,k),'cv_driver 1170',errmax,errmaxrel)
         endif !if (iso_HDO.gt.0) THEN
-        if (iso_HDO.gt.0) THEN
-          if (q1(i,k).gt.ridicule) THEN
+        IF (iso_HDO.gt.0) THEN
+          IF (q1(i,k).gt.ridicule) THEN
             CALL iso_verif_aberrant( &
                 (xt1(iso_HDO,i,k)+delt*fxt1(iso_HDO,i,k)) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv_routines.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv_routines.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv_routines.F90	(revision 5117)
@@ -591,8 +591,8 @@
         ! PRINT*,tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd
         tp(i, k) = (ah0(i)-(cl-cpd)*qnk(i)*t(i,k)-gz(i,k)-alv*qg)/cpd
-        ! if (.not.cpd.gt.1000.) THEN
+        ! if (.NOT.cpd.gt.1000.) THEN
         ! PRINT*,'CPD=',cpd
         ! stop
-        ! endif
+        ! END IF
         clw(i, k) = qnk(i) - qg
         clw(i, k) = max(0.0, clw(i,k))
@@ -670,6 +670,6 @@
   ! inb(i)=k+1
   ! capem(i)=cape(i)
-  ! endif
-  ! endif
+  ! END IF
+  ! END IF
   ! 520    continue
   ! 530  continue
@@ -697,6 +697,6 @@
   ! capem(i)=cape(i)
   ! byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-  ! endif
-  ! endif
+  ! END IF
+  ! END IF
   ! 520    continue
   ! 530  continue
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/cva_driver.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/cva_driver.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/cva_driver.F90	(revision 5117)
@@ -57,5 +57,5 @@
   USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,ridicule,bidouille_anti_divergence
 #ifdef ISOVERIF
-    use isotopes_verif_mod
+    USE isotopes_verif_mod
 !, ONLY: errmax,errmaxrel,Tmin_verif,deltalim, &
 !&       iso_verif_egalite_choix,iso_verif_aberrant_choix,iso_verif_aberrant, &
@@ -63,10 +63,10 @@
 #endif
 #ifdef ISOTRAC
-    use isotrac_mod, ONLY: option_traceurs,izone_ddft,izone_revap, &
+    USE isotrac_mod, ONLY: option_traceurs,izone_ddft,izone_revap, &
 &       izone_poubelle, index_zone,option_tmin,izone_cond
 #ifdef ISOVERIF
   USE isotopes_verif_mod, ONLY: iso_verif_traceur,iso_verif_traceur_justmass, &
 &       iso_verif_trac_masse_vect
-    use isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
+    USE isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
 #endif
 #endif
@@ -306,31 +306,31 @@
   REAL, DIMENSION (len ), INTENT (OUT)               :: epmax_diag1        
 #ifdef ISO
-      real, DIMENSION(ntraciso,len,nd), INTENT (IN)    :: xt1
-      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)   :: fxt1
-      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)   :: xt1_wake
-      real, DIMENSION(ntraciso,len), INTENT (OUT)      :: xtprecip1
-      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)   :: fxtd1
-      real, DIMENSION(ntraciso,len,ndp1), INTENT (OUT) :: xtvprecip1
-      real, DIMENSION(ntraciso,len,ndp1), INTENT (OUT) :: xtvprecipi1
-      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   xtwdtrainA1
-      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   xtevap1
+      REAL, DIMENSION(ntraciso,len,nd), INTENT (IN)    :: xt1
+      REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT)   :: fxt1
+      REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT)   :: xt1_wake
+      REAL, DIMENSION(ntraciso,len), INTENT (OUT)      :: xtprecip1
+      REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT)   :: fxtd1
+      REAL, DIMENSION(ntraciso,len,ndp1), INTENT (OUT) :: xtvprecip1
+      REAL, DIMENSION(ntraciso,len,ndp1), INTENT (OUT) :: xtvprecipi1
+      REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   xtwdtrainA1
+      REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   xtevap1
       REAL, DIMENSION (ntraciso,len, nd), INTENT (OUT)            :: xtclw1 
       REAL, DIMENSION (ntraciso,len, nd, nd)        :: xtelij1  ! pas besoin de le sortir?
 #ifdef DIAGISO
-      real, DIMENSION(len,nd), INTENT (OUT)             ::   water1
-      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   xtwater1
-      real, DIMENSION(len,nd), INTENT (OUT)             ::   qp1
-      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)    ::   xtp1
-      real, DIMENSION(len,nd), INTENT (OUT)             ::   fq_detrainement1
-      real, DIMENSION(len,nd), INTENT (OUT)             ::   fq_ddft1
-      real, DIMENSION(len,nd), INTENT (OUT)             ::   fq_fluxmasse1
-      real, DIMENSION(len,nd), INTENT (OUT)             ::   fq_evapprecip1
-      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   fxt_detrainement1
-      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   fxt_ddft1
-      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   fxt_fluxmasse1
-      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   fxt_evapprecip1
-      real, DIMENSION(len,nd), INTENT (OUT)             ::   f_detrainement1
-      real, DIMENSION(len,nd), INTENT (OUT)             ::   q_detrainement1
-      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   xt_detrainement1
+      REAL, DIMENSION(len,nd), INTENT (OUT)             ::   water1
+      REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   xtwater1
+      REAL, DIMENSION(len,nd), INTENT (OUT)             ::   qp1
+      REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT)    ::   xtp1
+      REAL, DIMENSION(len,nd), INTENT (OUT)             ::   fq_detrainement1
+      REAL, DIMENSION(len,nd), INTENT (OUT)             ::   fq_ddft1
+      REAL, DIMENSION(len,nd), INTENT (OUT)             ::   fq_fluxmasse1
+      REAL, DIMENSION(len,nd), INTENT (OUT)             ::   fq_evapprecip1
+      REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   fxt_detrainement1
+      REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   fxt_ddft1
+      REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   fxt_fluxmasse1
+      REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   fxt_evapprecip1
+      REAL, DIMENSION(len,nd), INTENT (OUT)             ::   f_detrainement1
+      REAL, DIMENSION(len,nd), INTENT (OUT)             ::   q_detrainement1
+      REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   xt_detrainement1
 !      real mentbas1(len,nd)
 !      real qentbas1(len,nd), xtentbas1(niso,len,nd)
@@ -508,6 +508,6 @@
 
 #ifdef ISO
-      integer ixt
-      real xtnk1(ntraciso,len)
+      INTEGER ixt
+      REAL xtnk1(ntraciso,len)
 #endif
 
@@ -622,40 +622,40 @@
 
 #ifdef ISO
-      real xt(ntraciso,nloc,nd)
+      REAL xt(ntraciso,nloc,nd)
       REAL, DIMENSION(ntraciso,nloc, nd)    :: xtta
-      real xt_wake(ntraciso,nloc,nd)
-      real xtclw(ntraciso,nloc,nd)
-      real xtp(ntraciso,nloc,nd)
-      real xtent(ntraciso,nloc,nd,nd)
-      real xtelij(ntraciso,nloc,nd,nd)
-      real xtwater(ntraciso,nloc,nd)
-      real xtice(ntraciso,nloc,nd)
-      real xtevap(ntraciso,nloc,nd)
-      real fxt(ntraciso,nloc,nd)
-      real fxtd(ntraciso,nloc,nd)
-      real xtprecip(ntraciso,nloc)
-      real xtnk(ntraciso,nloc)
-      real xtVprecip(ntraciso,nloc,nd+1)
-      real xtVprecipi(ntraciso,nloc,nd+1)
-      real xtwdtrainA(niso,nloc,nd)
+      REAL xt_wake(ntraciso,nloc,nd)
+      REAL xtclw(ntraciso,nloc,nd)
+      REAL xtp(ntraciso,nloc,nd)
+      REAL xtent(ntraciso,nloc,nd,nd)
+      REAL xtelij(ntraciso,nloc,nd,nd)
+      REAL xtwater(ntraciso,nloc,nd)
+      REAL xtice(ntraciso,nloc,nd)
+      REAL xtevap(ntraciso,nloc,nd)
+      REAL fxt(ntraciso,nloc,nd)
+      REAL fxtd(ntraciso,nloc,nd)
+      REAL xtprecip(ntraciso,nloc)
+      REAL xtnk(ntraciso,nloc)
+      REAL xtVprecip(ntraciso,nloc,nd+1)
+      REAL xtVprecipi(ntraciso,nloc,nd+1)
+      REAL xtwdtrainA(niso,nloc,nd)
 #ifdef DIAGISO
-      real fxt_detrainement(niso,nloc,nd)
-      real fxt_fluxmasse(niso,nloc,nd)
-      real fxt_evapprecip(niso,nloc,nd)
-      real fxt_ddft(niso,nloc,nd)
-      real fq_detrainement(nloc,nd)
-      real fq_fluxmasse(nloc,nd)
-      real fq_evapprecip(nloc,nd)
-      real fq_ddft(nloc,nd)
-      real f_detrainement(nloc,nd)
-      real q_detrainement(nloc,nd)
-      real xt_detrainement(niso,nloc,nd)
+      REAL fxt_detrainement(niso,nloc,nd)
+      REAL fxt_fluxmasse(niso,nloc,nd)
+      REAL fxt_evapprecip(niso,nloc,nd)
+      REAL fxt_ddft(niso,nloc,nd)
+      REAL fq_detrainement(nloc,nd)
+      REAL fq_fluxmasse(nloc,nd)
+      REAL fq_evapprecip(nloc,nd)
+      REAL fq_ddft(nloc,nd)
+      REAL f_detrainement(nloc,nd)
+      REAL q_detrainement(nloc,nd)
+      REAL xt_detrainement(niso,nloc,nd)
 #endif
 #ifdef ISOTRAC
-      integer iiso,ixt_ddft,ixt_poubelle,ixt_revap
-      integer izone 
+      INTEGER iiso,ixt_ddft,ixt_poubelle,ixt_revap
+      INTEGER izone
 #endif
 #ifdef ISOVERIF
-      integer j
+      INTEGER j
 #endif
 #endif  
@@ -823,5 +823,5 @@
     END IF
 ! PRINT*,'t1, q1 ',t1,q1
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_prelim'
     CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, &           ! nd->na
@@ -829,5 +829,5 @@
 
 
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_prelim'
     CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, & ! nd->na
@@ -839,5 +839,5 @@
   IF (iflag_con==4) THEN
     PRINT *, 'Emanuel version 4 '
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_prelim'
     CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
@@ -884,5 +884,5 @@
 ! WRITE(*,'(64i1)') iflag1(2:len-1)
 
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_feed'
     CALL cv3_feed(len, nd, ok_conserv_q, &                 ! nd->na
@@ -902,5 +902,5 @@
 
   IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_feed'
     CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, &
@@ -919,5 +919,5 @@
   IF (iflag_con==3) THEN
 
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_undilute1'
 
@@ -925,8 +925,8 @@
 #ifdef ISOVERIF
        WRITE(*,*) 'cva_driver 593: avant cv3_undilute1'
-       if (iso_HDO.gt.0) THEN
+       IF (iso_HDO.gt.0) THEN
        do k=1,nd       
          do i=1,len           
-           if (q1(i,k).gt.ridicule) THEN
+           IF (q1(i,k).gt.ridicule) THEN
             CALL iso_verif_aberrant(xt1(iso_hdo,i,k)/q1(i,k), &
                   'cva_driver 502')
@@ -935,5 +935,5 @@
         enddo !do k=1,nd   
         endif !if (iso_HDO.gt.0) THEN
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
           do i=1,len
             do k=1,nd
@@ -972,5 +972,5 @@
        do k=1,nd
         do i = 1, len
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
          CALL iso_verif_egalite_choix(xtclw1(iso_eau,i,k),clw1(i,k), &
                  'cva_driver 798',errmax,errmaxrel)
@@ -999,5 +999,5 @@
 
   IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_undilute1'
     CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
@@ -1013,5 +1013,5 @@
   IF (iflag_con==3) THEN
 
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_trigger'
     CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
@@ -1027,5 +1027,5 @@
 
   IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_trigger'
     CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
@@ -1068,5 +1068,5 @@
   compress = ncum < len*comp_threshold
 
-  IF (.not. compress) THEN
+  IF (.NOT. compress) THEN
     DO i = 1,len
       idcum(i) = i
@@ -1078,5 +1078,5 @@
        do k=1,nd
         do i = 1, nloc
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(xtclw1(iso_eau,i,k),clw1(i,k), &
                   'cva_driver 541a',errmax,errmaxrel)
@@ -1093,5 +1093,5 @@
 
 !>jyg
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3a_compress'
       CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
@@ -1131,5 +1131,5 @@
        do k=1,nd
         do i = 1, ncum
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
                   'cva_driver 598',errmax,errmaxrel)
@@ -1139,5 +1139,5 @@
                   'cva_driver 602',errmax,errmaxrel)
          endif !  if (iso_eau.gt.0) THEN
-         if (iso_HDO.gt.0) THEN
+         IF (iso_HDO.gt.0) THEN
               CALL iso_verif_aberrant_choix( &
                   xt(iso_HDO,i,k),q(i,k), &
@@ -1162,5 +1162,5 @@
 
     IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_compress'
       CALL cv_compress(len, nloc, ncum, nd, &
@@ -1186,5 +1186,5 @@
 
     IF (iflag_con==3) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_undilute2'
       CALL cv3_undilute2(nloc, ncum, nd, iflag, icb, icbs, nk, &        !na->nd
@@ -1201,5 +1201,5 @@
        do k=1,nd
         do i = 1, ncum
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
                   'cva_driver 650',errmax,errmaxrel)
@@ -1209,5 +1209,5 @@
                   'cva_driver 652',errmax,errmaxrel)
          endif !  if (iso_eau.gt.0) THEN
-         if (iso_HDO.gt.0) THEN
+         IF (iso_HDO.gt.0) THEN
               CALL iso_verif_aberrant_choix( &
                   xt(iso_HDO,i,k),q(i,k), &
@@ -1235,5 +1235,5 @@
 
     IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_undilute2'
       CALL cv_undilute2(nloc, ncum, nd, icb, nk, &
@@ -1245,5 +1245,5 @@
     ! epmax_cape
     ! on recalcule ep et hp    
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_epmax_cape'
     CALL cv3_epmax_fn_cape(nloc,ncum,nd &
@@ -1263,5 +1263,5 @@
       IF (iflag_mix>=1) THEN
         CALL zilch(supmax, nloc*nd)
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3p_mixing'
         CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &           ! na->nd
@@ -1288,5 +1288,5 @@
     IF (iflag_con==3) THEN
       IF (iflag_clos==0) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_closure'
         CALL cv3_closure(nloc, ncum, nd, icb, inb, &           ! na->nd
@@ -1306,5 +1306,5 @@
 
       IF (iflag_clos==2) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3p1_closure'
         CALL cv3p1_closure(nloc, ncum, nd, icb, inb, &         ! na->nd
@@ -1314,10 +1314,10 @@
                            Plim1, plim2, asupmax, supmax0, &
                            asupmaxmin, cbmf, plfc, wbeff)
-        if (prt_level >= 10) &
+        IF (prt_level >= 10) &
              PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
       END IF   ! iflag_clos==2
 
       IF (iflag_clos==3) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3p2_closure'
         CALL cv3p2_closure(nloc, ncum, nd, icb, inb, &         ! na->nd
@@ -1327,5 +1327,5 @@
                            Plim1, plim2, asupmax, supmax0, &
                            asupmaxmin, cbmf, plfc, wbeff)
-        if (prt_level >= 10) &
+        IF (prt_level >= 10) &
              PRINT *, 'cv3p2_closure-> plfc,wbeff ', plfc(1), wbeff(1)
       END IF   ! iflag_clos==3
@@ -1333,5 +1333,5 @@
 
     IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_closure'
       CALL cv_closure(nloc, ncum, nd, nk, icb, &
@@ -1348,5 +1348,5 @@
     IF (iflag_con==3) THEN
       IF (iflag_mix==0) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_mixing'
         CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &             ! na->nd
@@ -1368,5 +1368,5 @@
        do j = 1, nd
         do i = 1, ncum
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(xtelij(iso_eau,i,j,k), &
                   elij(i,j,k),'cva_driver 881',errmax,errmaxrel)
@@ -1387,5 +1387,5 @@
        do k=1,nd
         do i = 1, ncum
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
                   'cva_driver 709',errmax,errmaxrel)
@@ -1393,13 +1393,13 @@
 #ifdef ISOTRAC
            CALL iso_verif_traceur(xt(1,i,k),'cva_driver 856')
-           if (option_tmin.eq.1) THEN
-             if (iso_verif_positif_nostop(xtclw(itZonIso( &
+           IF (option_tmin.EQ.1) THEN
+             IF (iso_verif_positif_nostop(xtclw(itZonIso( &
                  izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
-                 ,'cva_driver 909').eq.1) THEN
+                 ,'cva_driver 909').EQ.1) THEN
                WRITE(*,*) 'i,k=',i,k
                WRITE(*,*) 'xtclw=',xtclw(:,i,k)
                stop
              endif !if (iso_verif_positif_nostop(xtclw(itZonIso(
-           endif !if ((option_traceurs.eq.17).or.
+           endif !if ((option_traceurs.EQ.17).OR.
 #endif  
         enddo
@@ -1423,5 +1423,5 @@
 
     IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_mixing'
       CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, &
@@ -1449,5 +1449,5 @@
        do k=1,nd
         do i = 1, ncum
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
                   'cva_driver 753a',errmax,errmaxrel)
@@ -1463,5 +1463,5 @@
 #endif
 
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_unsat'
       CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, &              ! na->nd
@@ -1497,5 +1497,5 @@
 
     IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_unsat'
       CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, &
@@ -1510,5 +1510,5 @@
 #ifdef ISO
 #ifdef ISOTRAC
-      if (option_traceurs.eq.6) THEN
+      IF (option_traceurs.EQ.6) THEN
           ! on colorie les ddfts en rouge, le reste est en blanc.
           do k=1,nd
@@ -1526,10 +1526,10 @@
             enddo !do i = 1, ncum
           enddo !do k=1,nd
-      else if (option_traceurs.eq.19) THEN
+      ELSE IF (option_traceurs.EQ.19) THEN
           ! on colorie les ddfts, mais on sauve la revap
           do k=1,nd
             do i = 1, ncum
                do izone=1,nzone
-                 if (izone.eq.izone_ddft) THEN
+                 IF (izone.EQ.izone_ddft) THEN
                    do iiso=1,niso
                      ixt_ddft=itZonIso(izone,iiso)
@@ -1537,12 +1537,12 @@
                      xtp(ixt_ddft,i,k)=xtp(iiso,i,k)-xtp(ixt_revap,i,k)
                    enddo !do iiso=1,niso
-                 elseif (izone.eq.izone_ddft) THEN
+                 elseif (izone.EQ.izone_ddft) THEN
                     ! rien à faire
-                 else !if (izone.eq.izone_ddft) THEN
+                 else !if (izone.EQ.izone_ddft) THEN
                    do iiso=1,niso
                      ixt=itZonIso(izone,iiso)
                      xtp(ixt,i,k)=0.0
                    enddo !do iiso=1,niso
-                 endif !if (izone.eq.izone_ddft) THEN
+                 endif !if (izone.EQ.izone_ddft) THEN
                enddo !do izone=1,nzone
 #ifdef ISOVERIF
@@ -1551,5 +1551,5 @@
             enddo !do i = 1, ncum
           enddo !do k=1,nd
-      endif !if (option_traceurs.eq.6) THEN
+      endif !if (option_traceurs.EQ.6) THEN
 #endif
 #endif   
@@ -1565,5 +1565,5 @@
     IF (iflag_con==3) THEN
 
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_yield'
 
@@ -1599,10 +1599,10 @@
       DO k = 1, nd
        DO i = 1, ncum
-        if (iso_HDO.gt.0) THEN
-          if (q(i,k)+delt*fq(i,k).gt.ridicule) THEN
+        IF (iso_HDO.gt.0) THEN
+          IF (q(i,k)+delt*fq(i,k).gt.ridicule) THEN
             CALL iso_verif_aberrant( &
                 (xt(iso_HDO,i,k)+delt*fxt(iso_HDO,i,k)) &
                 /(q(i,k)+delt*fq(i,k)),'cva_driver 855a')
-                if (iso_O18.gt.0) THEN
+                IF (iso_O18.gt.0) THEN
             CALL iso_verif_O18_aberrant( &
                 (xt(iso_HDO,i,k)+delt*fxt(iso_HDO,i,k)) &
@@ -1613,5 +1613,5 @@
           endif
          endif
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(fxt(iso_eau,i,k), &
                 fq(i,k),'cva_driver 1305',errmax,errmaxrel)
@@ -1637,5 +1637,5 @@
 
     IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_yield'
       CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, &
@@ -1657,5 +1657,5 @@
     IF (iflag_con==3) THEN
 !RomP >>>
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_tracer'
       CALL cv3_tracer(nloc, len, ncum, nd, nd, &
@@ -1674,5 +1674,5 @@
 
     IF (iflag_con==3) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3a_uncompress'
       CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
@@ -1723,6 +1723,6 @@
       DO k = 1, nd
        DO i = 1, len
-        if (iso_HDO.gt.0) THEN
-          if (q1(i,k).gt.ridicule) THEN
+        IF (iso_HDO.gt.0) THEN
+          IF (q1(i,k).gt.ridicule) THEN
             CALL iso_verif_aberrant( &
                 (xt1(iso_HDO,i,k)+delt*fxt1(iso_HDO,i,k)) &
@@ -1730,11 +1730,11 @@
           endif
          endif !if (iso_HDO.gt.0) THEN
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(fxt1(iso_eau,i,k), &
                 fq1(i,k),'cva_driver 1383',errmax,errmaxrel)
          endif      
          do ixt=1,ntraciso
-           if (iso_verif_noNaN_nostop(fxtd1(ixt,i,k), &
-                 'cva_driver 1447').eq.1) THEN
+           IF (iso_verif_noNaN_nostop(fxtd1(ixt,i,k), &
+                 'cva_driver 1447').EQ.1) THEN
               WRITE(*,*) 'i,k=', i,k
               stop
@@ -1755,5 +1755,5 @@
 
     IF (iflag_con==4) THEN
-        if (prt_level >= 9) &
+        IF (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv_uncompress'
       CALL cv_uncompress(nloc, len, ncum, nd, idcum, &
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_mod.F90	(revision 5117)
@@ -3,5 +3,5 @@
 
 MODULE isotopes_mod
-   USE strings_mod,  ONLY: msg, real2str, int2str, bool2str, maxlen, strIdx, strStack
+   USE lmdz_strings,  ONLY: msg, real2str, int2str, bool2str, maxlen, strIdx, strStack
    USE infotrac_phy, ONLY: isoName
    IMPLICIT NONE
@@ -156,5 +156,5 @@
 SUBROUTINE iso_init()
    USE infotrac_phy,       ONLY: ntiso, niso, getKey
-    USE strings_mod,       ONLY: maxlen
+    USE lmdz_strings,       ONLY: maxlen
    IMPLICIT NONE
 
@@ -291,9 +291,9 @@
 
    do ixt=1,niso
-     if (ixt.eq.iso_HTO) then  ! Tritium
+     IF (ixt.EQ.iso_HTO) then  ! Tritium
        tkcin0(ixt) = 0.01056
        tkcin1(ixt) = 0.0005016
        tkcin2(ixt) = 0.0014432
-       if (tnat1) THEN
+       IF (tnat1) THEN
                tnat(ixt)=1 
        else 
@@ -311,5 +311,5 @@
        Rmethox(ixt)=0.0
      endif
-     if (ixt.eq.iso_O17) then  ! O17
+     IF (ixt.EQ.iso_O17) then  ! O17
        pente_MWL=0.528 
        tdifrel(ixt)=1./0.98555 ! valeur utilisée en 1D et dans modèle de LdG ! tdifrel(ixt)=1./0.985452 ! donné par Amaelle
@@ -318,5 +318,5 @@
        tkcin1(ixt) = tkcin1_O18*fac_kcin
        tkcin2(ixt) = tkcin2_O18*fac_kcin
-       if (tnat1) THEN
+       IF (tnat1) THEN
                tnat(ixt)=1 
        else 
@@ -334,9 +334,9 @@
        Rmethox(ixt)=(230./1000.+1.)*tnat(ixt) !Zahn et al 2006
      endif
-     if (ixt.eq.iso_O18) then  ! Oxygene18
+     IF (ixt.EQ.iso_O18) then  ! Oxygene18
        tkcin0(ixt) = tkcin0_O18
        tkcin1(ixt) = tkcin1_O18
        tkcin2(ixt) = tkcin2_O18
-       if (tnat1) THEN
+       IF (tnat1) THEN
                tnat(ixt)=1 
        else 
@@ -355,5 +355,5 @@
        Rmethox(ixt)=(130./1000.+1.)*tnat(ixt) !Zahn et al 2006  
      endif
-     if (ixt.eq.iso_HDO) then ! Deuterium
+     IF (ixt.EQ.iso_HDO) then ! Deuterium
        pente_MWL=8.0
        tdifrel(ixt)=1./0.9755 !          fac_kcin=0.88
@@ -362,5 +362,5 @@
        tkcin1(ixt) = tkcin1_O18*fac_kcin
        tkcin2(ixt) = tkcin2_O18*fac_kcin
-       if (tnat1) THEN
+       IF (tnat1) THEN
                tnat(ixt)=1
        else
@@ -381,5 +381,5 @@
        Rmethox(ixt)=tnat(ixt)*(-25.0/1000.+1.) ! Zahn et al 2006
      endif
-     if (ixt.eq.iso_eau) then ! Oxygene16
+     IF (ixt.EQ.iso_eau) then ! Oxygene16
        tkcin0(ixt) = 0.0
        tkcin1(ixt) = 0.0
@@ -402,5 +402,5 @@
    IF(.NOT.Rdefault_smow) THEN
         Rdefault(:) = 0.0
-        if (iso_eau.gt.0) Rdefault(iso_eau) = 1.0 ! correction Camille 30 mars 2023
+        IF (iso_eau.gt.0) Rdefault(iso_eau) = 1.0 ! correction Camille 30 mars 2023
    ENDIF
    WRITE(*,*) 'Rdefault=',Rdefault
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_routines_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_routines_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_routines_mod.F90	(revision 5117)
@@ -25,5 +25,5 @@
 #ifdef ISOTRAC
 USE isotrac_mod, ONLY: option_revap,index_iso,izone_revap
-use isotrac_routines_mod, ONLY: ajoute_revap, &
+USE isotrac_routines_mod, ONLY: ajoute_revap, &
 &       compress_ilp_evap_glace_zone,compress_ilp_evap_liq_zone, &
 &       uncompress_ilp_zone
@@ -32,10 +32,10 @@
 
 ! inputs
-integer klon,klev,k
-real zrfl_ancien(klon)
-real zrfl(klon) ! pas necessaire, juste pour vérif
-real zxt_ancien(ntraciso,klon) ! equivalent local de xt       
-real zqev_diag(klon)
-real zxtrfl_ancien(ntraciso,klon)
+INTEGER klon,klev,k
+REAL zrfl_ancien(klon)
+REAL zrfl(klon) ! pas necessaire, juste pour vérif
+REAL zxt_ancien(ntraciso,klon) ! equivalent local de xt
+REAL zqev_diag(klon)
+REAL zxtrfl_ancien(ntraciso,klon)
 REAL zrfln(klon)
 REAL dtime ! intervalle du temps (s)
@@ -43,39 +43,39 @@
 REAL zt(klon)
 REAL zqs(klon)
-real zq_ancien(klon)
-real zq(klon) ! pas necessaire, juste pour vérifs
+REAL zq_ancien(klon)
+REAL zq(klon) ! pas necessaire, juste pour vérifs
 
 ! outputs       
-real zxtrfln(ntraciso,klon)  
-real zxtrfl(ntraciso,klon) ! identique à zxtrfln
-real zxt(ntraciso,klon) 
+REAL zxtrfln(ntraciso,klon)
+REAL zxtrfl(ntraciso,klon) ! identique à zxtrfln
+REAL zxt(ntraciso,klon)
 
 ! locals
-real zqevfl(klon)
-real fac_fluxtomixratio(klon)
-real zrfl_cas(klon)       
-real zqev_diag_cas(klon)
-real zxtrfl_cas(niso,klon)
-real zxtrfln_cas(niso,klon)
-real zrfln_cas(klon)
-real zxt_cas(niso,klon) ! zxt compress en input
-real zxtnew_cas(niso,klon) ! zxt compresse en output       
-real qeff(klon)
-real zqs_cas(klon),zt_cas(klon)
-real zq_cas(klon)
-real delP(klon),delP_s_dt(klon)
-real Exi(niso,klon)
-real ztglace_kelvin
+REAL zqevfl(klon)
+REAL fac_fluxtomixratio(klon)
+REAL zrfl_cas(klon)
+REAL zqev_diag_cas(klon)
+REAL zxtrfl_cas(niso,klon)
+REAL zxtrfln_cas(niso,klon)
+REAL zrfln_cas(klon)
+REAL zxt_cas(niso,klon) ! zxt compress en input
+REAL zxtnew_cas(niso,klon) ! zxt compresse en output
+REAL qeff(klon)
+REAL zqs_cas(klon),zt_cas(klon)
+REAL zq_cas(klon)
+REAL delP(klon),delP_s_dt(klon)
+REAL Exi(niso,klon)
+REAL ztglace_kelvin
 parameter (ztglace_kelvin=273) 
-integer frac_sublim
+INTEGER frac_sublim
 parameter (frac_sublim=0)
 ! pour le parsage
-integer icas_evap_tot,ncas_evap_tot
-integer icas_evap_liq,ncas_evap_liq
-integer icas_evap_glace,ncas_evap_glace
+INTEGER icas_evap_tot,ncas_evap_tot
+INTEGER icas_evap_liq,ncas_evap_liq
+INTEGER icas_evap_glace,ncas_evap_glace
 !      integer cas_evap_tot(klon)
-integer cas_evap_liq(klon)
-integer cas_evap_glace(klon)
-integer i,ixt
+INTEGER cas_evap_liq(klon)
+INTEGER cas_evap_glace(klon)
+INTEGER i,ixt
 
 #ifdef ISOVERIF 
@@ -84,5 +84,5 @@
 !integer iso_verif_positif_nostop
 !integer iso_verif_positif_choix_nostop
-integer trace_cas(klon)
+INTEGER trace_cas(klon)
 !real 
 !integer iso_verif_egalite_nostop
@@ -90,8 +90,8 @@
 #endif
 #ifdef ISOTRAC  
-integer iiso,ieau,izone
-real xtrevap_tag(ntraciso,klon)
-real ptrac(klon)
-real hdiag(klon)
+INTEGER iiso,ieau,izone
+REAL xtrevap_tag(ntraciso,klon)
+REAL ptrac(klon)
+REAL hdiag(klon)
 #endif
 
@@ -105,5 +105,5 @@
 DO i=1,klon
   trace_cas(i)=0
-  if (iso_eau.gt.0) THEN
+  IF (iso_eau.gt.0) THEN
            CALL iso_verif_egalite_choix(zxt_ancien(iso_eau,i), &
 &                  zq_ancien(i),'iso_revap_ilp 94', &
@@ -113,11 +113,11 @@
 &                  zrfl_ancien(i),'iso_revap_ilp 99', &
 &                  errmax,errmaxrel)
-  endif      
+  ENDIF
 END DO !do il=1,ncum
 #endif  
 DO i=1,klon
 IF (zrfl_ancien(i) .GT.0.) THEN
-  if (zrfln(i).gt.ridicule*1e-2) THEN
-     if (zt(i).ge.ztglace_kelvin) THEN
+  IF (zrfln(i).gt.ridicule*1e-2) THEN
+     IF (zt(i).ge.ztglace_kelvin) THEN
        icas_evap_liq=icas_evap_liq+1    
        cas_evap_liq(icas_evap_liq)=i
@@ -146,5 +146,5 @@
 #ifdef ISOVERIF
        trace_cas(i)=1
-       if (iso_eau.gt.0) THEN
+       IF (iso_eau.gt.0) THEN
            CALL iso_verif_egalite_choix(zxt(iso_eau,i), &
 &                  zq(i),'iso_revap_ilp 116',errmax,errmaxrel)
@@ -181,5 +181,5 @@
      CALL iso_verif_egalite_choix(zrfln(i), &
 &                  0.0,'iso_revap_ilp 148c',ridicule,errmaxrel)
-     if (iso_eau.gt.0) THEN
+     IF (iso_eau.gt.0) THEN
            CALL iso_verif_egalite_choix(zxt(iso_eau,i), &
 &                  zq(i),'iso_revap_ilp 149',errmax,errmaxrel)
@@ -189,6 +189,6 @@
 &                  zrfl(i),'iso_revap_ilp 151b',errmax,errmaxrel)
      endif
-     if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
-        if (zq(i).gt.ridicule) THEN
+     IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
+        IF (zq(i).gt.ridicule) THEN
            CALL iso_verif_aberrant_encadre(zxt(iso_HDO,i)/zq(i), &
                          'iso_revap_ilp 178')
@@ -196,5 +196,5 @@
                      zxt(iso_O18,i)/zq(i),'iso_revap_ilp 180')
         endif !if (zq(i).gt.ridicule) THEN
-     endif !if ((iso_HDO.gt.0.and.(iso_O18.gt.0) THEN
+     endif !if ((iso_HDO.gt.0.AND.(iso_O18.gt.0) THEN
 #ifdef ISOTRAC
      CALL iso_verif_traceur(zxtrfl_ancien(1,i), &
@@ -247,10 +247,10 @@
 &           'iso_revap_fisrtilp 695; ap compress_evap_liq', &
 &           errmax,errmaxrel)
-  if (iso_eau.gt.0) THEN
+  IF (iso_eau.gt.0) THEN
     CALL iso_verif_egalite_choix(( &
 &           zxtrfl_cas(iso_eau,i)),(zrfl_cas(i)), &
 &           'iso_revap_fisrtilp 639; ap compress_evap_liq', &
 &           errmax,errmaxrel)
-  endif ! if (iso_eau.gt.0) THEN
+  ENDIF ! if (iso_eau.gt.0) THEN
   CALL iso_verif_egalite_choix(zqev_diag_cas(i), &
 &           zqev_diag(cas_evap_liq(i)), &
@@ -270,5 +270,5 @@
 !     :           qeff(1),zqs_cas(1)
 #endif       
- if (no_pce.eq.1) THEN
+ IF (no_pce.EQ.1) THEN
      CALL stewart_sublim_nofrac_vectall( &
 &        ncas_evap_liq,zq_cas(1), &
@@ -277,5 +277,5 @@
 &        zxtrfln_cas(1,1),zxtnew_cas(1,1),Exi(1,1), &
 &        fac_fluxtomixratio(1))
- else !if (no_pce.eq.1) THEN
+ else !if (no_pce.EQ.1) THEN
   CALL stewart_explicite_vectall(ncas_evap_liq, &
 &           zq_cas(1),zxt_cas(1,1), &
@@ -291,5 +291,5 @@
 #endif
 &   )
-END IF !if (no_pce.eq.1) THEN
+END IF !if (no_pce.EQ.1) THEN
 #ifdef ISOVERIF
   do i=1,ncas_evap_liq
@@ -303,5 +303,5 @@
    enddo
   enddo
-  if (iso_eau.gt.0) THEN
+  IF (iso_eau.gt.0) THEN
      do i=1,ncas_evap_liq
        CALL iso_verif_egalite_choix( &
@@ -314,8 +314,8 @@
 &                  'il pleut 4102',errmax,errmaxrel)        
       enddo !do i=1,ncas_evap_liq
-   endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-   if (iso_HDO.gt.0) THEN
+   endif !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+   IF (iso_HDO.gt.0) THEN
       do i=1,ncas_evap_liq
-         if (zrfln_cas(i).gt.ridicule_rain) THEN
+         IF (zrfln_cas(i).gt.ridicule_rain) THEN
                 CALL iso_verif_aberrant( &
 &                  (zxtrfln_cas(iso_HDO,i) &
@@ -323,9 +323,9 @@
          endif
        enddo !do i=1,ncas_evap_liq
-   endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) THEN
+   endif !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO)) THEN
    !  WRITE(*,*) 'iso_routines tmp 308: i=',i
-   if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+   IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
         do i=1,ncas_evap_liq
-        if (zq(i).gt.ridicule) THEN
+        IF (zq(i).gt.ridicule) THEN
            CALL iso_verif_aberrant_encadre((zxtnew_cas(iso_HDO,i))/zq(cas_evap_liq(i)), &
                          'iso_revap_ilp 311')
@@ -334,8 +334,8 @@
         endif !if (zq(i).gt.ridicule) THEN
         enddo !do i=1,ncas_evap_liq
-    endif !if ((iso_HDO.gt.0.and.(iso_O18.gt.0) THEN
+    endif !if ((iso_HDO.gt.0.AND.(iso_O18.gt.0) THEN
     ! WRITE(*,*) 'iso_routines tmp 319'
 #endif
-  if ((bidouille_anti_divergence).and. &
+  IF ((bidouille_anti_divergence).AND. &
 &           (iso_eau.gt.0)) THEN
     do i=1,ncas_evap_liq
@@ -343,5 +343,5 @@
       zxtnew_cas(iso_eau,i)=zq(cas_evap_liq(i))    
     enddo !do i=1,ncas_evap_liq
-  endif
+  ENDIF
   
   CALL uncompress_ilp( &
@@ -399,5 +399,5 @@
   do i=1,ncas_evap_liq
     ! 1er juin 2009: on remplace ridicule par ridicule*1e3
-    if (ptrac(i).gt.ridicule*1e3) THEN
+    IF (ptrac(i).gt.ridicule*1e3) THEN
       zrfl_cas(i)=zrfl_cas(i)/ptrac(i)
       zqevfl(i)=zqevfl(i)/ptrac(i)
@@ -426,7 +426,7 @@
 #ifdef ISOVERIF
   do i=1,ncas_evap_liq
-    if (iso_verif_egalite_nostop(( &
+    IF (iso_verif_egalite_nostop(( &
 &           zrfl_cas(i)-zqevfl(i)-zrfln_cas(i)),0.0, &
-&          'iso_revap_fisrtilp 314').eq.1) THEN
+&          'iso_revap_fisrtilp 314').EQ.1) THEN
        WRITE(*,*) 'i,zrfl_cas(i),zqevfl(i),zrfln_cas(i)=', &
 &           i,zrfl_cas(i),zqevfl(i),zrfln_cas(i)
@@ -435,9 +435,9 @@
        stop
     endif
-    if (iso_verif_aberrant_choix_nostop( &
+    IF (iso_verif_aberrant_choix_nostop( &
 &         (zxtrfl_cas(iso_HDO,i)), &
 &         (zrfl_cas(i)), &
 &         ridicule_rain,deltalimtrac, &
-&         'iso_revap_ilp 342').eq.1) THEN
+&         'iso_revap_ilp 342').EQ.1) THEN
        WRITE(*,*) 'i,ptrac(i),zrfl_cas(i)=', &
 &           i,ptrac(i),zrfl_cas(i)
@@ -447,5 +447,5 @@
 #endif          
   
- if (no_pce.eq.1) THEN
+ IF (no_pce.EQ.1) THEN
      CALL stewart_sublim_nofrac_vectall( &
 &        ncas_evap_liq,zq_cas(1), & 
@@ -454,5 +454,5 @@
 &        zxtrfln_cas(1,1),zxtnew_cas(1,1),Exi(1,1), &
 &        fac_fluxtomixratio(1))
- else !if (no_pce.eq.1) THEN
+ else !if (no_pce.EQ.1) THEN
   CALL stewart_explicite_vectall(ncas_evap_liq, &
 &           zq_cas(1),zxt_cas(1,1), &
@@ -468,5 +468,5 @@
 #endif
 &   )
-  endif !if (no_pce.eq.1) theniso_revap_fisrtilp 776
+  ENDIF !if (no_pce.EQ.1) theniso_revap_fisrtilp 776
 
   ! renormaliser les flux de precip pour que la proportion masse
@@ -495,8 +495,8 @@
   CALL iso_verif_positif_choix( &
 &           zxt(ixt,cas_evap_liq(i)),0.0,'revap_ilp 397')
-  if (iso_verif_positif_choix_nostop( &
+  IF (iso_verif_positif_choix_nostop( &
 &           zxt(ixt,cas_evap_liq(i))+( &
 &           fac_fluxtomixratio(i)*Exi(iiso,i)), &
-&           0.0,'revap_ilp 401').eq.1) THEN
+&           0.0,'revap_ilp 401').EQ.1) THEN
      WRITE(*,*) 'i,iiso,iso_eau=',i,iiso,iso_eau
      WRITE(*,*) 'zxt=',zxt(ixt,cas_evap_liq(i))
@@ -508,5 +508,5 @@
      WRITE(*,*) 'ptrac=',ptrac(i)
 !             stop
-  endif
+  ENDIF
   enddo !do iiso=1,niso
 END DO !do i=1,ncas_evap_liq
@@ -537,8 +537,8 @@
   ! différentes zones ont été stockées dans xtrevap_tag
   ! on les somme toute dans la vap au tag revap
-  if (option_revap.eq.1) THEN
+  IF (option_revap.EQ.1) THEN
     CALL ajoute_revap(ncas_evap_liq,cas_evap_liq(1), &
 &          klon,izone,zxt(1,1),xtrevap_tag(1,1))            
-  endif !if (option_revap.eq.1) THEN
+  ENDIF !if (option_revap.EQ.1) THEN
 #ifdef ISOVERIF
   do i=1,ncas_evap_liq
@@ -567,5 +567,5 @@
 !     :           cas_evap_glace(1),zqev_diag(cas_evap_glace(1))
 
-  if (iso_eau.gt.0) THEN
+  IF (iso_eau.gt.0) THEN
     do i=1,ncas_evap_glace
       CALL iso_verif_egalite_choix( &
@@ -575,5 +575,5 @@
 &           errmax,errmaxrel)
     enddo !do i=1,ncas_evap_glace
-  endif !if (iso_eau.gt.0) THEN
+  ENDIF !if (iso_eau.gt.0) THEN
 #endif          
   CALL compress_ilp_evap_glace( &
@@ -588,5 +588,5 @@
 &       delP(1),paprs,k,klon,klev,frac_sublim)
 #ifdef ISOVERIF
-  if (iso_eau.gt.0) THEN
+  IF (iso_eau.gt.0) THEN
     do i=1,ncas_evap_glace
       
@@ -608,5 +608,5 @@
 &           errmax,errmaxrel) 
     enddo   !do i=1,ncas_evap_glace
-  endif ! if (iso_eau.gt.0) THEN
+  ENDIF ! if (iso_eau.gt.0) THEN
 #endif          
   do i=1,ncas_evap_glace
@@ -626,8 +626,8 @@
 !            WRITE(*,*) 'zqev_diag_cas(i),fac_fluxtomixratio(i)=',
 !     :         zqev_diag_cas(i),fac_fluxtomixratio(i)  
-    if (iso_verif_positif_nostop( &
+    IF (iso_verif_positif_nostop( &
 &           (zrfl_cas(i)-zqevfl(i)),'iso_revap_fisrtilp 776') &
-&           .eq.1) THEN
-      if (zrfl_cas(i)-zqevfl(i).lt.-ridicule*1e3) THEN
+&           .EQ.1) THEN
+      IF (zrfl_cas(i)-zqevfl(i).lt.-ridicule*1e3) THEN
           stop
       endif
@@ -635,5 +635,5 @@
   enddo !do i=1,ncas_evap_glace
 #endif     
-  if (frac_sublim.eq.1) THEN
+  IF (frac_sublim.EQ.1) THEN
       CALL stewart_glace_vectall(ncas_evap_glace &
 &                ,zq_cas(1),zxt_cas(1,1) &
@@ -642,5 +642,5 @@
 &                ,zxtrfln_cas(1,1),zxtnew_cas(1,1),Exi(1,1) &
 &                ,fac_fluxtomixratio(1),zt(1))
-  else !if (frac_sublim.eq.1) THEN
+  else !if (frac_sublim.EQ.1) THEN
       CALL stewart_sublim_nofrac_vectall(ncas_evap_glace &
 &              ,zq_cas(1),zxt_cas(1,1),zrfl_cas(1),zxtrfl_cas(1,1) &
@@ -648,5 +648,5 @@
 &              ,zxtrfln_cas(1,1),zxtnew_cas(1,1),Exi(1,1) &
 &              ,fac_fluxtomixratio(1))
-  endif  !if (frac_sublim.eq.1) THEN
+  ENDIF  !if (frac_sublim.EQ.1) THEN
 #ifdef ISOVERIF
         !WRITE(*,*) 'ncas_evap_glace=',ncas_evap_glace
@@ -662,5 +662,5 @@
    enddo
   enddo !do i=1,ncas_evap_glace
-  if (iso_eau.gt.0) THEN
+  IF (iso_eau.gt.0) THEN
      do i=1,ncas_evap_glace
        CALL iso_verif_egalite_choix( &
@@ -669,9 +669,9 @@
 &                  'iso_revap_fisrtilp 4553', &
 &                  errmax,errmaxrel)
-       if (iso_verif_egalite_choix_nostop( &
+       IF (iso_verif_egalite_choix_nostop( &
 &              (zxtnew_cas(iso_eau,i)), &
 &              zq(cas_evap_glace(i)), &
 &              'iso_revap_fisrtilp 4103',errmax,errmaxrel) &
-&              .eq.1) THEN
+&              .EQ.1) THEN
           WRITE(*,*) 'i,cas_evap_glace(i)=',i,cas_evap_glace(i)
           WRITE(*,*) 'zq(cas_evap_glace(i))=', &
@@ -681,15 +681,15 @@
        endif !if (iso_verif_egalite_choix_nostop
       enddo !do i=1,ncas_evap_glace
-   endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-   if (iso_HDO.gt.0) THEN
+   endif !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+   IF (iso_HDO.gt.0) THEN
       do i=1,ncas_evap_glace
                 CALL iso_verif_aberrant_choix(zxtrfln_cas(iso_HDO,i), zrfln_cas(i), &
                   ridicule_rain,deltalim_snow, 'iso_revap_fisrtilp 4563')
        enddo !do i=1,ncas_evap_glace
-   endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) THEN
+   endif !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO)) THEN
    !  WRITE(*,*) 'iso_routines tmp 667: i=',i
-   if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+   IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
       do i=1,ncas_evap_glace
-        if (zq(i).gt.ridicule) THEN
+        IF (zq(i).gt.ridicule) THEN
 !     WRITE(*,*) 'iso_routines tmp 679a'
 !        WRITE(*,*) 'cas_evap_glace(i)=',cas_evap_glace(i)
@@ -702,9 +702,9 @@
         endif !if (zq(i).gt.ridicule) THEN
         enddo ! do i=1,ncas_evap_glac
-    endif !if ((iso_HDO.gt.0.and.(iso_O18.gt.0) THEN
+    endif !if ((iso_HDO.gt.0.AND.(iso_O18.gt.0) THEN
 !     WRITE(*,*) 'iso_routines tmp 679d'
 #endif
 
-  if ((bidouille_anti_divergence).and. &
+  IF ((bidouille_anti_divergence).AND. &
 &           (iso_eau.gt.0)) THEN
     do i=1,ncas_evap_glace
@@ -712,8 +712,8 @@
       zxtnew_cas(iso_eau,i)=zq(cas_evap_glace(i))    
     enddo !do i=1,ncas_evap_liq
-  endif ! if ((bidouille_anti_divergence).and.
-
-#ifdef ISOVERIF
-  if (iso_eau.gt.0) THEN
+  ENDIF ! if ((bidouille_anti_divergence).AND.
+
+#ifdef ISOVERIF
+  IF (iso_eau.gt.0) THEN
     do i=1,ncas_evap_glace
     CALL iso_verif_egalite_choix( &
@@ -722,5 +722,5 @@
 &           errmax,errmaxrel)
     enddo !do i=1,ncas_evap_glace
-  endif !if (iso_eau.gt.0) THEN
+  ENDIF !if (iso_eau.gt.0) THEN
 #endif          
   
@@ -753,5 +753,5 @@
   enddo  
 
-  if (frac_sublim.eq.1) THEN
+  IF (frac_sublim.EQ.1) THEN
       CALL stewart_glace_vectall(ncas_evap_glace &
 &                ,zq_cas(1),zxt_cas(1,1) &
@@ -766,5 +766,5 @@
 &              ,zxtrfln_cas(1,1),zxtnew_cas(1,1),Exi(1,1) &
 &              ,fac_fluxtomixratio(1))
-  endif  
+  ENDIF
   
 !          WRITE(*,*) 'iso_revap_ilp 509 tmp: Exi,zqev_diag_cas=',
@@ -782,8 +782,8 @@
   ! différentes zones ont été stockées dans xtrevap_tag
   ! on les somme toute dans la vap au tag revap
-  if (option_revap.eq.1) THEN
+  IF (option_revap.EQ.1) THEN
     CALL ajoute_revap(ncas_evap_glace,cas_evap_glace(1), &
 &          klon,izone,zxt(1,1),xtrevap_tag(1,1))            
-  endif !if (option_revap.eq.1) THEN
+  ENDIF !if (option_revap.EQ.1) THEN
 #ifdef ISOVERIF
   do i=1,ncas_evap_glace
@@ -816,5 +816,5 @@
 &         zxtrfl(iso_eau,i), &
 &         zrfl(i),'iso_revap_fisrtilp 802', &
-&         errmax,errmaxrel).eq.1) THEN
+&         errmax,errmaxrel).EQ.1) THEN
       WRITE(*,*) 'i,k,trace_cas(i)=',i,k,trace_cas(i)
       WRITE(*,*) 'zxtrfln(iso_eau,i),zrfln(i)=', &
@@ -824,5 +824,5 @@
 IF (iso_verif_egalite_choix_nostop( &
 &         zxt(iso_eau,i),zq(i), &
-&         'iso_revap_fisrtilp 807',errmax,errmaxrel).eq.1) THEN
+&         'iso_revap_fisrtilp 807',errmax,errmaxrel).EQ.1) THEN
   WRITE(*,*) 'i,k,trace_cas(i)=',i,k,trace_cas(i)
   stop
@@ -865,29 +865,29 @@
 
 ! inputs:
-real qsol0 ! eau du sol
-real qevap  ! eau perdue par le sol
-real Rsol0(niso) ! rapport iso initial dans sol
-real R1(niso) ! rapport iso dans couche 1, supposé constant
-real q10 ! humidité 1ère couche, en mm
-real h ! humidité rel dans couche 1, supposée cosntante
-real T ! température
-real alphak(niso) ! coef cinétique
-real L ! longueur de diffusion
-real Pveg ! just pour débguage
+REAL qsol0 ! eau du sol
+REAL qevap  ! eau perdue par le sol
+REAL Rsol0(niso) ! rapport iso initial dans sol
+REAL R1(niso) ! rapport iso dans couche 1, supposé constant
+REAL q10 ! humidité 1ère couche, en mm
+REAL h ! humidité rel dans couche 1, supposée cosntante
+REAL T ! température
+REAL alphak(niso) ! coef cinétique
+REAL L ! longueur de diffusion
+REAL Pveg ! just pour débguage
 
 ! outputs!
-real xtnu(niso) !  flux iso dans l'évap
+REAL xtnu(niso) !  flux iso dans l'évap
 
 ! locals
-real f ! fraction d'eau résiduelle dans le sol   
-real interm(niso)        
-real betaprime(niso) ! beta de stewart75
-real gama(niso) ! le gama de Stewart75
-real zxtalphal(niso), zxtalphai(niso) ! coeffs frac
-integer ixt
+REAL f ! fraction d'eau résiduelle dans le sol
+REAL interm(niso)
+REAL betaprime(niso) ! beta de stewart75
+REAL gama(niso) ! le gama de Stewart75
+REAL zxtalphal(niso), zxtalphai(niso) ! coeffs frac
+INTEGER ixt
 
 ! calcul de l'évap: ordre 1 (on prend l'évap en t0) ou bilan total
 ! (on prend l'évap tel que la 1ère couche se mette à l'équilibre
-integer ordre1 ! 1: ordre 1: deltaDevap= si deltaDvap ne change pas
+INTEGER ordre1 ! 1: ordre 1: deltaDevap= si deltaDvap ne change pas
              ! 2: deltaDvap change
 parameter (ordre1=2)
@@ -898,5 +898,5 @@
 !integer iso_verif_egalite_choix_nostop
 !real deltaD
-real xtnu2(niso)
+REAL xtnu2(niso)
 #endif      
 
@@ -907,5 +907,5 @@
   enddo
 #ifdef ISOVERIF
-    if (iso_HDO.gt.0) THEN
+    IF (iso_HDO.gt.0) THEN
 !                WRITE(*,*) 'sol_nu 66: deltaDsol(iso_HDO)=',
 !     :           (Rsol(iso_HDO)/tnat(iso_HDO)-1)*1000
@@ -919,5 +919,5 @@
 #ifdef ISOVERIF
 ! provisoire, à enlever pour tests avec evap sol nu!
-IF (P_veg.eq.1.0) THEN
+IF (P_veg.EQ.1.0) THEN
  CALL iso_verif_egalite(Pveg,1.0,'iso_evap_sol_nu 64')
 END IF
@@ -929,14 +929,14 @@
 END IF !if (iso_eau.gt.0) THEN
 IF (iso_HDO.gt.0) THEN
-  if (qsol0.gt.ridicule_qsol*1e2) THEN
-     if (iso_verif_aberrant_nostop(Rsol0(iso_HDO)/faccond, &
-&           'sol_nu 58').eq.1) THEN
+  IF (qsol0.gt.ridicule_qsol*1e2) THEN
+     IF (iso_verif_aberrant_nostop(Rsol0(iso_HDO)/faccond, &
+&           'sol_nu 58').EQ.1) THEN
        WRITE(*,*) 'qsol0=',qsol0
        stop
      endif !if (iso_verif_aberrant_nostop
-  endif !if (qsol0.gt.ridicule*1e2) THEN
-  if (h.gt.0.01) THEN
+  ENDIF !if (qsol0.gt.ridicule*1e2) THEN
+  IF (h.gt.0.01) THEN
      CALL iso_verif_aberrant(R1(iso_HDO),'sol_nu 59')
-  endif !if (h.gt.0.01) THEN
+  ENDIF !if (h.gt.0.01) THEN
 END IF  !if (iso_HDO.gt.0) THEN
 #endif
@@ -968,19 +968,19 @@
     CALL fractcalk(ixt,T,zxtalphal(ixt),zxtalphai(ixt))
   enddo ! do ixt=1,niso
-  if (qevap.gt.min(L,qsol0)) THEN
+  IF (qevap.gt.min(L,qsol0)) THEN
       ! évap trop rapide pour fractionner
      do ixt=1,niso
        xtnu(ixt)=qevap*Rsol0(ixt) 
      enddo ! do ixt=1,niso
-  else if (qsol0.lt.L) THEN
+  ELSE IF (qsol0.lt.L) THEN
       ! il ne reste plus beaucou d'eau, tout diffuse
      
      ! cas simple où q10>>qevap
-     if (ordre1.eq.1) THEN
+     IF (ordre1.EQ.1) THEN
        do ixt=1,niso
          xtnu(ixt)=qsol0*(Rsol0(ixt)-zxtalphal(ixt)*R1(ixt)) &
 &          +qevap*zxtalphal(ixt)*R1(ixt)
        enddo ! do ixt=1,niso
-     else !if (ordre1.eq.1) THEN
+     else !if (ordre1.EQ.1) THEN
        ! cas général
        do ixt=1,niso
@@ -989,15 +989,15 @@
 &           /(q10+qevap+(qsol0-qevap)*zxtalphal(ixt))
        enddo ! do ixt=1,niso
-     endif !if (ordre1.eq.1) THEN
+     endif !if (ordre1.EQ.1) THEN
   else !if (qevap.gt.min(L,qsol0)) THEN
       ! évaporation non totale et plus d'eau que dans couche de
       ! diffusion                                  
      ! cas simple où q10>>qevap
-     if (ordre1.eq.1) THEN
+     IF (ordre1.EQ.1) THEN
        do ixt=1,niso
         xtnu(ixt)=L*(Rsol0(ixt)-zxtalphal(ixt)*R1(ixt)) &
 &          +qevap*zxtalphal(ixt)*R1(ixt)
        enddo ! do ixt=1,niso
-      else !if (ordre1.eq.1) THEN
+      else !if (ordre1.EQ.1) THEN
         ! cas général
         do ixt=1,niso
@@ -1006,6 +1006,6 @@
 &           /(q10+qevap+(L-qevap)*zxtalphal(ixt))
         enddo ! do ixt=1,niso
-      endif !if (ordre1.eq.1) THEN
-  endif !if (qevap.gt.min(L,qsol0)) THEN
+      endif !if (ordre1.EQ.1) THEN
+  ENDIF !if (qevap.gt.min(L,qsol0)) THEN
 #ifdef ISOVERIF
   do ixt=1,niso
@@ -1013,7 +1013,7 @@
 &               'iso_evap_sol_nu 121')
   enddo
-        if (iso_eau.gt.0) THEN
-         if (iso_verif_egalite_choix_nostop(xtnu(iso_eau),qevap, &
-&                  'sol_nu 110',errmax,errmaxrel).eq.1) THEN
+        IF (iso_eau.gt.0) THEN
+         IF (iso_verif_egalite_choix_nostop(xtnu(iso_eau),qevap, &
+&                  'sol_nu 110',errmax,errmaxrel).EQ.1) THEN
            WRITE(*,*) 'qevap=',qevap
            WRITE(*,*) 'qsol0=',qsol0
@@ -1026,8 +1026,8 @@
          endif
         endif !if (iso_eau.gt.0) THEN
-        if (iso_HDO.gt.0) THEN
-          if (qevap.gt.ridicule_evap*1800) THEN
-            if (iso_verif_aberrant_nostop(xtnu(iso_HDO)/qevap, &
-&                   'sol_nu 113').eq.1) THEN
+        IF (iso_HDO.gt.0) THEN
+          IF (qevap.gt.ridicule_evap*1800) THEN
+            IF (iso_verif_aberrant_nostop(xtnu(iso_HDO)/qevap, &
+&                   'sol_nu 113').EQ.1) THEN
               WRITE(*,*) 'qevap=',qevap
               WRITE(*,*) 'qsol0=',qsol0
@@ -1050,6 +1050,6 @@
             endif !if (iso_verif_aberrant_nosto
           endif !if (qevap.gt.ridicule_evap*1800) THEN
-          if (iso_verif_aberrant_choix_nostop(xtnu(iso_HDO), &
-&             qevap,ridicule,1e5,'sol_nu 195').eq.1) THEN
+          IF (iso_verif_aberrant_choix_nostop(xtnu(iso_HDO), &
+&             qevap,ridicule,1e5,'sol_nu 195').EQ.1) THEN
              WRITE(*,*) 'h=',h
              WRITE(*,*) 'qsol0=',qsol0
@@ -1063,5 +1063,5 @@
 &                  /(q10+qevap))
              
-             if (ordre1.eq.1) THEN
+             IF (ordre1.EQ.1) THEN
                  ! l'ordre 2 aurait-il amélioré?
                do ixt=1,niso
@@ -1083,11 +1083,11 @@
           endif
         endif  !if (iso_HDO.gt.0) THEN
-        if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-          if (qevap.gt.ridicule_evap) THEN
+        IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+          IF (qevap.gt.ridicule_evap) THEN
             CALL iso_verif_aberrant_o17(xtnu(iso_O17) &
 &               /qevap,xtnu(iso_O18)/qevap, &
 &               'iso_evap_nu 238')
           endif !if (qevap(i).gt.ridicule_evap) THEN
-        endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+        endif !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
 #endif
 
@@ -1120,12 +1120,12 @@
 &               'iso_evap_sol_nu 169')
     enddo
-    if (iso_eau.gt.0) THEN
+    IF (iso_eau.gt.0) THEN
       CALL iso_verif_egalite_choix(xtnu(iso_eau),qevap, &
 &           'sol_nu 151',errmax,errmaxrel)
     endif !if (iso_eau.gt.0) THEN
-    if (iso_HDO.gt.0) THEN
-        if (qevap.gt.ridicule_evap*1800) THEN
-          if (iso_verif_aberrant_nostop(xtnu(iso_HDO)/qevap, &
-&           'sol_nu 154').eq.1) THEN
+    IF (iso_HDO.gt.0) THEN
+        IF (qevap.gt.ridicule_evap*1800) THEN
+          IF (iso_verif_aberrant_nostop(xtnu(iso_HDO)/qevap, &
+&           'sol_nu 154').EQ.1) THEN
                 WRITE(*,*) 'deltaDRsol0=',deltaD(Rsol0(iso_HDO))
                 WRITE(*,*) 'deltaDR1=',deltaD(R1(iso_HDO))
@@ -1151,11 +1151,11 @@
 &             qevap,ridicule,1e5,'sol_nu 269')
     endif  !if (iso_HDO.gt.0) THEN
-   if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-          if (qevap.gt.ridicule_evap) THEN
+   IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+          IF (qevap.gt.ridicule_evap) THEN
             CALL iso_verif_aberrant_o17(xtnu(iso_O17) &
 &               /qevap,xtnu(iso_O18)/qevap, &
 &               'iso_evap_nu 307')
           endif !if (qevap(i).gt.ridicule_evap) THEN
-        endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+        endif !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
 #endif
 else !if (f.gt.0.90) THEN
@@ -1178,10 +1178,10 @@
 &               'iso_evap_sol_nu 206')
   enddo
-  if (iso_eau.gt.0) THEN
+  IF (iso_eau.gt.0) THEN
      CALL iso_verif_egalite_choix(xtnu(iso_eau),qevap, &
 &           'sol_nu 168',errmax,errmaxrel)
-  endif !if (iso_eau.gt.0) THEN
-  if (iso_HDO.gt.0) THEN
-    if (qevap.gt.ridicule_qsol) THEN
+  ENDIF !if (iso_eau.gt.0) THEN
+  IF (iso_HDO.gt.0) THEN
+    IF (qevap.gt.ridicule_qsol) THEN
       CALL iso_verif_aberrant(xtnu(iso_HDO)/qevap, &
 &                   'sol_nu 171')
@@ -1189,12 +1189,12 @@
     CALL iso_verif_aberrant_choix(xtnu(iso_HDO), &
 &             qevap,ridicule,1e5,'sol_nu 302')
-  endif  !if (iso_HDO.gt.0) THEN
-  if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-       if (qevap.gt.ridicule_evap) THEN
+  ENDIF  !if (iso_HDO.gt.0) THEN
+  IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+       IF (qevap.gt.ridicule_evap) THEN
             CALL iso_verif_aberrant_o17(xtnu(iso_O17) &
 &               /qevap,xtnu(iso_O18)/qevap, &
 &               'iso_evap_nu 347')
        endif !if (qevap(i).gt.ridicule_evap) THEN
-   endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+   endif !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
 #endif
 
@@ -1225,7 +1225,7 @@
 END IF !if (iso_eau.gt.0) THEN
 IF (iso_HDO.gt.0) THEN
-   if (qevap.gt.ridicule_evap*1800) THEN
-     if (iso_verif_aberrant_nostop(xtnu(iso_HDO)/qevap, &
-&           'sol_nu 189').eq.1) THEN
+   IF (qevap.gt.ridicule_evap*1800) THEN
+     IF (iso_verif_aberrant_nostop(xtnu(iso_HDO)/qevap, &
+&           'sol_nu 189').EQ.1) THEN
        WRITE(*,*) 'deltaDRsol0=',deltaD(Rsol0(iso_HDO))
        WRITE(*,*) 'deltaDR1=',deltaD(R1(iso_HDO))
@@ -1247,8 +1247,8 @@
    CALL iso_verif_aberrant_choix(xtnu(iso_HDO), &
 &             qevap,ridicule,1e5,'sol_nu 354')
-   if (qsol0-qevap.gt.ridicule_qsol*1e2) THEN
-     if (iso_verif_aberrant_nostop((qsol0*Rsol0(iso_HDO) &
+   IF (qsol0-qevap.gt.ridicule_qsol*1e2) THEN
+     IF (iso_verif_aberrant_nostop((qsol0*Rsol0(iso_HDO) &
 &           -xtnu(iso_HDO))/(qsol0-qevap)/faccond, &
-&         'evap_sol_nu, reste sol aberrant 375').eq.1) THEN
+&         'evap_sol_nu, reste sol aberrant 375').EQ.1) THEN
        WRITE(*,*) 'qsol0=',qsol0
        WRITE(*,*) 'deltaDRsol0=',deltaD(Rsol0(iso_HDO))
@@ -1260,12 +1260,12 @@
      endif
    endif
- endif  !if (iso_HDO.gt.0) THEN
- if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-     if (qevap.gt.ridicule_evap) THEN
+ END IF  !if (iso_HDO.gt.0) THEN
+ IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+     IF (qevap.gt.ridicule_evap) THEN
        CALL iso_verif_aberrant_o17(xtnu(iso_O17) &
 &               /qevap,xtnu(iso_O18)/qevap, &
 &               'iso_evap_nu 419')
      endif !if (qevap(i).gt.ridicule_evap) THEN
-  endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+  ENDIF !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
 #endif
 END IF !if (h.lt.0.01) THEN
@@ -1284,11 +1284,11 @@
 &           'sol_nu 244',errmax,errmaxrel)
 END IF !if (iso_eau.gt.0) THEN
-IF ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-  if (qevap.gt.ridicule_evap) THEN
+IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+  IF (qevap.gt.ridicule_evap) THEN
      CALL iso_verif_aberrant_o17(xtnu(iso_O17) &
 &           /qevap,xtnu(iso_O18)/qevap, &
 &           'iso_evap_nu 443')
-  endif !if (qevap(i).gt.ridicule_evap) THEN
-END IF !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+  ENDIF !if (qevap(i).gt.ridicule_evap) THEN
+END IF !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
 #endif       
 
@@ -1303,9 +1303,9 @@
 
 ! input:
-real Vsurf ! vent de surface
+REAL Vsurf ! vent de surface
 ! output:
-real kcin(niso) ! coef cin
+REAL kcin(niso) ! coef cin
 ! locals      
-integer ixt ! numéro d'isotope
+INTEGER ixt ! numéro d'isotope
 
 
@@ -1342,15 +1342,15 @@
 
 !c -- inputs:
-      integer kt    ! tracor number
-      real ptin       ! temperature (K)
+      INTEGER kt    ! tracor number
+      REAL ptin       ! temperature (K)
 
 !c -- outputs:
-      real pxtfra   ! fractionation factor for vapor/liquid condensation
-      real pfraice  ! fractionation factor for vapor/ice condensation
+      REAL pxtfra   ! fractionation factor for vapor/liquid condensation
+      REAL pfraice  ! fractionation factor for vapor/ice condensation
 
 !c -- local variables:
-      real ZCELS, ZSATVAL
+      REAL ZCELS, ZSATVAL
       parameter (ZCELS=273.15)
-      real pt ! la température max(ptin,pxtmin)
+      REAL pt ! la température max(ptin,pxtmin)
 
 !      integer iso_verif_noNAN_nostop ! pour debugage
@@ -1363,5 +1363,5 @@
        pt=max(ptin,pxtmin)
 
-       if ((iso_O17.gt.0).and.(kt.eq.iso_O17)) THEN
+       IF ((iso_O17.gt.0).AND.(kt.EQ.iso_O17)) THEN
          pxtfra=(EXP(talph1(kt)/(pt**2)+talph2(kt)/pt+talph3(kt))) &
                  **fac_coeff_eq17_liq
@@ -1371,7 +1371,7 @@
 
 #ifdef ISOVERIF
-       if (pt.gt.pxtice) THEN
-           if (iso_verif_noNAN_nostop(pxtfra,'iso_fractcal 33') &
-                  .eq.1) THEN
+       IF (pt.gt.pxtice) THEN
+           IF (iso_verif_noNAN_nostop(pxtfra,'iso_fractcal 33') &
+                  .EQ.1) THEN
 !             WRITE(*,*) 'kt,pt=',kt,pt
 !             WRITE(*,*) 'talph1(kt),talph2(kt),talph3(kt)=',
@@ -1386,18 +1386,18 @@
 !c-----------------------------------------------------------
 
-       if ((iso_HTO.gt.0).and.(kt.eq.iso_HTO)) THEN
+       IF ((iso_HTO.gt.0).AND.(kt.EQ.iso_HTO)) THEN
           pfraice=EXP(talps1(kt)/(pt**2)+talps2(kt)/pt)
 
-       elseif ((iso_HDO.gt.0).and.(kt.eq.iso_HDO)) THEN
+       elseif ((iso_HDO.gt.0).AND.(kt.EQ.iso_HDO)) THEN
           pfraice=EXP(talps1(kt)/(pt**2)+talps2(kt))
 
-       elseif ((iso_O18.gt.0).and.(kt.eq.iso_O18)) THEN
+       elseif ((iso_O18.gt.0).AND.(kt.EQ.iso_O18)) THEN
           pfraice=EXP(talps1(kt)/pt+talps2(kt))
 
-       elseif ((iso_O17.gt.0).and.(kt.eq.iso_O17)) THEN
+       elseif ((iso_O17.gt.0).AND.(kt.EQ.iso_O17)) THEN
           pfraice=(EXP(talps1(kt)/pt+talps2(kt))) &
                  **fac_coeff_eq17_ice
 
-       elseif ((iso_eau.gt.0).and.(kt.eq.iso_eau)) THEN
+       elseif ((iso_eau.gt.0).AND.(kt.EQ.iso_eau)) THEN
           pfraice=1.
        else
@@ -1409,7 +1409,7 @@
 
 #ifdef ISOVERIF       
-       if (pt.lt.pxtmelt) THEN
-           if (iso_verif_noNAN_nostop(pfraice,'iso_fractcal 55') &
-                 .eq.1) THEN
+       IF (pt.lt.pxtmelt) THEN
+           IF (iso_verif_noNAN_nostop(pfraice,'iso_fractcal 55') &
+                 .EQ.1) THEN
 !              WRITE(*,*) 'kt,pt=',kt,pt
 !              WRITE(*,*) 'talps1(kt),talps2(kt)=',
@@ -1424,23 +1424,23 @@
 !c-----------------------------------------------------------
 
-       if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) THEN
+       IF ((iso_eau.gt.0).AND.(kt.EQ.iso_eau)) THEN
          pfraice=1.
-       else  !if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) THEN
-         if (pt.lt.pxtmelt) THEN
+       else  !if ((iso_eau.gt.0).AND.(kt.EQ.iso_eau)) THEN
+         IF (pt.lt.pxtmelt) THEN
            ZSATVAL=musi-lambda_sursat*(pt-ZCELS)
            pfraice=pfraice*(ZSATVAL/(1.+pfraice*(ZSATVAL-1.) &
                 *tdifrel(kt)))
          endif !if (pt.lt.pxtmelt) THEN
-       endif !if ((kt.ne.iso_eau).or.(iso_eau.gt.0.ne.1)) THEN
-#ifdef ISOVERIF
-         if (iso_verif_noNAN_nostop(pfraice,'iso_fractcal 73')  &
-                 .eq.1) THEN
+       endif !if ((kt.NE.iso_eau).OR.(iso_eau.gt.0.NE.1)) THEN
+#ifdef ISOVERIF
+         IF (iso_verif_noNAN_nostop(pfraice,'iso_fractcal 73')  &
+                 .EQ.1) THEN
 !            WRITE(*,*) 'kt,pt=',kt,pt
 !            WRITE(*,*) 'ZSATVAL,tdifrel(kt)=',ZSATVAL,tdifrel(kt)
          endif
-         if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) THEN
+         IF ((iso_eau.gt.0).AND.(kt.EQ.iso_eau)) THEN
              CALL iso_verif_egalite(pfraice,1.0,'iso_fractcal 63')
              CALL iso_verif_egalite(pxtfra,1.0,'iso_fractcal 67')
-         endif !if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) THEN
+         endif !if ((iso_eau.gt.0).AND.(kt.EQ.iso_eau)) THEN
 #endif
        pfraice=max(min(pfraice,100.0),0.0)
@@ -1468,14 +1468,14 @@
 
 !c -- inputs:
-      integer kt    ! tracor number
-      real ptin       ! temperature (K)
+      INTEGER kt    ! tracor number
+      REAL ptin       ! temperature (K)
 
 !c -- outputs:
-      real pxtfra   ! fractionation factor for vapor/liquid condensation
-
-      real pt ! la température max(ptin,pxtmin)
+      REAL pxtfra   ! fractionation factor for vapor/liquid condensation
+
+      REAL pt ! la température max(ptin,pxtmin)
 
 !      integer iso_verif_noNAN_nostop ! pour debugage
-      real alpha_max
+      REAL alpha_max
       parameter (alpha_max=10.0)
 
@@ -1487,5 +1487,5 @@
        pt=max(ptin,pxtmin)
 
-       if ((iso_O17.gt.0).and.(kt.eq.iso_O17)) THEN
+       IF ((iso_O17.gt.0).AND.(kt.EQ.iso_O17)) THEN
          pxtfra=(EXP(talph1(kt)/(pt**2)+talph2(kt)/pt+talph3(kt))) &
                  **fac_coeff_eq17_liq
@@ -1495,7 +1495,7 @@
 
 #ifdef ISOVERIF
-       if (pt.gt.pxtice) THEN
-           if (iso_verif_noNAN_nostop(pxtfra,'iso_fractcal 33') &
-                  .eq.1) THEN
+       IF (pt.gt.pxtice) THEN
+           IF (iso_verif_noNAN_nostop(pxtfra,'iso_fractcal 33') &
+                  .EQ.1) THEN
 !             WRITE(*,*) 'kt,pt=',kt,pt
 !             WRITE(*,*) 'talph1(kt),talph2(kt),talph3(kt)=',
@@ -1503,5 +1503,5 @@
            endif
        endif !if (pt.gt.pxtice) THEN
-       if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) THEN
+       IF ((iso_eau.gt.0).AND.(kt.EQ.iso_eau)) THEN
            CALL iso_verif_egalite(pxtfra,1.0,'iso_fractcal_phase 51')
        endif
@@ -1514,5 +1514,5 @@
       SUBROUTINE fractcalk_glace(kt, ptin, pfraice)
 
-      use isotopes_mod, ONLY: talps1,talps2, iso_O17,fac_coeff_eq17_ice, &
+      USE isotopes_mod, ONLY: talps1,talps2, iso_O17,fac_coeff_eq17_ice, &
           pxtmelt,musi, lambda_sursat, tdifrel, &
           iso_eau,iso_O18,iso_HDO,iso_O17,iso_HTO
@@ -1531,22 +1531,22 @@
 
 !c -- inputs:
-      integer kt    ! tracor number
-      real ptin       ! temperature (K)
+      INTEGER kt    ! tracor number
+      REAL ptin       ! temperature (K)
 
 !c -- outputs:
-      real pfraice  ! fractionation factor for vapor/ice condensation
+      REAL pfraice  ! fractionation factor for vapor/ice condensation
 
 !c -- local variables:
-      real ZCELS, ZSATVAL
+      REAL ZCELS, ZSATVAL
       parameter (ZCELS=273.15)
-      real Tmin ! valeur minimum de la température en K. Si elle est de
+      REAL Tmin ! valeur minimum de la température en K. Si elle est de
         ! l'ordre de quelques K seulement, les coeffs de fractionnement
         ! deviennent démesurément grands, et en plus ça fait planter l'execution à
         ! l'idris.
       parameter (Tmin=100.0)
-      real pt ! la température max(ptin,Tmin)
+      REAL pt ! la température max(ptin,Tmin)
 
 !      integer iso_verif_noNAN_nostop ! pour debugage
-      real alpha_max
+      REAL alpha_max
       parameter (alpha_max=10.0)
 
@@ -1557,15 +1557,15 @@
 !c-----------------------------------------------------------
 
-       if ((iso_HTO.gt.0).and.(kt.eq.iso_HTO)) THEN
+       IF ((iso_HTO.gt.0).AND.(kt.EQ.iso_HTO)) THEN
           pfraice=EXP(talps1(kt)/(pt**2)+talps2(kt)/pt)
 
-       elseif ((iso_HDO.gt.0).and.(kt.eq.iso_HDO)) THEN
+       elseif ((iso_HDO.gt.0).AND.(kt.EQ.iso_HDO)) THEN
           pfraice=EXP(talps1(kt)/(pt**2)+talps2(kt))
 
-       elseif ((iso_O18.gt.0).and.(kt.eq.iso_O18)) THEN
+       elseif ((iso_O18.gt.0).AND.(kt.EQ.iso_O18)) THEN
           pfraice=EXP(talps1(kt)/pt+talps2(kt))
-       elseif ((iso_O17.gt.0).and.(kt.eq.iso_O17)) THEN
+       elseif ((iso_O17.gt.0).AND.(kt.EQ.iso_O17)) THEN
           pfraice=(EXP(talps1(kt)/pt+talps2(kt)))**fac_coeff_eq17_ice
-       elseif ((iso_eau.gt.0).and.(kt.eq.iso_eau)) THEN
+       elseif ((iso_eau.gt.0).AND.(kt.EQ.iso_eau)) THEN
           pfraice=1.
        else
@@ -1577,7 +1577,7 @@
 
 #ifdef ISOVERIF       
-       if (pt.lt.pxtmelt) THEN
-           if (iso_verif_noNAN_nostop(pfraice,'iso_fractcal 55') &
-                 .eq.1) THEN
+       IF (pt.lt.pxtmelt) THEN
+           IF (iso_verif_noNAN_nostop(pfraice,'iso_fractcal 55') &
+                 .EQ.1) THEN
 !              WRITE(*,*) 'kt,pt=',kt,pt
 !              WRITE(*,*) 'talps1(kt),talps2(kt)=',
@@ -1594,22 +1594,22 @@
 !c-----------------------------------------------------------
 
-       if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) THEN
+       IF ((iso_eau.gt.0).AND.(kt.EQ.iso_eau)) THEN
          pfraice=1.
-       else  !if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) THEN
-         if (pt.lt.pxtmelt) THEN
+       else  !if ((iso_eau.gt.0).AND.(kt.EQ.iso_eau)) THEN
+         IF (pt.lt.pxtmelt) THEN
            ZSATVAL=musi-lambda_sursat*(pt-ZCELS)
            pfraice=pfraice*(ZSATVAL/(1.+pfraice*(ZSATVAL-1.) &
                 *tdifrel(kt)))
          endif !if (pt.lt.pxtmelt) THEN
-       endif !if ((kt.ne.iso_eau).or.(iso_eau.gt.0.ne.1)) THEN
-#ifdef ISOVERIF
-         if (iso_verif_noNAN_nostop(pfraice,'iso_fractcal 73')  &
-                 .eq.1) THEN
+       endif !if ((kt.NE.iso_eau).OR.(iso_eau.gt.0.NE.1)) THEN
+#ifdef ISOVERIF
+         IF (iso_verif_noNAN_nostop(pfraice,'iso_fractcal 73')  &
+                 .EQ.1) THEN
 !            WRITE(*,*) 'kt,pt=',kt,pt
 !            WRITE(*,*) 'ZSATVAL,tdifrel(kt)=',ZSATVAL,tdifrel(kt)
          endif
-         if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) THEN
+         IF ((iso_eau.gt.0).AND.(kt.EQ.iso_eau)) THEN
              CALL iso_verif_egalite(pfraice,1.0,'iso_fractcal 63')
-         endif !if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) THEN
+         endif !if ((iso_eau.gt.0).AND.(kt.EQ.iso_eau)) THEN
 #endif
        pfraice=max(min(pfraice,alpha_max),0.0)
@@ -1639,17 +1639,17 @@
 
 !c -- inputs:
-      integer n ! nombre de mailles à traiter
-      real ptin(n)       ! temperature (K)
+      INTEGER n ! nombre de mailles à traiter
+      REAL ptin(n)       ! temperature (K)
 
 !c -- outputs:
-      real pxtfra(niso,n)   ! fractionation factor for vapor/liquid condensation
-      real pfraice(niso,n)  ! fractionation factor for vapor/ice condensation
+      REAL pxtfra(niso,n)   ! fractionation factor for vapor/liquid condensation
+      REAL pfraice(niso,n)  ! fractionation factor for vapor/ice condensation
 
 !c -- local variables:
-      real ZCELS, ZSATVAL(n)
+      REAL ZCELS, ZSATVAL(n)
       parameter (ZCELS=273.15)
-      real pt(n) ! la température max(ptin,pxtmin)
-      integer i ! compteur: indice des mailles
-      integer ixt ! compteur: indice de l'isotope
+      REAL pt(n) ! la température max(ptin,pxtmin)
+      INTEGER i ! compteur: indice des mailles
+      INTEGER ixt ! compteur: indice de l'isotope
 
 !#ifdef ISOVERIF
@@ -1657,5 +1657,5 @@
 !#endif      
 
-      real alpha_max
+      REAL alpha_max
       parameter (alpha_max=10.0)
 
@@ -1671,5 +1671,5 @@
       do ixt=1,niso ! *******************************
 
-       if ((iso_O17.gt.0).and.(ixt.eq.iso_O17)) THEN
+       IF ((iso_O17.gt.0).AND.(ixt.EQ.iso_O17)) THEN
          do i=1,n
          pxtfra(ixt,i)=(EXP(talph1(ixt)/(pt(i)**2) &
@@ -1686,7 +1686,7 @@
 #ifdef ISOVERIF
        do i=1,n
-        if (pt(i).gt.pxtice) THEN
-           if (iso_verif_noNAN_nostop(pxtfra(ixt,i), &
-                 'iso_fractcal 33').eq.1) THEN
+        IF (pt(i).gt.pxtice) THEN
+           IF (iso_verif_noNAN_nostop(pxtfra(ixt,i), &
+                 'iso_fractcal 33').EQ.1) THEN
            endif
         endif !if (pt(i).gt.pxtice) THEN
@@ -1702,24 +1702,24 @@
 !c-----------------------------------------------------------
 
-       if ((iso_HTO.gt.0).and.(ixt.eq.iso_HTO)) THEN
+       IF ((iso_HTO.gt.0).AND.(ixt.EQ.iso_HTO)) THEN
          do i=1,n 
           pfraice(ixt,i)=EXP(talps1(ixt)/(pt(i)**2) &
                   +talps2(ixt)/pt(i))
          enddo !do i=1,n       
-       elseif ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) THEN
+       elseif ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO)) THEN
          do i=1,n
           pfraice(ixt,i)=EXP(talps1(ixt)/(pt(i)**2) &
                  +talps2(ixt))
          enddo !do i=1,n       
-       elseif ((iso_O18.gt.0).and.(ixt.eq.iso_O18)) THEN
+       elseif ((iso_O18.gt.0).AND.(ixt.EQ.iso_O18)) THEN
          do i=1,n
           pfraice(ixt,i)=EXP(talps1(ixt)/pt(i)+talps2(ixt))
          enddo !do i=1,n 
-       elseif ((iso_O17.gt.0).and.(ixt.eq.iso_O17)) THEN
+       elseif ((iso_O17.gt.0).AND.(ixt.EQ.iso_O17)) THEN
          do i=1,n
           pfraice(ixt,i)=(EXP(talps1(ixt)/pt(i) &
                  +talps2(ixt)))**fac_coeff_eq17_ice
          enddo !do i=1,n 
-       elseif ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+       elseif ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
          do i=1,n
           pfraice(ixt,i)=1.
@@ -1734,7 +1734,7 @@
 #ifdef ISOVERIF  
        do i=1,n     
-         if (pt(i).lt.pxtmelt) THEN
-           if (iso_verif_noNAN_nostop(pfraice(ixt,i), &
-                 'iso_fractcal 55').eq.1) THEN
+         IF (pt(i).lt.pxtmelt) THEN
+           IF (iso_verif_noNAN_nostop(pfraice(ixt,i), &
+                 'iso_fractcal 55').EQ.1) THEN
            endif
          endif !if (pt(i).lt.pxtmelt) THEN
@@ -1750,8 +1750,8 @@
 !c-----------------------------------------------------------
 
-       if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-       else  !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+       IF ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+       else  !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
          do i=1,n   
-          if (pt(i).lt.pxtmelt) THEN
+          IF (pt(i).lt.pxtmelt) THEN
            ZSATVAL(i)=musi-lambda_sursat*(pt(i)-ZCELS)
            pfraice(ixt,i)=pfraice(ixt,i) &
@@ -1760,14 +1760,14 @@
           endif !if (pt(i).lt.pxtmelt) THEN
          enddo ! do i=1,n 
-       endif !if ((ixt.ne.iso_eau).or.(iso_eau.gt.0.ne.1)) THEN
+       endif !if ((ixt.NE.iso_eau).OR.(iso_eau.gt.0.NE.1)) THEN
 #ifdef ISOVERIF
        do i=1,n
-         if (iso_verif_noNAN_nostop(pfraice(ixt,i), &
-                'iso_fractcal 73').eq.1) THEN
+         IF (iso_verif_noNAN_nostop(pfraice(ixt,i), &
+                'iso_fractcal 73').EQ.1) THEN
 !            WRITE(*,*) 'ixt,pt(i)=',ixt,pt(i)
 !            WRITE(*,*) 'ZSATVAL,tdifrel(ixt)=',ZSATVAL,tdifrel(ixt)
          endif
        enddo
-         if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+         IF ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
             do i=1,n 
              CALL iso_verif_egalite(pfraice(ixt,i),1.0, &
@@ -1776,5 +1776,5 @@
                  'iso_fractcal 67')
             enddo ! do i=1,n 
-         endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+         endif !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
 #endif
        do i=1,n
@@ -1809,16 +1809,16 @@
 
 !c -- inputs:
-      integer n ! nombre de mailles à traiter
-      real ptin(n)       ! temperature (K)
+      INTEGER n ! nombre de mailles à traiter
+      REAL ptin(n)       ! temperature (K)
 
 !c -- outputs:
-      real pxtfra(niso,n)   ! fractionation factor for vapor/liquid condensation
-
-      real pt(n) ! la température max(ptin,pxtmin)
-      integer i ! compteur: indice des mailles
-      integer ixt ! compteur: indice de l'isotope
+      REAL pxtfra(niso,n)   ! fractionation factor for vapor/liquid condensation
+
+      REAL pt(n) ! la température max(ptin,pxtmin)
+      INTEGER i ! compteur: indice des mailles
+      INTEGER ixt ! compteur: indice de l'isotope
 
 !      integer iso_verif_noNAN_nostop ! pour debugage
-      real alpha_max
+      REAL alpha_max
       parameter (alpha_max=10.0)
 
@@ -1833,5 +1833,5 @@
       do ixt=1,niso ! *******************************
 
-       if ((iso_O17.gt.0).and.(ixt.eq.iso_O17)) THEN
+       IF ((iso_O17.gt.0).AND.(ixt.EQ.iso_O17)) THEN
          do i=1,n
          pxtfra(ixt,i)=(EXP(talph1(ixt)/(pt(i)**2) &
@@ -1848,7 +1848,7 @@
 #ifdef ISOVERIF
        do i=1,n
-        if (pt(i).gt.pxtice) THEN
-           if (iso_verif_noNAN_nostop(pxtfra(ixt,i), &
-                 'iso_fractcal 33').eq.1) THEN
+        IF (pt(i).gt.pxtice) THEN
+           IF (iso_verif_noNAN_nostop(pxtfra(ixt,i), &
+                 'iso_fractcal 33').EQ.1) THEN
            endif
         endif !if (pt(i).gt.pxtice) THEN
@@ -1869,5 +1869,5 @@
       SUBROUTINE fractcalk_vectall_ice(ptin, pfraice,n)
 
-      use isotopes_mod, ONLY: talps1,talps2, fac_coeff_eq17_ice, &
+      USE isotopes_mod, ONLY: talps1,talps2, fac_coeff_eq17_ice, &
           pxtmelt,musi, lambda_sursat, tdifrel, &
           iso_eau, iso_HDO, iso_O18, iso_HTO, iso_O17
@@ -1887,24 +1887,24 @@
 
 !c -- inputs:
-      integer n ! nombre de mailles à traiter
-      real ptin(n)       ! temperature (K)
+      INTEGER n ! nombre de mailles à traiter
+      REAL ptin(n)       ! temperature (K)
 
 !c -- outputs:
-      real pfraice(niso,n)  ! fractionation factor for vapor/ice condensation
+      REAL pfraice(niso,n)  ! fractionation factor for vapor/ice condensation
 
 !c -- local variables:
-      real ZCELS, ZSATVAL(n)
+      REAL ZCELS, ZSATVAL(n)
       parameter (ZCELS=273.15)
-      real Tmin ! valeur minimum de la température en K. Si elle est de
+      REAL Tmin ! valeur minimum de la température en K. Si elle est de
         ! l'ordre de quelques K seulement, les coeffs de fractionnement
         ! deviennent démesurément grands, et en plus ça fait planter l'execution à
         ! l'idris.
       parameter (Tmin=100.0)
-      real pt(n) ! la température max(ptin,Tmin)
-      integer i ! compteur: indice des mailles
-      integer ixt ! compteur: indice de l'isotope
+      REAL pt(n) ! la température max(ptin,Tmin)
+      INTEGER i ! compteur: indice des mailles
+      INTEGER ixt ! compteur: indice de l'isotope
 
 !      integer iso_verif_noNAN_nostop ! pour debugage
-      real alpha_max
+      REAL alpha_max
       parameter (alpha_max=10.0)
 
@@ -1919,24 +1919,24 @@
 !c-----------------------------------------------------------
 
-       if ((iso_HTO.gt.0).and.(ixt.eq.iso_HTO)) THEN
+       IF ((iso_HTO.gt.0).AND.(ixt.EQ.iso_HTO)) THEN
          do i=1,n 
           pfraice(ixt,i)=EXP(talps1(ixt)/(pt(i)**2) &
                   +talps2(ixt)/pt(i))
          enddo !do i=1,n       
-       elseif ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) THEN
+       elseif ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO)) THEN
          do i=1,n
           pfraice(ixt,i)=EXP(talps1(ixt)/(pt(i)**2) &
                  +talps2(ixt))
          enddo !do i=1,n       
-       elseif ((iso_O18.gt.0).and.(ixt.eq.iso_O18)) THEN
+       elseif ((iso_O18.gt.0).AND.(ixt.EQ.iso_O18)) THEN
          do i=1,n
           pfraice(ixt,i)=EXP(talps1(ixt)/pt(i)+talps2(ixt))
          enddo !do i=1,n 
-       elseif ((iso_O17.gt.0).and.(ixt.eq.iso_O17)) THEN
+       elseif ((iso_O17.gt.0).AND.(ixt.EQ.iso_O17)) THEN
          do i=1,n
           pfraice(ixt,i)=(EXP(talps1(ixt)/pt(i)+talps2(ixt))) &
                  **fac_coeff_eq17_ice
          enddo !do i=1,n 
-       elseif ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+       elseif ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
          do i=1,n
           pfraice(ixt,i)=1.
@@ -1951,7 +1951,7 @@
 #ifdef ISOVERIF  
        do i=1,n     
-         if (pt(i).lt.pxtmelt) THEN
-           if (iso_verif_noNAN_nostop(pfraice(ixt,i), &
-                 'iso_fractcal 55').eq.1) THEN
+         IF (pt(i).lt.pxtmelt) THEN
+           IF (iso_verif_noNAN_nostop(pfraice(ixt,i), &
+                 'iso_fractcal 55').EQ.1) THEN
            endif
          endif !if (pt(i).lt.pxtmelt) THEN
@@ -1967,8 +1967,8 @@
 !c-----------------------------------------------------------
 
-       if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-       else  !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+       IF ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+       else  !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
          do i=1,n   
-          if (pt(i).lt.pxtmelt) THEN
+          IF (pt(i).lt.pxtmelt) THEN
            ZSATVAL(i)=musi-lambda_sursat*(pt(i)-ZCELS)
            pfraice(ixt,i)=pfraice(ixt,i) &
@@ -1977,19 +1977,19 @@
           endif !if (pt(i).lt.pxtmelt) THEN
          enddo ! do i=1,n 
-       endif !if ((ixt.ne.iso_eau).or.(iso_eau.gt.0.ne.1)) THEN
+       endif !if ((ixt.NE.iso_eau).OR.(iso_eau.gt.0.NE.1)) THEN
 #ifdef ISOVERIF
        do i=1,n
-         if (iso_verif_noNAN_nostop(pfraice(ixt,i), &
-                'iso_fractcal 73').eq.1) THEN
+         IF (iso_verif_noNAN_nostop(pfraice(ixt,i), &
+                'iso_fractcal 73').EQ.1) THEN
 !            WRITE(*,*) 'ixt,pt(i)=',ixt,pt(i)
 !            WRITE(*,*) 'ZSATVAL,tdifrel(ixt)=',ZSATVAL,tdifrel(ixt)
          endif
        enddo
-         if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+         IF ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
             do i=1,n 
              CALL iso_verif_egalite(pfraice(ixt,i),1.0, &
                         'iso_fractcal 63')
             enddo ! do i=1,n 
-         endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+         endif !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
 #endif
        do i=1,n
@@ -2019,17 +2019,17 @@
 
 ! inputs
-integer klon
-integer i
-real qsol(klon)
-real evap(klon)
-real xtsol(niso,klon)
-real xt1lay(ntraciso,klon)
-real q1lay(klon)
-real t1lay(klon)
+INTEGER klon
+INTEGER i
+REAL qsol(klon)
+REAL evap(klon)
+REAL xtsol(niso,klon)
+REAL xt1lay(ntraciso,klon)
+REAL q1lay(klon)
+REAL t1lay(klon)
 ! outputs
-real Rsol(niso)
+REAL Rsol(niso)
 ! locals
-integer ixt
-real zxtalphal(niso),zxtalphai(niso)
+INTEGER ixt
+REAL zxtalphal(niso),zxtalphai(niso)
 !#ifdef ISOVERIF      
 !integer iso_verif_egalite_choix_nostop
@@ -2050,18 +2050,18 @@
 END IF !if (iso_eau.gt.0) THEN
 IF (iso_HDO.gt.0) THEN
-  if (qsol(i).gt.ridicule_qsol*1e2) THEN
+  IF (qsol(i).gt.ridicule_qsol*1e2) THEN
      CALL iso_verif_aberrant(( &
 &           xtsol(iso_HDO,i)/qsol(i))/faccond, &
 &           'iso_surf>calcul_Rsol 301')
- endif ! if (qsol(i).gt.ridicule_qsol) THEN
+ END IF ! if (qsol(i).gt.ridicule_qsol) THEN
 END IF  !if (iso_HDO.gt.0) THEN
-IF ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-    if (qsol(i).gt.ridicule_qsol) THEN
+IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+    IF (qsol(i).gt.ridicule_qsol) THEN
       CALL iso_verif_aberrant_o17( &
 &           (xtsol(iso_O17,i) &
 &           /qsol(i)),(xtsol(iso_O18,i) &
 &           /qsol(i)),'iso_surf 401')
-    endif !if ((qsol(i).gt.ridicule).and.(xtsol(iso_O18,i)
-END IF !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+    endif !if ((qsol(i).gt.ridicule).AND.(xtsol(iso_O18,i)
+END IF !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
 #endif
 ! end verif 
@@ -2077,25 +2077,25 @@
     CALL iso_verif_noNAN(Rsol(ixt),'iso_surf>calcul_Rsol 3191')
   enddo !do ixt=1,niso
-  if (iso_eau.gt.0) THEN
-   if (iso_verif_egalite_choix_nostop(Rsol(iso_eau),1.0, &
+  IF (iso_eau.gt.0) THEN
+   IF (iso_verif_egalite_choix_nostop(Rsol(iso_eau),1.0, &
 &           'iso_surf>calcul_Rsol 312',errmax,errmaxrel*10) &
-&           .eq.1) THEN
+&           .EQ.1) THEN
       WRITE(*,*) 'xtsol(ixt,i),qsol(i),ridicule_qsol=', &
 &           xtsol(ixt,i),qsol(i),ridicule_qsol
       stop
    endif !if (iso_verif_egalite_choix_nostop(Rsol(iso_eau),1.0,   
-  endif !if (iso_eau.gt.0) THEN
-  if (iso_HDO.gt.0) THEN
-    if (qsol(i).gt.ridicule_qsol*1e2) THEN
+  ENDIF !if (iso_eau.gt.0) THEN
+  IF (iso_HDO.gt.0) THEN
+    IF (qsol(i).gt.ridicule_qsol*1e2) THEN
       CALL iso_verif_aberrant(Rsol(iso_HDO)/faccond, &
 &                  'iso_surf>calcul_Rsol 3201')
     endif !if (qsol(i).gt.ridicule_qsol) THEN
-  endif  !if (iso_HDO.gt.0) THEN
- if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-    if (qsol(i).gt.ridicule_qsol) THEN
+  ENDIF  !if (iso_HDO.gt.0) THEN
+ IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+    IF (qsol(i).gt.ridicule_qsol) THEN
       CALL iso_verif_aberrant_o17(Rsol(iso_O17), &
 &           Rsol(iso_O18),'iso_surf 437')
-    endif !if ((qsol(i).gt.ridicule).and.(xtsol(iso_O18,i)
- endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+    endif !if ((qsol(i).gt.ridicule).AND.(xtsol(iso_O18,i)
+ END IF !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
 #endif
 ! end verif 
@@ -2103,10 +2103,10 @@
 else !if (qsol(i).gt.ridicule_rain) THEN
 #ifdef ISOVERIF
- if (evap(i)*1800.0.gt.qsol(i)) THEN
+ IF (evap(i)*1800.0.gt.qsol(i)) THEN
  WRITE(*,*) 'iso_surf>calcul_Rsol 2989'
  WRITE(*,*) 'qsol(i)=',qsol(i),' mais evap(i)=',evap(i)
- endif
+ END IF
 #endif         
- if (q1lay(i).gt.ridicule) THEN
+ IF (q1lay(i).gt.ridicule) THEN
        ! on suppose que
        ! deltaDsol=deltaDprecip~deltaDcond(INB)~deltaDNK
@@ -2114,5 +2114,5 @@
       CALL fractcalk(ixt,t1lay(i),zxtalphal(ixt),zxtalphai(ixt))
      enddo
-     if (t1lay(i).ge.0.0) THEN
+     IF (t1lay(i).ge.0.0) THEN
          do ixt=1,niso              
             Rsol(ixt)=zxtalphal(ixt)*xt1lay(ixt,i)/q1lay(i) 
@@ -2125,20 +2125,20 @@
 &                   'iso_surf>calcul_Rsol 3202')
            enddo !do ixt=1,niso
-           if (iso_eau.gt.0) THEN
+           IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(Rsol(iso_eau),1.0, &
 &                  'iso_surf>calcul_Rsol 467',errmax,errmaxrel)
            endif !if (iso_eau.gt.0) THEN
-           if (iso_HDO.gt.0) THEN
-              if (qsol(i).gt.ridicule_qsol) THEN
+           IF (iso_HDO.gt.0) THEN
+              IF (qsol(i).gt.ridicule_qsol) THEN
                  CALL iso_verif_aberrant(Rsol(iso_HDO)/faccond, &
 &                   'iso_surf>calcul_Rsol 338')
                endif !if (qsol(i).gt.ridicule_qsol) THEN
            endif  !if (iso_HDO.gt.0) THEN
-           if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-             if (qsol(i).gt.ridicule_qsol) THEN
+           IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+             IF (qsol(i).gt.ridicule_qsol) THEN
                CALL iso_verif_aberrant_o17(Rsol(iso_O17) &
 &                   ,Rsol(iso_O18),'iso_surf 480')
-             endif !if ((qsol(i).gt.ridicule).and.(xtsol(iso_O18,i)
-           endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+             endif !if ((qsol(i).gt.ridicule).AND.(xtsol(iso_O18,i)
+           endif !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
 #endif
           ! end verif
@@ -2155,20 +2155,20 @@
 &                   'iso_surf>calcul_Rsol 3207')
             enddo !do ixt=1,niso    
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
                 CALL iso_verif_egalite_choix(Rsol(iso_eau),1.0, &
 &                   'iso_surf>calcul_Rsol 335',errmax,errmaxrel)
             endif !if (iso_eau.gt.0) THEN
-            if (iso_HDO.gt.0) THEN
-              if (qsol(i).gt.ridicule_qsol) THEN
+            IF (iso_HDO.gt.0) THEN
+              IF (qsol(i).gt.ridicule_qsol) THEN
                 CALL iso_verif_aberrant(Rsol(iso_HDO)/faccond, &
 &                   'iso_surf>calcul_Rsol 338')
               endif !if (qsol(i).gt.ridicule_qsol) THEN
             endif  !if (iso_HDO.gt.0) THEN
-            if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-              if (qsol(i).gt.ridicule_qsol) THEN
+            IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+              IF (qsol(i).gt.ridicule_qsol) THEN
                 CALL iso_verif_aberrant_o17(Rsol(iso_O17) &
 &                    ,Rsol(iso_O18),'iso_surf 513')
-              endif !if ((qsol(i).gt.ridicule).and.(xtsol(iso_O18,i)
-            endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+              endif !if ((qsol(i).gt.ridicule).AND.(xtsol(iso_O18,i)
+            endif !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
 #endif
               ! end verif
@@ -2179,5 +2179,5 @@
         WRITE(*,*) 'q1lay(i)=',q1lay(i)
         CALL abort_physic('isotopes_routines_mod', 'iso_surf 2187', 1)
- endif !if (q1lay(i).gt.ridicule) THEN
+ END IF !if (q1lay(i).gt.ridicule) THEN
 END IF !if (qsol(i).gt.ridicule_rain) THEN
 ! verif
@@ -2188,20 +2188,20 @@
  enddo !do ixt=1,niso
 
- if (iso_eau.gt.0) THEN
+ IF (iso_eau.gt.0) THEN
          CALL iso_verif_egalite_choix(Rsol(iso_eau),1.0, &
 &          'iso_surf>calcul_Rsol 371',errmax,errmaxrel*10)
- endif !if (iso_eau.gt.0) THEN
- if (iso_HDO.gt.0) THEN
-    if (qsol(i).gt.ridicule_qsol*1e2) THEN
+ END IF !if (iso_eau.gt.0) THEN
+ IF (iso_HDO.gt.0) THEN
+    IF (qsol(i).gt.ridicule_qsol*1e2) THEN
         CALL iso_verif_aberrant(Rsol(iso_HDO)/faccond, &
 &          'iso_surf>calcul_Rsol 374')
     endif !if (qsol(i).gt.ridicule_qsol) THEN
- endif  !if (iso_HDO.gt.0) THEN
- if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-    if (qsol(i).gt.ridicule_qsol) THEN
+ END IF  !if (iso_HDO.gt.0) THEN
+ IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+    IF (qsol(i).gt.ridicule_qsol) THEN
       CALL iso_verif_aberrant_o17(Rsol(iso_O17), &
 &           Rsol(iso_O18),'iso_surf 548')
-    endif !if ((qsol(i).gt.ridicule).and.(xtsol(iso_O18,i)
- endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+    endif !if ((qsol(i).gt.ridicule).AND.(xtsol(iso_O18,i)
+ END IF !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
 #endif
           ! end verif
@@ -2226,24 +2226,24 @@
  IMPLICIT NONE
 ! inputs
-integer i
-integer klon
-real evap(klon) ! en kg d'eau/s
-real xt1lay(ntraciso,klon) ! en kg d'iso/kg d'air
-real q1lay(klon) ! en kg d'eau/kg d'air
-real tsurf(klon)
-real t_coup
+INTEGER i
+INTEGER klon
+REAL evap(klon) ! en kg d'eau/s
+REAL xt1lay(ntraciso,klon) ! en kg d'iso/kg d'air
+REAL q1lay(klon) ! en kg d'eau/kg d'air
+REAL tsurf(klon)
+REAL t_coup
 !      real dtime ! en s: typiquement: 1800s
 !      real Mair ! en kg d'air
 
 ! outputs
-real xtevap(ntraciso,klon) ! en kg d'iso/s
+REAL xtevap(ntraciso,klon) ! en kg d'iso/s
 
 ! locals
-integer ixt
-real zxtalphal(niso),zxtalphai(niso)
-real zxtliq,zxtice ! en kg d'eau /kg d'air
+INTEGER ixt
+REAL zxtalphal(niso),zxtalphai(niso)
+REAL zxtliq,zxtice ! en kg d'eau /kg d'air
 !      real qevap ! en kg d'eau /kg d'air
 !real deltaD ! juste pour vérif
-real R1eff
+REAL R1eff
 !#ifdef ISOVERIF
 !integer iso_verif_aberrant_o17_nostop
@@ -2252,5 +2252,5 @@
 
 !      WRITE(*,*) 'iso_surf>rosée 527: entrée dans rosée'
-IF (evap(i).eq.0.0) THEN
+IF (evap(i).EQ.0.0) THEN
 #ifdef ISOVERIF          
 WRITE(*,*) 'iso_surf>rosée 528: evap(i)=',evap(i)
@@ -2265,5 +2265,5 @@
      ! verif de R1
 #ifdef ISOVERIF
-         if (iso_HDO.gt.0) THEN
+         IF (iso_HDO.gt.0) THEN
              CALL iso_verif_aberrant(xt1lay(iso_HDO,i)/q1lay(i), &
 &                  'iso_surf>rosée 530')
@@ -2276,5 +2276,5 @@
 !             WRITE(*,*) 'evap(i),dtime,Mair,q1lay(i)=',
 !     :                   evap(i),dtime,Mair,q1lay(i)            
-  if (tsurf(i).ge.t_coup) THEN
+  IF (tsurf(i).ge.t_coup) THEN
     !WRITE(*,*) 'iso_surf>iso_rosee_givre 3181: tsurf(i)=',tsurf(i)
     do ixt=1,niso
@@ -2305,5 +2305,5 @@
         CALL iso_verif_noNAN(xtevap(ixt,i),'iso_surf>rosée 557')
       enddo !do ixt=1,niso  
-      if (iso_HDO.gt.0) THEN
+      IF (iso_HDO.gt.0) THEN
 !                WRITE(*,*) 'iso_surf>rosée 554: deltaD1=',
 !     :                   deltaD(xt1lay(iso_HDO,i)/q1lay(i))
@@ -2343,5 +2343,5 @@
 
 #ifdef ISOVERIF            
-    if (iso_HDO.gt.0) THEN
+    IF (iso_HDO.gt.0) THEN
 !             WRITE(*,*) 'iso_surf>rosée 571: deltaD1=',
 !     :                   deltaD(xt1lay(iso_HDO,i)/q1lay(i))
@@ -2349,5 +2349,5 @@
 !     :                   deltaD(xtevap(iso_HDO,i)/evap(i))    
     endif  !if (iso_HDO.gt.0) THEN
-    if (iso_eau.gt.0) THEN
+    IF (iso_eau.gt.0) THEN
       CALL iso_verif_egalite_choix(xt1lay(iso_eau,i),q1lay(i), &
 &           'iso_surf>iso_rosee_givre 621',errmax,errmaxrel)
@@ -2360,5 +2360,5 @@
 #endif              
 #endif            
-  endif !if (tsurf(i).ge.0.0) THEN
+  ENDIF !if (tsurf(i).ge.0.0) THEN
   ! verif   
 #ifdef ISOVERIF
@@ -2369,12 +2369,12 @@
 #endif
 #ifdef ISOVERIF
-    if (iso_eau.gt.0) THEN
+    IF (iso_eau.gt.0) THEN
       CALL iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), &
 &           'iso_surf>iso_rosee_givre 3192',errmax,errmaxrel)
     endif !if (iso_eau.gt.0) THEN
-    if (abs(evap(i)).gt.ridicule_rain) THEN
-      if (iso_HDO.gt.0) THEN
-         if (iso_verif_aberrant_choix_nostop(xtevap(iso_HDO,i),evap(i), &
-&           ridicule_rain,deltalim_snow,'iso_surf>iso_rosee_givre 3193').eq.1) THEN
+    IF (abs(evap(i)).gt.ridicule_rain) THEN
+      IF (iso_HDO.gt.0) THEN
+         IF (iso_verif_aberrant_choix_nostop(xtevap(iso_HDO,i),evap(i), &
+&           ridicule_rain,deltalim_snow,'iso_surf>iso_rosee_givre 3193').EQ.1) THEN
                 WRITE(*,*) 'zxtalphai(iso_HDO)=',zxtalphai(iso_HDO)
                 WRITE(*,*) 'deltaD1eff=',deltaD(xt1lay(iso_HDO,i)/q1lay(i))
@@ -2384,8 +2384,8 @@
            endif !if (iso_verif_aberrant_nostop
       endif  !if (iso_HDO.gt.0) THEN
-      if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-        if (iso_verif_aberrant_o17_nostop(xtevap(iso_O17,i) &
+      IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+        IF (iso_verif_aberrant_o17_nostop(xtevap(iso_O17,i) &
 &            /evap(i),xtevap(iso_O18,i) &
-&            /evap(i),'iso_surf>iso_rosee_givre 713').eq.1) THEN
+&            /evap(i),'iso_surf>iso_rosee_givre 713').EQ.1) THEN
           WRITE(*,*) 'tsurf(i)-t_coup=',tsurf(i)-t_coup
           WRITE(*,*) 'deltaO18, O17excess, 1lay', &
@@ -2396,5 +2396,5 @@
           stop
         endif
-      endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+      endif !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
     endif !if (evap(i).gt.ridicule_rain) THEN
 #endif
@@ -2442,19 +2442,19 @@
 ! declaration des variables      
 ! **inputs
-integer ncas
-real qp0(ncas),xtp0(niso,ncas)
-real Pxtisup(niso,ncas)
-real Pqisup(ncas),Eqi(ncas),Pqiinf(ncas)
-real qs(ncas),qeff(ncas)
-real fac_ftmr(ncas)
-
-real Tevap(ncas)
-real deltaP(ncas),wt(ncas)
+INTEGER ncas
+REAL qp0(ncas),xtp0(niso,ncas)
+REAL Pxtisup(niso,ncas)
+REAL Pqisup(ncas),Eqi(ncas),Pqiinf(ncas)
+REAL qs(ncas),qeff(ncas)
+REAL fac_ftmr(ncas)
+
+REAL Tevap(ncas)
+REAL deltaP(ncas),wt(ncas)
 
 ! **outputs
-real Pxtiinf(niso,ncas)
-real xtnew(niso,ncas)
-real Exi(niso,ncas)
-integer ixt
+REAL Pxtiinf(niso,ncas)
+REAL xtnew(niso,ncas)
+REAL Exi(niso,ncas)
+INTEGER ixt
 
 ! **locals
@@ -2462,34 +2462,34 @@
 #ifdef ISOVERIF
 !real deltaD,deltaO,O17excess
-real Rlfin(niso),Rbfin(niso)
-integer debug ! si 1: on sort à l'écran ce qui se passe en il_debug
-integer il_debug
+REAL Rlfin(niso),Rbfin(niso)
+INTEGER debug ! si 1: on sort à l'écran ce qui se passe en il_debug
+INTEGER il_debug
 #endif        
 
 ! intermediaires
-real h(ncas)
-real gama(niso,ncas), beta(niso,ncas), &
+REAL h(ncas)
+REAL gama(niso,ncas), beta(niso,ncas), &
 &           interm(niso,ncas)
-real alphap(niso,ncas)
-real Rl0(niso,ncas), Rb0(niso,ncas), Rl(niso,ncas),  &
+REAL alphap(niso,ncas)
+REAL Rl0(niso,ncas), Rb0(niso,ncas), Rl(niso,ncas),  &
 &           Rb(niso,ncas)
-real m(ncas), m0(ncas), A(ncas), qp(ncas)
-real J(niso,ncas),e(niso,ncas)
-real r_l0qp0(ncas), r_jqp0(niso,ncas),  &
+REAL m(ncas), m0(ncas), A(ncas), qp(ncas)
+REAL J(niso,ncas),e(niso,ncas)
+REAL r_l0qp0(ncas), r_jqp0(niso,ncas),  &
 &           r_jl0(niso,ncas)
-real f(ncas),g(ncas)
-real Revap(niso,ncas)
-real Revap0(niso,ncas)
-real Revapfin(niso,ncas)
-real fv(ncas)
+REAL f(ncas),g(ncas)
+REAL Revap(niso,ncas)
+REAL Revap0(niso,ncas)
+REAL Revapfin(niso,ncas)
+REAL fv(ncas)
 
 !real  ! debugage
-real real_to_double        
-integer il
+REAL real_to_double
+INTEGER il
 #ifdef ISOVERIF
 !integer iso_verif_aberrant_nostop
 !integer iso_verif_egalite_choix_nostop
 !integer iso_verif_egalite_nostop
-real Jtmp,etmp
+REAL Jtmp,etmp
 #endif      
 !integer iso_verif_noNaN_nostop
@@ -2501,11 +2501,11 @@
 
 ! parsage
-integer trace(ncas)
-integer icas_Jsimple,ncas_Jsimple
-integer icas_rieman,ncas_rieman
-integer cas_Jsimple(ncas)
-integer cas_rieman(ncas)
-
-real m_cas(ncas), m0_cas(ncas), &
+INTEGER trace(ncas)
+INTEGER icas_Jsimple,ncas_Jsimple
+INTEGER icas_rieman,ncas_rieman
+INTEGER cas_Jsimple(ncas)
+INTEGER cas_rieman(ncas)
+
+REAL m_cas(ncas), m0_cas(ncas), &
 &     qp0_cas(ncas),A_cas(ncas), &
 &     beta_cas(niso,ncas),gama_cas(niso,ncas),f_cas(ncas), &
@@ -2516,5 +2516,5 @@
 &     xtnew_cas(niso,ncas),Pqiinf_cas(ncas), &
 &     Eqi_cas(ncas),xtp0_cas(niso,ncas)
-real fac_ftmr_cas(ncas)
+REAL fac_ftmr_cas(ncas)
 !        integer ntot_cas(ncas)
 
@@ -2538,5 +2538,5 @@
 IF (iso_verif_egalite_nostop(( &
 &           Pqisup(il)-Eqi(il)-Pqiinf(il)),0.0, &
-&          'stewart_explicite 37' ).eq.1) THEN
+&          'stewart_explicite 37' ).EQ.1) THEN
   WRITE(*,*) 'il,Pqisup(il),Eqi(il),Pqiinf(il)=', &
 &          il,Pqisup(il),Eqi(il),Pqiinf(il) 
@@ -2554,5 +2554,5 @@
 &          'stewart_explicite 58',errmax,errmaxrel)
    enddo !do il=1,ncas 
- endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+ END IF !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
 #endif
  
@@ -2582,6 +2582,6 @@
     ! éviter des Pqisup pathologiquement petits
 #ifdef ISOVERIF
-    if ((abs(Pqiinf(il)).gt.ridicule) &
-&            .or.(abs(Eqi(il)).gt.ridicule)) THEN
+    IF ((abs(Pqiinf(il)).gt.ridicule) &
+&            .OR.(abs(Eqi(il)).gt.ridicule)) THEN
         WRITE(*,*) 'stewart_explicite 39'
         WRITE(*,*) 'Pqisup=',Pqisup(il)
@@ -2596,5 +2596,5 @@
       Pxtiinf(ixt,il)=0.0
     enddo
-    if (abs(Eqi(il)*fac_ftmr(il)).gt.ridicule) THEN
+    IF (abs(Eqi(il)*fac_ftmr(il)).gt.ridicule) THEN
         ! attention: pour des raisons obscures, il y a parfois
         ! de le réévaporation significative alors qu'il n'y a
@@ -2603,5 +2603,5 @@
         ! on suppose qu'elle ne change pas la composition
         ! isotopique de la vapeur. 
-        if (qp0(il).gt.ridicule) THEN
+        IF (qp0(il).gt.ridicule) THEN
            do ixt=1,niso
            Rb0(ixt,il)=xtp0(ixt,il)/qp0(il)  
@@ -2614,5 +2614,5 @@
            Rb0(ixt,il)=0.0     
            enddo ! do ixt=1,niso
-           if (iso_eau.gt.0) THEN
+           IF (iso_eau.gt.0) THEN
                 Rb0(iso_eau,il)=1.0
            endif
@@ -2636,5 +2636,5 @@
 &             'stewart_explicite_vectall 220')
     enddo
-    if (iso_eau.gt.0) THEN
+    IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite_choix( &
 &              (Exi(iso_eau,il)*fac_ftmr(il)), &
@@ -2650,13 +2650,13 @@
 &                'stewart_explicite 218',errmax*10,errmaxrel*50) 
        endif !if (iso_eau.gt.0) THEN
-       if ((iso_HDO.gt.0).and. &
+       IF ((iso_HDO.gt.0).AND. &
 &           (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule)) THEN
          CALL iso_verif_aberrant(( &
 &                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
 &                   *fac_ftmr(il))),'stewart_explicite 214')
-       endif !if ((iso_HDO.gt.0).and.
+       endif !if ((iso_HDO.gt.0).AND.
 
 #endif              
-else !if (Pqisup.eq.0) THEN
+else !if (Pqisup.EQ.0) THEN
 h(il)=qeff(il)/qs(il)       
 h(il)= MAX(MIN(h(il),1.0),0.0)
@@ -2669,5 +2669,5 @@
 ! en fait, tout reste pareil si h<1, car diff devient alors
 ! difficile
-IF ((Eqi(il)*fac_ftmr(il).lt.ridicule).and.(h(il).lt.0.99)) THEN
+IF ((Eqi(il)*fac_ftmr(il).lt.ridicule).AND.(h(il).lt.0.99)) THEN
 !            WRITE(*,*) 'stewart_explicite 137: cas pas d''évap'
 
@@ -2688,14 +2688,14 @@
 #endif
 #ifdef ISOVERIF
-    if (iso_eau.gt.0) THEN
+    IF (iso_eau.gt.0) THEN
       CALL iso_verif_egalite_choix( &
 &                   (Pxtiinf(iso_eau,il)), &
 &                   (Pqiinf(il)), &
 &                  'stewart_explicite 143',errmax,errmaxrel)
-      if (iso_verif_egalite_choix_nostop( &
+      IF (iso_verif_egalite_choix_nostop( &
 &              (Exi(iso_eau,il)*fac_ftmr(il)), &
 &              (Eqi(il)*fac_ftmr(il)), &
 &              'stewart_explicit 283',errmax*10,errmaxrel*10) &
-&              .eq.1) THEN
+&              .EQ.1) THEN
         WRITE(*,*) 'il=',il
         WRITE(*,*) 'Eqi(il)=',Eqi(il)
@@ -2703,23 +2703,23 @@
         stop
       endif
-      if (Pqiinf(il).gt.ridicule) THEN
+      IF (Pqiinf(il).gt.ridicule) THEN
           CALL iso_verif_egalite_choix &
 &               ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
 &               1.,'stewart_explicite 143',errmax,errmaxrel)
       endif !if (Pqiinf.gt.ridicule) THEN
-    endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-    if (iso_HDO.gt.0) THEN
-      if (Pqiinf(il).gt.ridicule_rain) THEN
+    endif !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+    IF (iso_HDO.gt.0) THEN
+      IF (Pqiinf(il).gt.ridicule_rain) THEN
             CALL iso_verif_aberrant( &
 &                (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
 &                'stewart_explicie 132')   
-      endif   !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
-      if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
+      endif   !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO).AND.
+      IF (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
          CALL iso_verif_aberrant(( &
 &                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
 &                   *fac_ftmr(il))),'stewart_explicite 268')
-      endif !if ((iso_HDO.gt.0).and.
+      endif !if ((iso_HDO.gt.0).AND.
     endif !if (iso_HDO.gt.0) THEN
-    if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) THEN
+    IF ((debug.EQ.1).AND.(il.EQ.il_debug).AND.(Eqi(il).gt.0.)) THEN
            WRITE(*,*) 'stewart_explicit 302: cas evap~0'
            WRITE(*,*) 'deltaDv est inchangé:',deltaD( &
@@ -2730,5 +2730,5 @@
      ! end verif
 
- else !if ((Eqi(il)*fac_ftmr(il).lt.ridicule).and.(h(il).lt.0.99)) THEN
+ else !if ((Eqi(il)*fac_ftmr(il).lt.ridicule).AND.(h(il).lt.0.99)) THEN
 A(il)=wt(il)/deltaP(il)*fac_ftmr(il)
 m0(il)=max(Pqisup(il)*deltaP(il)/wt(il),0.0)
@@ -2742,7 +2742,7 @@
    Rb0(ixt,il)=0.0 
   enddo !do ixt=1,niso
-  if (iso_eau.gt.0) THEN
+  IF (iso_eau.gt.0) THEN
       Rb0(iso_eau,il)=1.0
-  endif
+  ENDIF
 END IF
 IF (Pqisup(il).gt.ridicule*1e-3) THEN
@@ -2754,7 +2754,7 @@
    Rl0(ixt,il)=0.0
   enddo !do ixt=1,niso 
-  if (iso_eau.gt.0) THEN
+  IF (iso_eau.gt.0) THEN
       Rl0(iso_eau,il)=1.0
-  endif
+  ENDIF
 END IF ! if (Pqisup(il).gt.ridicule*1e-3) THEN
 f(il)=m(il)/m0(il)    
@@ -2779,8 +2779,8 @@
 #ifdef ISOVERIF
 DO ixt=1,niso
-  if ((iso_verif_noNaN_nostop((Rl0(ixt,il)), &
-&          'stewart_explicit 357').eq.1).or.  &
+  IF ((iso_verif_noNaN_nostop((Rl0(ixt,il)), &
+&          'stewart_explicit 357').EQ.1).OR.  &
 &          (iso_verif_noNaN_nostop((Rb0(ixt,il)), &
-&          'stewart_explicit 359').eq.1)) THEN
+&          'stewart_explicit 359').EQ.1)) THEN
     WRITE(*,*) 'Pxtisup(ixt,il)=',Pxtisup(ixt,il)
     WRITE(*,*) 'Pqisup(il)',Pqisup(il)
@@ -2788,17 +2788,17 @@
     WRITE(*,*) 'qp0(il)=',qp0(il)
     stop
-  endif !if ((iso_verif_noNaN_nostop
+  ENDIF !if ((iso_verif_noNaN_nostop
 END DO !do ixt=1,niso
 #endif              
 #ifdef ISOVERIF
-  if (iso_eau.gt.0) THEN
+  IF (iso_eau.gt.0) THEN
     CALL iso_verif_egalite_choix( &
 &           (xtp0(iso_eau,il)), &
 &           (qp0(il)),'stewart_explicit 199', &
 &           errmax,errmaxrel)  
-    if (iso_verif_egalite_choix_nostop( &
+    IF (iso_verif_egalite_choix_nostop( &
 &           (Rb0(iso_eau,il)),1.0, &
 &           'stewart_explicit 136', &
-&           errmax*10,errmaxrel*10).eq.1) THEN
+&           errmax*10,errmaxrel*10).EQ.1) THEN
        WRITE(*,*) 'xtp0,qp0,Rb0=', &
 &           xtp0(iso_eau,il),qp0(il),Rb0(iso_eau,il)
@@ -2808,7 +2808,7 @@
 &           Pxtisup(iso_eau,il)),(Pqisup(il)), &
 &           'stewart_explicit 208',errmax,errmaxrel)
-    if (iso_verif_egalite_choix_nostop( &
+    IF (iso_verif_egalite_choix_nostop( &
 &           (Rl0(iso_eau,il)),1.0, &
-&        'stewart_explicit 209',errmax,errmaxrel).eq.1) THEN
+&        'stewart_explicit 209',errmax,errmaxrel).EQ.1) THEN
       WRITE(*,*) 'Pxtisup(iso_eau,il),Pqisup=', &
 &                   Pxtisup(iso_eau,il),Pqisup(il)
@@ -2816,9 +2816,9 @@
     endif !if (iso_verif_egalite_choix_nostop(
     ! rajout verif 4 sept 2009
-    if (iso_HDO.gt.0) THEN
+    IF (iso_HDO.gt.0) THEN
         CALL iso_verif_aberrant_choix(Rl0(iso_HDO,il)*Pqisup(il),Pqisup(il), &
 &                   ridicule_rain,deltalim_snow,'stewart_explicite 368')
     endif !if (iso_HDO.gt.0) THEN
-  endif !(iso_eau.gt.0)
+  ENDIF !(iso_eau.gt.0)
 #endif
 ! end verif
@@ -2826,5 +2826,5 @@
         
 ! **** cas où m=0 <-> f=0
-IF ((f(il).lt.1e-9).or.(Pqiinf(il).lt.ridicule/10.)) THEN
+IF ((f(il).lt.1e-9).OR.(Pqiinf(il).lt.ridicule/10.)) THEN
     !WRITE(*,*) 'stewart_explicit 137: cas f=0: il=',il
   do ixt=1,niso 
@@ -2847,5 +2847,5 @@
 &                   'stewart_explicite 271')
    enddo !do ixt=1,niso   
-   if (iso_eau.gt.0) THEN
+   IF (iso_eau.gt.0) THEN
       CALL iso_verif_egalite_choix( &
 &                   (Pxtiinf(iso_eau,il)), &
@@ -2860,14 +2860,14 @@
 &                  (Eqi(il)*fac_ftmr(il)), &
 &                  'stewart_expilicit 229',errmax*10,errmaxrel*10)
-      if (Pqiinf(il).gt.ridicule) THEN
+      IF (Pqiinf(il).gt.ridicule) THEN
               CALL iso_verif_egalite_choix &
 &                 ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
 &                 1.,'stewart_explicite 143',errmax,errmaxrel)
       endif !if (Pqiinf.gt.ridicule) THEN
-      if (iso_verif_egalite_choix_nostop( &
+      IF (iso_verif_egalite_choix_nostop( &
 &                   (xtnew(iso_eau,il)), &
 &                   (qp0(il)+Eqi(il)*fac_ftmr(il)), &
 &                   'stewart_explicite 218',errmax*10,errmaxrel*50) &
-&                           .eq.1) THEN
+&                           .EQ.1) THEN
                 WRITE(*,*) 'xtnew=',xtnew(iso_eau,il)
                 WRITE(*,*) 'qp=',qp0(il)+Eqi(il)*fac_ftmr(il)
@@ -2886,12 +2886,12 @@
              !Exi=Eqi
              !xtnew=qp0+Eqi*fac_ftmr
-     endif    !if (iso_eau.gt.0).and.(ixt.eq.iso_eau) 
-     if (iso_HDO.gt.0) THEN
-       if (Pqiinf(il).gt.ridicule_rain) THEN
+     endif    !if (iso_eau.gt.0).AND.(ixt.EQ.iso_eau)
+     IF (iso_HDO.gt.0) THEN
+       IF (Pqiinf(il).gt.ridicule_rain) THEN
             CALL iso_verif_aberrant( &
 &                  (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
 &                   'stewart_explicie 224')   
-       endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
-       if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
+       endif !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO).AND.
+       IF (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
          CALL iso_verif_aberrant(( &
 &                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
@@ -2899,5 +2899,5 @@
        endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
      endif !if (iso_HDO.gt.0)
-     if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) THEN
+     IF ((debug.EQ.1).AND.(il.EQ.il_debug).AND.(Eqi(il).gt.0.)) THEN
          WRITE(*,*) 'stewart_explicit 442: tout se réévapore'
          WRITE(*,*) 'Eqi(il),deltaD=',Eqi(il), &
@@ -2906,5 +2906,5 @@
 #endif
         ! end verifs                
-  else !if ((f.lt.errmaxrel).or.(Pqiinf.lt.errmax)) THEN
+  else !if ((f.lt.errmaxrel).OR.(Pqiinf.lt.errmax)) THEN
 DO ixt=1,niso
 CALL FRACTCALK_liq(IXT, TEVAP(il), alphap(ixt,il))
@@ -2915,6 +2915,6 @@
 ! dans le cas 1er ordre pour la vapeur
 ! on remplace aussi le alpha en gama pour être plus précis
-IF ((h(il).gt.0.99).or. &
-&           (h(il).gt.0.98).and.(f(il).lt.1e-3)) THEN
+IF ((h(il).gt.0.99).OR. &
+&           (h(il).gt.0.98).AND.(f(il).lt.1e-3)) THEN
     do ixt=1,niso
     interm(ixt,il)=alphap(ixt,il)*(1.0-h(il)) &
@@ -2931,5 +2931,5 @@
     xtnew(ixt,il)=max(xtnew(ixt,il),0.0)
   enddo !do ixt=1,niso 
-  if (fac_ftmr(il).gt.0.0) THEN
+  IF (fac_ftmr(il).gt.0.0) THEN
      do ixt=1,niso  
        Exi(ixt,il)=(xtnew(ixt,il)-xtp0(ixt,il))/fac_ftmr(il)
@@ -2939,5 +2939,5 @@
        Exi(ixt,il)=Pxtisup(ixt,il)-Pxtiinf(ixt,il)
     enddo !do ixt=1,niso    
-  endif
+  ENDIF
     !Exi=max(Exi,0)
 
@@ -2952,5 +2952,5 @@
 &           'stewart_explicite 261')
     enddo !do ixt=1,niso
-    if (iso_eau.gt.0) THEN
+    IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite_choix( &
 &            (Rb(iso_eau,il)), &
@@ -2968,14 +2968,14 @@
 &                  (Eqi(il)*fac_ftmr(il)), &
 &                  'stewart_expilicit 291',errmax*10,errmaxrel*10)
-        if (Pqiinf(il).gt.ridicule) THEN
+        IF (Pqiinf(il).gt.ridicule) THEN
             CALL iso_verif_egalite_choix &
 &                 ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
 &                 1.,'stewart_explicite 312',errmax,errmaxrel)
          endif !if (Pqiinf.gt.ridicule) THEN
-     endif    !if (iso_eau.gt.0).and.(ixt.eq.iso_eau)  
+     endif    !if (iso_eau.gt.0).AND.(ixt.EQ.iso_eau)
       
-     if (iso_HDO.gt.0) THEN
-       if (iso_verif_aberrant_choix_nostop(Pxtiinf(iso_HDO,il),Pqiinf(il), &
-&                ridicule_rain,deltalim_snow,'stewart_explicite 248').eq.1) THEN
+     IF (iso_HDO.gt.0) THEN
+       IF (iso_verif_aberrant_choix_nostop(Pxtiinf(iso_HDO,il),Pqiinf(il), &
+&                ridicule_rain,deltalim_snow,'stewart_explicite 248').EQ.1) THEN
              WRITE(*,*) 'cas reeq totale, il=',il
              WRITE(*,*) 'deltaDl0=',deltaD( &
@@ -2987,11 +2987,11 @@
              stop
        endif !if (iso_verif_aberrant_choix_nostop
-       if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
+       IF (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
          CALL iso_verif_aberrant(( &
 &                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
 &                   *fac_ftmr(il))),'stewart_explicite 499')
-       endif !if ((iso_HDO.gt.0).and.
+       endif !if ((iso_HDO.gt.0).AND.
      endif  !if (iso_HDO.gt.0) THEN
-     if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) THEN
+     IF ((debug.EQ.1).AND.(il.EQ.il_debug).AND.(Eqi(il).gt.0.)) THEN
          WRITE(*,*) 'stewart_explicit 526: cas h~1: rééq'
          WRITE(*,*) 'Eqi(il),deltaD=',Eqi(il), &
@@ -3000,10 +3000,10 @@
 &                   (Rb0(iso_hdo,il))),deltaD( &
 &                   (Rl0(iso_hdo,il)))
-     endif !if ((debug.eq.1).and.(il.eq.il_debug)) THEN
+     endif !if ((debug.EQ.1).AND.(il.EQ.il_debug)) THEN
 #endif
     ! end verifs
 
-else if ((f(il).gt.0.998).and. &
-&           (Eqi(il)*fac_ftmr(il).lt.1e-2*qp0(il))) then ! if ((h(il).gt.0.99).or. 
+ELSE IF ((f(il).gt.0.998).AND. &
+&           (Eqi(il)*fac_ftmr(il).lt.1e-2*qp0(il))) then ! if ((h(il).gt.0.99).OR.
 
 !*** cas particulier pour éviter imprécisions numériques:
@@ -3049,5 +3049,5 @@
 &           'stewart_explicite 397')
    enddo !do ixt=1,niso 
-   if (iso_eau.gt.0) THEN
+   IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite_choix( &
 &              (Pxtiinf(iso_eau,il)), &
@@ -3058,9 +3058,9 @@
 &              (Eqi(il)),'stewart_explicite 419', &
 &              errmax,errmaxrel)
-        if (iso_verif_egalite_choix_nostop( &
+        IF (iso_verif_egalite_choix_nostop( &
 &                (Exi(iso_eau,il)*fac_ftmr(il)), &
 &                (Eqi(il)*fac_ftmr(il)), &
 &                'stewart_expilicit 344', &
-&                errmax*10,errmaxrel*10).eq.1) THEN
+&                errmax*10,errmaxrel*10).EQ.1) THEN
           WRITE(*,*) 'Rl0,Rb0=',Rl0(iso_eau,il),Rb0(iso_eau,il)
           WRITE(*,*) 'Revap0=',Revap0(iso_eau,il)
@@ -3072,5 +3072,5 @@
           stop
         endif
-        if (Pqiinf(il).gt.ridicule) THEN
+        IF (Pqiinf(il).gt.ridicule) THEN
               CALL iso_verif_egalite_choix &
 &                 ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
@@ -3078,9 +3078,9 @@
 &                   errmax,errmaxrel)
         endif !if (Pqiinf.gt.ridicule) THEN
-        if (iso_verif_egalite_choix_nostop( &
+        IF (iso_verif_egalite_choix_nostop( &
 &                   (xtnew(iso_eau,il)), &
 &                   (qp0(il)+Eqi(il)*fac_ftmr(il)), &
 &                   'stewart_explicite 380',errmax*10,errmaxrel*50) &
-&                           .eq.1) THEN
+&                           .EQ.1) THEN
                 WRITE(*,*) 'xtnew=',xtnew(iso_eau,il)
                 WRITE(*,*) 'qp=',qp0(il)+Eqi(il)*fac_ftmr(il)
@@ -3095,15 +3095,15 @@
                 stop
         endif !if (iso_verif_egalite_choix_nostop(
-     endif    !if (iso_eau.gt.0).and.(ixt.eq.iso_eau)
-     if (iso_HDO.gt.0) THEN
-       if (Pqiinf(il).gt.ridicule_rain) THEN
+     endif    !if (iso_eau.gt.0).AND.(ixt.EQ.iso_eau)
+     IF (iso_HDO.gt.0) THEN
+       IF (Pqiinf(il).gt.ridicule_rain) THEN
          CALL iso_verif_aberrant( &
 &              (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
 &             'stewart_explicie 384')   
-       endif !(iso_HDO.gt.0).and.(ixt.eq.iso_HDO)
-       if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
-         if (iso_verif_aberrant_nostop(( &
+       endif !(iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO)
+       IF (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
+         IF (iso_verif_aberrant_nostop(( &
 &               xtnew(iso_HDO,il)/(qp0(il)+Eqi(il)*fac_ftmr(il))), &
-&              'stewart_explicite 603').eq.1) THEN
+&              'stewart_explicite 603').EQ.1) THEN
            WRITE(*,*) 'qp0(il),Eqi(il),fac_ftmr(il)=', &
 &                   qp0(il),Eqi(il),fac_ftmr(il)
@@ -3132,5 +3132,5 @@
        endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
      endif !!if ((iso_HDO.gt.0)
-     if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) THEN
+     IF ((debug.EQ.1).AND.(il.EQ.il_debug).AND.(Eqi(il).gt.0.)) THEN
          WRITE(*,*) 'stewart_explicit 663: cas où réévap faible'
          WRITE(*,*) 'ordre 1 pour la vapeur et le liquide'
@@ -3145,5 +3145,5 @@
 
   ! *** cas où pas d'air
-  if ((h(il).lt.1e-3).or.(qp0(il).lt.1e-8)) THEN
+  IF ((h(il).lt.1e-3).OR.(qp0(il).lt.1e-8)) THEN
 !              WRITE(*,*) 'stewart_explicit 349: cas pas d''air'
       !**** calcul de Rl
@@ -3179,5 +3179,5 @@
 &                   *(qp0(il)+Eqi(il)*fac_ftmr(il))
         enddo
-        if (fac_ftmr(il).gt.0.0) THEN
+        IF (fac_ftmr(il).gt.0.0) THEN
             do ixt=1,niso
                 Exi(ixt,il)=(xtnew(ixt,il)-xtp0(ixt,il)) &
@@ -3203,5 +3203,5 @@
 #endif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix( &
 &                   (Pxtiinf(iso_eau,il)), &
@@ -3216,17 +3216,17 @@
 &                  (Eqi(il)*fac_ftmr(il)), &
 &                  'stewart_expilicit 419',errmax*10,errmaxrel*10)
-            if (Pqiinf(il).gt.ridicule) THEN
+            IF (Pqiinf(il).gt.ridicule) THEN
               CALL iso_verif_egalite_choix &
 &                 ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
 &                 1.,'stewart_explicite 143',errmax,errmaxrel)
             endif !if (Pqiinf.gt.ridicule) THEN
-          endif !(iso_eau.gt.0).and.(ixt.eq.iso_eau)
-          if (iso_HDO.gt.0) THEN
-            if (Pqiinf(il).gt.ridicule_rain) THEN
+          endif !(iso_eau.gt.0).AND.(ixt.EQ.iso_eau)
+          IF (iso_HDO.gt.0) THEN
+            IF (Pqiinf(il).gt.ridicule_rain) THEN
               CALL iso_verif_aberrant( &
 &                  (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
 &                   'stewart_explicie 484')   
-            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
-            if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
+            endif !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO).AND.
+            IF (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
               CALL iso_verif_aberrant(( &
 &                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
@@ -3234,5 +3234,5 @@
              endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
           endif !if ((iso_HDO.gt.0)
-     if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) THEN
+     IF ((debug.EQ.1).AND.(il.EQ.il_debug).AND.(Eqi(il).gt.0.)) THEN
          WRITE(*,*) 'stewart_explicit 767: cas de réévap sèche'
          WRITE(*,*) 'distill de Rayleigh'
@@ -3243,6 +3243,6 @@
         ! end verifs
 
-    !else if (fac_ftmr(il).gt.1e18) THEN
-    else if (fac_ftmr(il).gt.1e24) THEN
+    !ELSE IF (fac_ftmr(il).gt.1e18) THEN
+    ELSE IF (fac_ftmr(il).gt.1e24) THEN
         ! *** cas où flux de masse nul
         do ixt=1,niso
@@ -3279,5 +3279,5 @@
 &                   'stewart_explicite 467')
     enddo !do ixt=1,niso    
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix( &
 &                  (Pxtiinf(iso_eau,il)), &
@@ -3288,9 +3288,9 @@
 &                  (Eqi(il)),'stewart_explicite 472', &
 &                   errmax,errmaxrel)
-            if (iso_verif_egalite_choix_nostop( &
+            IF (iso_verif_egalite_choix_nostop( &
 &                  (Exi(iso_eau,il)*fac_ftmr(il)), &
 &                  (Eqi(il)*fac_ftmr(il)), &
 &                  'stewart_expilicit 472b',errmax*10,errmaxrel*10) &
-&                  .eq.1) THEN
+&                  .EQ.1) THEN
                 WRITE(*,*) 'il=',il
                 WRITE(*,*) 'f,h=',f(il),h(il)
@@ -3302,17 +3302,17 @@
                 stop
             endif !if (iso_verif_egalite_choix_nostop(
-            if (Pqiinf(il).gt.ridicule) THEN
+            IF (Pqiinf(il).gt.ridicule) THEN
               CALL iso_verif_egalite_choix &
 &                  ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
 &                  1.,'stewart_explicite 143',errmax,errmaxrel)
             endif !if (Pqiinf.gt.ridicule) THEN
-          endif !(iso_eau.gt.0).and.(ixt.eq.iso_eau)
-          if (iso_HDO.gt.0) THEN
-            if (Pqiinf(il).gt.ridicule_rain) THEN
+          endif !(iso_eau.gt.0).AND.(ixt.EQ.iso_eau)
+          IF (iso_HDO.gt.0) THEN
+            IF (Pqiinf(il).gt.ridicule_rain) THEN
             CALL iso_verif_aberrant( &
 &                  (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
 &                   'stewart_explicie 484')   
-            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
-            if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
+            endif !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO).AND.
+            IF (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
              CALL iso_verif_aberrant(( &
 &                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
@@ -3320,5 +3320,5 @@
             endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
           endif !if (iso_HDO.gt.0)
-      if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) THEN
+      IF ((debug.EQ.1).AND.(il.EQ.il_debug).AND.(Eqi(il).gt.0.)) THEN
          WRITE(*,*) 'stewart_explicit 831: flux de masse vap~0'
          WRITE(*,*) 'Eqi(il),deltaD=',Eqi(il), &
@@ -3328,5 +3328,5 @@
         ! end verifs
 
-    else ! else if (fac_ftmr(il).gt.1e18) THEN
+    else ! ELSE IF (fac_ftmr(il).gt.1e18) THEN
     !**** cas général
 
@@ -3341,5 +3341,5 @@
     ! modif le 13 juin 2012: seuil 1e-2 -> 5e-2
     ! le 15 juin: on revient à 1e-2 car sinon, vapeur varie trop
-    if (Eqi(il)*fac_ftmr(il)/qp0(il).lt.1e-2) THEN
+    IF (Eqi(il)*fac_ftmr(il)/qp0(il).lt.1e-2) THEN
                 ! premier ordre pour la vapeur
                 ! cas ajouté le 7 dec 2011 car le cas général
@@ -3349,5 +3349,5 @@
             ! underflow exceptions quand f**beta fait dans les
             ! 1e-300.    
-       if (-h(il)/(1-h(il))*log(f(il)).gt.30.0) THEN
+       IF (-h(il)/(1-h(il))*log(f(il)).gt.30.0) THEN
         do ixt=1,niso
            Rl(ixt,il) = Rl0(ixt,il)*f(il)**beta(ixt,il) &
@@ -3368,5 +3368,5 @@
         xtnew(ixt,il)=Rb(ixt,il)*(qp0(il)+Eqi(il)*fac_ftmr(il)) 
         xtnew(ixt,il)=max(xtnew(ixt,il),0.0)              
-        if (fac_ftmr(il).gt.0.0) THEN
+        IF (fac_ftmr(il).gt.0.0) THEN
          Exi(ixt,il)=(xtnew(ixt,il)-xtp0(ixt,il))/fac_ftmr(il)
         else
@@ -3388,5 +3388,5 @@
 #endif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix( &
 &                   (Pxtiinf(iso_eau,il)), &
@@ -3401,21 +3401,21 @@
 &                  (Eqi(il)*fac_ftmr(il)), &
 &                  'stewart_expilicit 931',errmax*10,errmaxrel*10)
-            if (Pqiinf(il).gt.ridicule) THEN
+            IF (Pqiinf(il).gt.ridicule) THEN
               CALL iso_verif_egalite_choix &
 &                 ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
 &                 1.,'stewart_explicite 935',errmax,errmaxrel)
             endif !if (Pqiinf.gt.ridicule) THEN
-          endif !(iso_eau.gt.0).and.(ixt.eq.iso_eau)
-          if (iso_HDO.gt.0) THEN
-            if (Pqiinf(il).gt.ridicule_rain) THEN
+          endif !(iso_eau.gt.0).AND.(ixt.EQ.iso_eau)
+          IF (iso_HDO.gt.0) THEN
+            IF (Pqiinf(il).gt.ridicule_rain) THEN
               CALL iso_verif_aberrant( &
 &                  (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
 &                   'stewart_explicie 484')   
-            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
-            if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
-                if (iso_verif_aberrant_nostop(( &
+            endif !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO).AND.
+            IF (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
+                IF (iso_verif_aberrant_nostop(( &
 &                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
 &                   *fac_ftmr(il))),'stewart_explicite 947') &
-&                   .eq.1) THEN
+&                   .EQ.1) THEN
                    WRITE(*,*) 'Eqi(il)*fac_ftmr(il)/qp0(il)=', &
 &                          Eqi(il)*fac_ftmr(il)/qp0(il) 
@@ -3447,19 +3447,19 @@
              endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
           endif !if ((iso_HDO.gt.0)
-          if ((iso_O17.gt.0).and.(iso_O18.gt.0).and. &
+          IF ((iso_O17.gt.0).AND.(iso_O18.gt.0).AND. &
 &               (O17_verif)) THEN
-             if (Pqiinf(il).gt.ridicule_rain) THEN
+             IF (Pqiinf(il).gt.ridicule_rain) THEN
               CALL iso_verif_aberrant_o17( &
 &                  (Pxtiinf(iso_O17,il)/Pqiinf(il)), &
 &                  (Pxtiinf(iso_O18,il)/Pqiinf(il)), &
 &                  'stewart_explicie 955')   
-            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
-          endif  ! if ((iso_O17.gt.0).and.(iso_O18.gt.0).and.
-     if ((debug.eq.1).and.(il.eq.il_debug)) THEN
+            endif !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO).AND.
+          endif  ! if ((iso_O17.gt.0).AND.(iso_O18.gt.0).AND.
+     IF ((debug.EQ.1).AND.(il.EQ.il_debug)) THEN
         WRITE(*,*) 'stewart_explicit 951: 1er ordre pour la vap'
-     endif !if ((debug.eq.1).and.(il.eq.il_debug)) THEN
+     endif !if ((debug.EQ.1).AND.(il.EQ.il_debug)) THEN
 #endif              
 
-    else if ((A(il)*m0(il)/qp0(il).gt.10.0).and. &
+    ELSE IF ((A(il)*m0(il)/qp0(il).gt.10.0).AND. &
 &                (1.0-f(il).lt.1e-5)) THEN
         ! beaucoup de liquide se réévaporant très peu dans un
@@ -3485,5 +3485,5 @@
           Pxtiinf(ixt,il)=max(Pxtiinf(ixt,il),0.0)
           xtnew(ixt,il)=max(xtnew(ixt,il),0.0)          
-          if (fac_ftmr(il).gt.0.0) THEN
+          IF (fac_ftmr(il).gt.0.0) THEN
              Exi(ixt,il)=(xtnew(ixt,il) &
 &                 -xtp0(ixt,il))/fac_ftmr(il)
@@ -3505,5 +3505,5 @@
 #endif
 #ifdef ISOVERIF   
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix( &
 &                   (Pxtiinf(iso_eau,il)), &
@@ -3518,21 +3518,21 @@
 &                  (Eqi(il)*fac_ftmr(il)), &
 &                  'stewart_expilicit 1111',errmax*10,errmaxrel*10)
-            if (Pqiinf(il).gt.ridicule) THEN
+            IF (Pqiinf(il).gt.ridicule) THEN
               CALL iso_verif_egalite_choix &
 &                 ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
 &                 1.,'stewart_explicite 1115',errmax,errmaxrel)
             endif !if (Pqiinf.gt.ridicule) THEN
-          endif !(iso_eau.gt.0).and.(ixt.eq.iso_eau)
-          if (iso_HDO.gt.0) THEN
-            if (Pqiinf(il).gt.ridicule_rain) THEN
+          endif !(iso_eau.gt.0).AND.(ixt.EQ.iso_eau)
+          IF (iso_HDO.gt.0) THEN
+            IF (Pqiinf(il).gt.ridicule_rain) THEN
               CALL iso_verif_aberrant( &
 &                  (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
 &                   'stewart_explicie 1122')   
-            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
-            if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
-                if (iso_verif_aberrant_nostop(( &
+            endif !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO).AND.
+            IF (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
+                IF (iso_verif_aberrant_nostop(( &
 &                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
 &                   *fac_ftmr(il))),'stewart_explicite 1127') &
-&                   .eq.1) THEN
+&                   .EQ.1) THEN
                    WRITE(*,*) 'Eqi(il)*fac_ftmr(il)/qp0(il)=', &
 &                          Eqi(il)*fac_ftmr(il)/qp0(il) 
@@ -3556,16 +3556,16 @@
              endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
           endif !if ((iso_HDO.gt.0)
-          if ((iso_O17.gt.0).and.(iso_O18.gt.0).and. &
+          IF ((iso_O17.gt.0).AND.(iso_O18.gt.0).AND. &
 &               (O17_verif)) THEN
-             if (Pqiinf(il).gt.ridicule_rain) THEN
+             IF (Pqiinf(il).gt.ridicule_rain) THEN
               CALL iso_verif_aberrant_o17( &
 &                  (Pxtiinf(iso_O17,il)/Pqiinf(il)), &
 &                  (Pxtiinf(iso_O18,il)/Pqiinf(il)), &
 &                  'stewart_explicite 1156')   
-            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
-          endif  ! if ((iso_O17.gt.0).and.(iso_O18.gt.0).and.
-     if ((debug.eq.1).and.(il.eq.il_debug)) THEN
+            endif !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO).AND.
+          endif  ! if ((iso_O17.gt.0).AND.(iso_O18.gt.0).AND.
+     IF ((debug.EQ.1).AND.(il.EQ.il_debug)) THEN
       WRITE(*,*) 'stewart_explicit 1160: 1er ordre pour le liq'
-     endif !if ((debug.eq.1).and.(il.eq.il_debug)) THEN
+     endif !if ((debug.EQ.1).AND.(il.EQ.il_debug)) THEN
 #endif              
 
@@ -3580,6 +3580,6 @@
 #endif            
 
-!            if ((allow_ordre1v).and.
-!     :           (Eqi(il)*fac_ftmr(il).lt.1e-2*qp0(il)).and.
+!            if ((allow_ordre1v).AND.
+!     :           (Eqi(il)*fac_ftmr(il).lt.1e-2*qp0(il)).AND.
 !     :            (h.lt.0.97)) THEN
 !               ! peu d'apport d'évap dans la vapeur, et peu diffusf ->
@@ -3594,10 +3594,10 @@
     ! traite à part.
     r_l0qp0(il)=A(il)*m0(il)/qp0(il)            
-!            if (  ((f.lt.0.005).and.(h.gt.0.5)) ! orig: beta.gt.7
-!     :           .or.((f.lt.0.01).and.(h.gt.0.85)) ! orig: beta.gt.8
-!     :           .or.((f.lt.0.1).and.(h.gt.0.9))
-!     :           .or.((f.lt.0.15).and.(h.gt.0.95))            
-!     :           .or.((f.lt.0.2).and.(h.gt.0.98))) THEN
-    if ((h(il).gt.0.5).and.(f(il).lt.0.2).and. &
+!            if (  ((f.lt.0.005).AND.(h.gt.0.5)) ! orig: beta.gt.7
+!     :           .OR.((f.lt.0.01).AND.(h.gt.0.85)) ! orig: beta.gt.8
+!     :           .OR.((f.lt.0.1).AND.(h.gt.0.9))
+!     :           .OR.((f.lt.0.15).AND.(h.gt.0.95))
+!     :           .OR.((f.lt.0.2).AND.(h.gt.0.98))) THEN
+    IF ((h(il).gt.0.5).AND.(f(il).lt.0.2).AND. &
 &           (f(il).lt.0.005+3*(h(il)-0.5)**4)) THEN
         ! la fonction flimite(h(il))=0.005+3*(h(il)-0.5)**4 est
@@ -3619,5 +3619,5 @@
        xtnew(ixt,il)=max(xtnew(ixt,il),0.0)
       
-       if (fac_ftmr(il).gt.0.0) THEN
+       IF (fac_ftmr(il).gt.0.0) THEN
          Exi(ixt,il)=(xtnew(ixt,il)-xtp0(ixt,il))/fac_ftmr(il)
        else
@@ -3642,5 +3642,5 @@
 #endif
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
          CALL iso_verif_egalite_choix( &
 &            (Rl(iso_eau,il)), &
@@ -3660,8 +3660,8 @@
 &            'stewart_explicite 594', &
 &            errmax*50,errmaxrel*10)
-         if (iso_verif_egalite_choix_nostop( &
+         IF (iso_verif_egalite_choix_nostop( &
 &            (Exi(iso_eau,il)), &
 &            (Eqi(il)),'stewart_explicite 595', &
-&            errmax*50,errmaxrel*10).eq.1) THEN
+&            errmax*50,errmaxrel*10).EQ.1) THEN
            WRITE(*,*) 'il,fac_ftmr(il)=',il,fac_ftmr(il)
            WRITE(*,*) 'xtnew(iso_eau,il),qp(il)=', &
@@ -3674,13 +3674,13 @@
            stop
          endif
-         if (iso_verif_egalite_choix_nostop( &
+         IF (iso_verif_egalite_choix_nostop( &
 &            (Exi(iso_eau,il)*fac_ftmr(il)), &
 &            (Eqi(il)*fac_ftmr(il)), &
 &            'stewart_expilicit 521',errmax*10,errmaxrel*10) &
-&            .eq.1) THEN
+&            .EQ.1) THEN
            WRITE(*,*) 'il=',il
            stop
          endif !if (iso_verif_egalite_choix_nostop
-         if (Pqiinf(il).gt.ridicule) THEN
+         IF (Pqiinf(il).gt.ridicule) THEN
            CALL iso_verif_egalite_choix &
 &                ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
@@ -3690,9 +3690,9 @@
         !Pxtiinf=Pqiinf
         !Exi=Eqi
-        if (iso_verif_egalite_choix_nostop( &
+        IF (iso_verif_egalite_choix_nostop( &
 &                   (xtnew(iso_eau,il)), &
 &                   (qp0(il)+Eqi(il)*fac_ftmr(il)), &
 &                   'stewart_explicite 605',errmax*10,errmaxrel*50) &
-&                           .eq.1) THEN
+&                           .EQ.1) THEN
                 WRITE(*,*) 'xtnew=',xtnew(iso_eau,il)
                 WRITE(*,*) 'qp=',qp0(il)+Eqi(il)*fac_ftmr(il)
@@ -3707,10 +3707,10 @@
        ! pour meilleure convergence numérique:
        !xtnew=qp0+Eqi*fac_ftmr
-   endif   ! if (iso_eau.gt.0).and.(ixt.eq.iso_eau)  
-   if (iso_HDO.gt.0) THEN
-     if (Pqiinf(il).gt.ridicule_rain) THEN
-        if (iso_verif_aberrant_nostop( &
+   endif   ! if (iso_eau.gt.0).AND.(ixt.EQ.iso_eau)
+   IF (iso_HDO.gt.0) THEN
+     IF (Pqiinf(il).gt.ridicule_rain) THEN
+        IF (iso_verif_aberrant_nostop( &
 &                  (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
-&                   'stewart_explicie 675').eq.1) THEN
+&                   'stewart_explicie 675').EQ.1) THEN
           WRITE(*,*) 'cas général f petit: il=',il
           WRITE(*,*) 'Rl,deltaDRl=',Rl(iso_HDO,il), &
@@ -3730,10 +3730,10 @@
         endif   !if iso_verif_aberrant_nostop(
        endif !if (Pqiinf(il).gt.ridicule_rain) THEN
-       if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
+       IF (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
              CALL iso_verif_aberrant(( &
 &                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
 &                   *fac_ftmr(il))),'stewart_explicite 912')
        endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
-       if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) THEN
+       IF ((debug.EQ.1).AND.(il.EQ.il_debug).AND.(Eqi(il).gt.0.)) THEN
          WRITE(*,*) 'stewart_explicit 991: fcas général'
          WRITE(*,*) 'mais avec formule simplifiée'
@@ -3745,5 +3745,5 @@
   ! end verifs  
     
-else if (abs((g(il)**((1-2*h(il))/(1-h(il))))-1.0).lt.1e-2) THEN
+ELSE IF (abs((g(il)**((1-2*h(il))/(1-h(il))))-1.0).lt.1e-2) THEN
         ! dans ce cas, le premier facteur de func (la fonction a
         ! intégrer) est environ constant et égal à 1. on a alors
@@ -3770,11 +3770,11 @@
         trace(il)=2533
 #endif                
-  endif !if ((g**(1-beta*gama))-1.0.lt.errmaxrel*10) THEN
+  ENDIF !if ((g**(1-beta*gama))-1.0.lt.errmaxrel*10) THEN
   ! end verifs
 END IF !if (Eqi(il)*fac_ftmr(il)/qp0(il).lt.5e-2) THEN
-END IF !if ((h.lt.1e-3).or.(qp0.lt.1e-8)) THEN
+END IF !if ((h.lt.1e-3).OR.(qp0.lt.1e-8)) THEN
 END IF !if (h(il).gt.0.99) THEN
-END IF !if ((f(il).lt.1e-9).or.(Pqiinf(il).lt.ridicule/10.)) THEN
-END IF !!if ((Eqi(il)*fac_ftmr(il).lt.ridicule).and.(h(il).lt.0.99)) THEN
+END IF !if ((f(il).lt.1e-9).OR.(Pqiinf(il).lt.ridicule/10.)) THEN
+END IF !!if ((Eqi(il)*fac_ftmr(il).lt.ridicule).AND.(h(il).lt.0.99)) THEN
 END IF ! Pqisup.le.0
 END DO ! do il=1,ncas
@@ -3841,14 +3841,14 @@
 &           (Pqiinf(cas_rieman(icas_Jsimple))), &
 &           'stewart_explicit 918',errmax,errmaxrel)
-  if (iso_verif_egalite_choix_nostop( &
+  IF (iso_verif_egalite_choix_nostop( &
 &        (f_cas(icas_Jsimple+ncas_Jsimple)), &
 &        (m_cas(icas_Jsimple+ncas_Jsimple) &
 &        /m0_cas(icas_Jsimple+ncas_Jsimple)), &
 &       'stewart_explicite_vectall 953b apres compression', &
-&        errmax,errmaxrel).eq.1) THEN
+&        errmax,errmaxrel).EQ.1) THEN
       WRITE(*,*) 'icas_Jsimple,cas_rieman(icas_Jsimple)=', &
 &           icas_Jsimple,cas_rieman(icas_Jsimple)
       stop
-  endif
+  ENDIF
 END DO !do icas_Jsimple=1,ncas_Jsimple
 #endif        
@@ -3890,5 +3890,5 @@
 &       g_cas(icas_rieman))      
 
-  endif !if (ncas_rieman.gt.0) THEN
+  ENDIF !if (ncas_rieman.gt.0) THEN
 ! ******* traitement vectoriel commun du cas Rieman et Jsimple           
 #ifdef ISOVERIF
@@ -3921,5 +3921,5 @@
     xtnew_cas(ixt,il)=max(xtnew_cas(ixt,il),0.0)
     
-    if ((fac_ftmr_cas(il).gt.0.0).and. &
+    IF ((fac_ftmr_cas(il).gt.0.0).AND. &
 &           (Pqiinf_cas(il).gt.(Eqi_cas(il)+qp0_cas(il) &
 &                   /fac_ftmr_cas(il)))) THEN
@@ -3936,10 +3936,10 @@
 #ifdef ISOVERIF
     do ixt=1,niso
-      if ((iso_verif_noNaN_nostop(Exi_cas(ixt,il), &
-&           'stewart_explicite 1345').eq.1).or. &
+      IF ((iso_verif_noNaN_nostop(Exi_cas(ixt,il), &
+&           'stewart_explicite 1345').EQ.1).OR. &
 &           (iso_verif_noNaN_nostop(Pxtiinf_cas(ixt,il), &
-&           'stewart_explicite 1348').eq.1).or. &
+&           'stewart_explicite 1348').EQ.1).OR. &
 &           (iso_verif_noNaN_nostop(xtnew_cas(ixt,il), &
-&           'stewart_explicite 1348b').eq.1)) THEN
+&           'stewart_explicite 1348b').EQ.1)) THEN
        WRITE(*,*) 'ixt,ncas_Jsimple,il=',ixt,ncas_Jsimple,il
        WRITE(*,*) 'Exi_cas(ixt,il)=',Exi_cas(ixt,il)
@@ -3974,11 +3974,11 @@
 #endif
 #ifdef ISOVERIF         
-    if (iso_eau.gt.0) THEN
-      if (iso_verif_egalite_choix_nostop( &
+    IF (iso_eau.gt.0) THEN
+      IF (iso_verif_egalite_choix_nostop( &
 &           (Pxtiinf_cas(iso_eau,il)), &
 &           (Pqiinf_cas(il)),'stewart_explicite 451', &
-&           errmax*50,errmaxrel*50).eq.1) THEN
+&           errmax*50,errmaxrel*50).EQ.1) THEN
          WRITE(*,*) 'il=',il
-         if (il.le.ncas_Jsimple) THEN
+         IF (il.le.ncas_Jsimple) THEN
             WRITE(*,*) 'cas_Jsimple(il)=',cas_Jsimple(il)
          else !if (il.le.ncas_Jsimple) THEN
@@ -3995,5 +3995,5 @@
          WRITE(*,*) 'gama=',gama_cas(iso_eau,il), &
 &                   ' beta=',beta_cas(iso_eau,il)
-         if (il.le.ncas_Jsimple) THEN
+         IF (il.le.ncas_Jsimple) THEN
            WRITE(*,*) 'h=',h(cas_Jsimple(il)), &
 &                   ' Tevap=',Tevap(cas_Jsimple(il))
@@ -4029,11 +4029,11 @@
          stop   
        endif !if (iso_verif_egalite_choix_nostop(
-       if (iso_verif_egalite_choix_nostop( &
+       IF (iso_verif_egalite_choix_nostop( &
 &           (xtnew_cas(iso_eau,il)), &
 &           (qp0_cas(il)+Eqi_cas(il) &
 &           *fac_ftmr_cas(il)),'stewart_explicite 1026', &
-&           errmax*50,errmaxrel*50).eq.1) THEN
+&           errmax*50,errmaxrel*50).EQ.1) THEN
          WRITE(*,*) 'il=',il
-         if (il.le.ncas_Jsimple) THEN
+         IF (il.le.ncas_Jsimple) THEN
             WRITE(*,*) 'cas_Jsimple(il)=',cas_Jsimple(il)
          else !if (il.le.ncas_Jsimple) THEN
@@ -4050,5 +4050,5 @@
          WRITE(*,*) 'gama=',gama_cas(iso_eau,il), &
 &                   ' beta=',beta_cas(iso_eau,il)
-         if (il.le.ncas_Jsimple) THEN
+         IF (il.le.ncas_Jsimple) THEN
            WRITE(*,*) 'h=',h(cas_Jsimple(il)), &
 &                   ' Tevap=',Tevap(cas_Jsimple(il))
@@ -4077,15 +4077,15 @@
          stop   
        endif !if (iso_verif_egalite_choix_nostop(
-       if ((iso_verif_egalite_choix_nostop( &
+       IF ((iso_verif_egalite_choix_nostop( &
 &            (Exi_cas(iso_eau,il)), &
 &            (Eqi_cas(il)),'stewart_explicite 777', &
-&            errmax*800,errmaxrel*800).eq.1).or. &
+&            errmax*800,errmaxrel*800).EQ.1).OR. &
 &            (iso_verif_egalite_choix_nostop( &
 &            (Exi_cas(iso_eau,il)*fac_ftmr_cas(il)), &
 &            (Eqi_cas(il)*fac_ftmr_cas(il)), &
 &           'stewart_explicite 586', &
-&            errmax*3000,errmaxrel*800).eq.1)) THEN
+&            errmax*3000,errmaxrel*800).EQ.1)) THEN
           WRITE(*,*) 'il=',il
-         if (il.le.ncas_Jsimple) THEN
+         IF (il.le.ncas_Jsimple) THEN
             WRITE(*,*) 'cas_Jsimple(il)=',cas_Jsimple(il)
          else !if (il.le.ncas_Jsimple) THEN
@@ -4101,11 +4101,11 @@
      endif
     endif  !if (iso_eau.gt.0) THEN
-    if (iso_HDO.gt.0) THEN
-       if (qp0_cas(il)+Eqi_cas(il)*fac_ftmr_cas(il) &
+    IF (iso_HDO.gt.0) THEN
+       IF (qp0_cas(il)+Eqi_cas(il)*fac_ftmr_cas(il) &
 &                   .gt.ridicule) THEN
-         if (iso_verif_aberrant_nostop(( &
+         IF (iso_verif_aberrant_nostop(( &
 &                xtnew_cas(iso_HDO,il)/(qp0_cas(il)+Eqi_cas(il) &
 &                *fac_ftmr_cas(il))), &
-&                'stewart_explicite 1316').eq.1) THEN
+&                'stewart_explicite 1316').EQ.1) THEN
            WRITE(*,*) 'il,fac_ftmr_cas(il)=',il,fac_ftmr_cas(il)
            WRITE(*,*) 'h(il)=',h(il)
@@ -4178,5 +4178,5 @@
 #ifdef ISOVERIF
  do icas_Jsimple=1,ncas_Jsimple+ncas_rieman    
-   if (icas_Jsimple.le.ncas_Jsimple) THEN
+   IF (icas_Jsimple.le.ncas_Jsimple) THEN
      il=cas_Jsimple(icas_Jsimple)
    else
@@ -4184,10 +4184,10 @@
    endif
    do ixt=1,niso
-    if ((iso_verif_noNaN_nostop((Pxtiinf(ixt,il)), &
-&         'stewart_explicite 618').eq.1).or. &
+    IF ((iso_verif_noNaN_nostop((Pxtiinf(ixt,il)), &
+&         'stewart_explicite 618').EQ.1).OR. &
 &         (iso_verif_noNaN_nostop((Exi(ixt,il)), &
-&         'stewart_explicite 620').eq.1).or. &
+&         'stewart_explicite 620').EQ.1).OR. &
 &         (iso_verif_noNaN_nostop((xtnew(ixt,il)), &
-&         'stewart_explicite 622').eq.1)) THEN
+&         'stewart_explicite 622').EQ.1)) THEN
        WRITE(*,*) 'ixt,il=',ixt,il
        WRITE(*,*) 'icas_Jsimple,ncas_Jsimple=', &
@@ -4200,14 +4200,14 @@
 #ifdef ISOVERIF
  do icas_Jsimple=1,ncas_Jsimple+ncas_rieman    
-   if (icas_Jsimple.le.ncas_Jsimple) THEN
+   IF (icas_Jsimple.le.ncas_Jsimple) THEN
      il=cas_Jsimple(icas_Jsimple)
    else
      il=cas_rieman(icas_Jsimple-ncas_Jsimple)
    endif           
-   if (iso_eau.gt.0) THEN
-       if (iso_verif_egalite_choix_nostop( &
+   IF (iso_eau.gt.0) THEN
+       IF (iso_verif_egalite_choix_nostop( &
 &           (Pxtiinf(iso_eau,il)), &
 &           (Pqiinf(il)),'stewart_explicite 1105', &
-&           errmax*50,errmaxrel*50).eq.1) THEN
+&           errmax*50,errmaxrel*50).EQ.1) THEN
           WRITE(*,*) 'icas_Jsimple,il,trace(il)=', &
 &                    icas_Jsimple,il,trace(il) 
@@ -4219,13 +4219,13 @@
      endif
      !Pxtiinf=Pqiinf
-     if ((iso_verif_egalite_choix_nostop( &
+     IF ((iso_verif_egalite_choix_nostop( &
 &            (Exi(iso_eau,il)), &
 &            (Eqi(il)),'stewart_explicite 778', &
-&            errmax*800,errmaxrel*800).eq.1).or. &
+&            errmax*800,errmaxrel*800).EQ.1).OR. &
 &            (iso_verif_egalite_choix_nostop( &
 &            (Exi(iso_eau,il)*fac_ftmr(il)), &
 &            (Eqi(il)*fac_ftmr(il)), &
 &           'stewart_explicite 587', &
-&            errmax*3000,errmaxrel*800).eq.1)) THEN
+&            errmax*3000,errmaxrel*800).EQ.1)) THEN
           WRITE(*,*) 'il,icas_Jsimple=',il,icas_Jsimple
           WRITE(*,*) 'g**(1-beta*gama)=', &
@@ -4237,9 +4237,9 @@
 
      ! le 6 dec 2011: on relache ridicule en ridicule*2
-     if (Pqiinf(il).gt.ridicule*2) THEN
-       if (iso_verif_egalite_choix_nostop &
+     IF (Pqiinf(il).gt.ridicule*2) THEN
+       IF (iso_verif_egalite_choix_nostop &
 &           ((Pxtiinf(iso_eau,il)/Pqiinf(il)),1., &
 &           'stewart_explicite 716', &
-&            errmax*10,errmaxrel*50).eq.1) THEN
+&            errmax*10,errmaxrel*50).EQ.1) THEN
          WRITE(*,*) 'il=',il
          WRITE(*,*) 'Pqiinf,Pxtiinf=', &
@@ -4253,9 +4253,9 @@
        endif !if (iso_verif_egalite_choix_nostop
      endif !if (Pqiinf.gt.ridicule) THEN
-     if (iso_verif_egalite_choix_nostop( &
+     IF (iso_verif_egalite_choix_nostop( &
 &                   (xtnew(iso_eau,il)), &
 &                   (qp0(il)+Eqi(il)*fac_ftmr(il)), &
 &                   'stewart_explicite 732',errmax*10,errmaxrel*50) &
-&                           .eq.1) THEN
+&                           .EQ.1) THEN
                 WRITE(*,*) 'icas_Jsimple,il,trace(il)=', &
 &                    icas_Jsimple,il,trace(il) 
@@ -4276,5 +4276,5 @@
      endif
      ! pour meilleure convergence numérique:
-     if (bidouille_anti_divergence) THEN
+     IF (bidouille_anti_divergence) THEN
          Exi(iso_eau,il)=Eqi(il)
          xtnew(iso_eau,il)=qp0(il)+Eqi(il)*fac_ftmr(il)
@@ -4282,10 +4282,10 @@
      endif   
 
-   endif   ! if if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) the       
-
-   if (iso_HDO.gt.0) THEN
-    if (Pqiinf(il).gt.ridicule_rain) THEN
-      if (iso_verif_aberrant_choix_nostop(Pxtiinf(iso_HDO,il),Pqiinf(il),ridicule_rain,deltalim_snow, &
-&                   'stewart_explicite 871').eq.1)  THEN
+   endif   ! if if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) the
+
+   IF (iso_HDO.gt.0) THEN
+    IF (Pqiinf(il).gt.ridicule_rain) THEN
+      IF (iso_verif_aberrant_choix_nostop(Pxtiinf(iso_HDO,il),Pqiinf(il),ridicule_rain,deltalim_snow, &
+&                   'stewart_explicite 871').EQ.1)  THEN
       WRITE(*,*) 'deltaDl0=',deltaD( &
 &           (Rl0(iso_HDO,il)))
@@ -4295,5 +4295,5 @@
       endif  !if (iso_verif_aberrant_nostop(
      endif !if (Pqiinf(il).gt.ridicule_rain) THEN
-     if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
+     IF (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
          CALL iso_verif_aberrant(( &
 &               xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
@@ -4302,9 +4302,9 @@
     endif !if (iso_HDO.gt.0)
 
-    if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) THEN
+    IF ((debug.EQ.1).AND.(il.EQ.il_debug).AND.(Eqi(il).gt.0.)) THEN
           WRITE(*,*) 'stewart_explicit 1558: cas avec calcul J'
           WRITE(*,*) 'Eqi(il),deltaD=',Eqi(il), &
 &                   deltaD((Exi(iso_HDO,il)/Eqi(il)))
-          if (icas_Jsimple.le.ncas_Jsimple) THEN
+          IF (icas_Jsimple.le.ncas_Jsimple) THEN
                WRITE(*,*) 'calcul J par simple'
           else
@@ -4345,5 +4345,5 @@
           WRITE(*,*) 'fac_ftmr_cas(icas)=', &
 &                   fac_ftmr_cas(icas_Jsimple)
-    endif !if ((debug.eq.1).and.(il.eq.il_debug)) THEN
+    endif !if ((debug.EQ.1).AND.(il.EQ.il_debug)) THEN
     enddo !do il=1,ncas_Jsimple+ncas_rieman    
 #endif  
@@ -4374,21 +4374,21 @@
   ! declaration des variables      
 ! **inputs
-integer ncas
-real q(ncas),xt(niso,ncas)
-real Pxtisup(niso,ncas)
-real Pqisup(ncas)
-real Eqi(ncas),Pqiinf(ncas)
-real fac_ftmr(ncas)       
-real Tevap(ncas)    
+INTEGER ncas
+REAL q(ncas),xt(niso,ncas)
+REAL Pxtisup(niso,ncas)
+REAL Pqisup(ncas)
+REAL Eqi(ncas),Pqiinf(ncas)
+REAL fac_ftmr(ncas)
+REAL Tevap(ncas)
 
        ! **outputs
-real xtnew(niso,ncas)
-real Pxtiinf(niso,ncas)
-real Exi(niso,ncas)
+REAL xtnew(niso,ncas)
+REAL Pxtiinf(niso,ncas)
+REAL Exi(niso,ncas)
 
 ! **locals
-real zxtalphai(niso,ncas)
-real f(ncas)
-integer ixt,il        
+REAL zxtalphai(niso,ncas)
+REAL f(ncas)
+INTEGER ixt,il
 
 !        WRITE(*,*) 'sttewart_glace 39: entrée'
@@ -4401,10 +4401,10 @@
 &           (Pqisup(il)-Eqi(il)-Pqiinf(il)),0.0, &
 &           'stewart_glace 37')
-  if (iso_eau.gt.0) THEN
+  IF (iso_eau.gt.0) THEN
       CALL iso_verif_egalite((Pqisup(il)), &
 &           (Pxtisup(iso_eau,il)),'stewart_loop 52')
       CALL iso_verif_egalite((xt(iso_eau,il)), &
 &           (q(il)),'stewart_loop 58')
-  endif !if  ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+  ENDIF !if  ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
 END DO !do il=1,ncas
 #endif
@@ -4414,10 +4414,10 @@
 DO il=1,ncas
 ! traitement rapide de quelques cas particuliers:
-IF (Pqisup(il).eq.0) THEN
+IF (Pqisup(il).EQ.0) THEN
     ! pas de pluie, pas de Pqiinf, pas de changement de vap
     ! cam verif
 #ifdef ISOVERIF
-    if ((abs(Pqiinf(il)).gt.ridicule) &
-&            .or.(abs(Eqi(il)).gt.ridicule)) THEN
+    IF ((abs(Pqiinf(il)).gt.ridicule) &
+&            .OR.(abs(Eqi(il)).gt.ridicule)) THEN
         WRITE(*,*) 'stewart_loop 39'
         WRITE(*,*) 'Pqisup=',Pqisup(il)
@@ -4433,5 +4433,5 @@
       Exi(ixt,il)=0.0
     enddo !do ixt=1,niso
-else !if (Pqisup(il).eq.0) THEN
+else !if (Pqisup(il).EQ.0) THEN
 ! calcul du coeff de fractionnement
 DO ixt=1,niso
@@ -4465,17 +4465,17 @@
 &           'stewart_glace 111')
  enddo !do ixt=1,niso   
- if (iso_eau.gt.0) THEN
+ IF (iso_eau.gt.0) THEN
    CALL iso_verif_egalite((Exi(iso_eau,il)), &
 &                   (Eqi(il)),'stewart_glace 101')
    CALL iso_verif_egalite((Pxtiinf(iso_eau,il)), &
 &           (Pqiinf(il)),'stewart_glace 110')
- endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-#endif
-IF ((bidouille_anti_divergence).and. &
+ END IF !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+#endif
+IF ((bidouille_anti_divergence).AND. &
 &            (iso_eau.gt.0)) THEN
   ! assurer la convergence numérique pour ixt=4:
   Exi(iso_eau,il)=Eqi(il)
   Pxtiinf(iso_eau,il)=Pqiinf(il)
- endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)
+ END IF !if ((bidouille_anti_divergence).AND.(iso_eau.gt.0)
   
 
@@ -4492,12 +4492,12 @@
 &           'stewart_glace 140')
 END DO !do ixt=1,niso
-  if ((iso_HDO.gt.0).and. &
+  IF ((iso_HDO.gt.0).AND. &
 &            (Pqisup(il).gt.ridicule_rain)) THEN
     CALL iso_verif_aberrant(( &
 &           Pxtiinf(iso_HDO,il)/Pqiinf(il)),'stewart_glace 175')  
-  endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) THEN
+  ENDIF !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO)) THEN
 #endif
 ! end verif
-END IF !if (Pqisup(il).eq.0) THEN
+END IF !if (Pqisup(il).EQ.0) THEN
 END DO !do il=1,ncas
 
@@ -4529,22 +4529,22 @@
   ! declaration des variables      
 ! **inputs
-integer ncas
-real q(ncas),xt(niso,ncas)
-real Pxtisup(niso,ncas)
-real Pqisup(ncas)
-real Eqi(ncas),Pqiinf(ncas)
-real fac_ftmr(ncas)      
+INTEGER ncas
+REAL q(ncas),xt(niso,ncas)
+REAL Pxtisup(niso,ncas)
+REAL Pqisup(ncas)
+REAL Eqi(ncas),Pqiinf(ncas)
+REAL fac_ftmr(ncas)
 
        ! **outputs
-real xtnew(niso,ncas)
-real Pxtiinf(niso,ncas)
-real Exi(niso,ncas)
+REAL xtnew(niso,ncas)
+REAL Pxtiinf(niso,ncas)
+REAL Exi(niso,ncas)
 
 ! **locals
-integer il
+INTEGER il
 !real  ! debuggage
-real Rb0(niso,ncas)
-real real_to_double
-integer ixt
+REAL Rb0(niso,ncas)
+REAL real_to_double
+INTEGER ixt
 !#ifdef ISOVERIF
 !integer iso_verif_egalite_nostop
@@ -4559,5 +4559,5 @@
 IF (iso_verif_egalite_nostop(( &
 &           Pqisup(il)-Eqi(il)-Pqiinf(il)),0.0, &
-&           'stewart_sublim_nofrac 37').eq.1) THEN
+&           'stewart_sublim_nofrac 37').EQ.1) THEN
   WRITE(*,*) 'il,Pqisup(il),Eqi(il),Pqiinf(il)=', &
 &          il,Pqisup(il),Eqi(il),Pqiinf(il)         
@@ -4571,9 +4571,9 @@
 &           (q(il)), &
 &           'stewart_sublim_nofrac 39')              
-END IF !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+END IF !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
 IF (iso_HDO.gt.0) then ! Camille 9 mars 2023: moins stricte pour condensat
     CALL iso_verif_aberrant_choix(Pxtisup(iso_HDO,il),Pqisup(il), &
 &           ridicule_rain,deltalim_snow, 'stewart_sublim_nofrac 40') 
-END IF !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
+END IF !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO).AND.
 END DO !do il=1,ncas
 #endif
@@ -4588,6 +4588,6 @@
     ! cam verif
 #ifdef ISOVERIF
-     if ((abs(Pqiinf(il)).gt.ridicule) &
-&            .or.(abs(Eqi(il)).gt.ridicule)) THEN
+     IF ((abs(Pqiinf(il)).gt.ridicule) &
+&            .OR.(abs(Eqi(il)).gt.ridicule)) THEN
         WRITE(*,*) 'stewart_sublim 57'
         WRITE(*,*) 'Pqisup=',Pqisup(il)
@@ -4601,8 +4601,8 @@
       Pxtiinf(ixt,il)=0.0
     enddo
-    if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+    IF ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
         Pxtiinf(iso_eau,il)=Pqiinf(il)
     endif
-    if (abs(Eqi(il)*fac_ftmr(il)).gt.ridicule) THEN
+    IF (abs(Eqi(il)*fac_ftmr(il)).gt.ridicule) THEN
         ! attention: pour des raisons obscures, il y a parfois
         ! de le réévaporation significative alors qu'il n'y a
@@ -4611,5 +4611,5 @@
         ! on suppose qu'elle ne change pas la composition
         ! isotopique de la vapeur. 
-        if (q(il).gt.ridicule) THEN
+        IF (q(il).gt.ridicule) THEN
            do ixt=1,niso
              Rb0(ixt,il)=xt(ixt,il)/q(il)
@@ -4622,5 +4622,5 @@
                      Rb0(ixt,il)=0.0                        
                    enddo !do ixt=1,niso  
-                   if (iso_eau.gt.0) THEN
+                   IF (iso_eau.gt.0) THEN
                         Rb0(iso_eau,il)=1.0 
                    endif      
@@ -4638,5 +4638,5 @@
             endif !if (abs(Eqi*fac_ftmr).gt.ridicule) THEN
 #ifdef ISOVERIF
-              if (iso_eau.gt.0) THEN
+              IF (iso_eau.gt.0) THEN
                 CALL iso_verif_egalite_choix( &
                    (Exi(iso_eau,il)*fac_ftmr(il)), &
@@ -4671,5 +4671,5 @@
                  'stewart_sublim 102')
         enddo !do ixt=1,niso
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
            CALL iso_verif_egalite_choix((Exi(iso_eau,il)), &
                          (Eqi(il)), &
@@ -4677,13 +4677,13 @@
            CALL iso_verif_egalite((Pxtiinf(iso_eau,il)), &
                  (Pqiinf(il)),'stewart_sublim 110')
-          endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-#endif
-
-         if ((bidouille_anti_divergence).and. &
+          endif !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+#endif
+
+         IF ((bidouille_anti_divergence).AND. &
                  (iso_eau.gt.0)) THEN
           ! assurer la convergence numérique pour ixt=4:
           Exi(iso_eau,il)=Eqi(il)          
           Pxtiinf(iso_eau,il)=Pqiinf(il)
-        endif !if  if ((bidouille_anti_divergence).and.(iso_eau.gt.0)
+        endif !if  if ((bidouille_anti_divergence).AND.(iso_eau.gt.0)
         
         ! calcul de xtnew
@@ -4701,15 +4701,15 @@
         enddo ! do ixt=1,niso
         ! verif que deltaD(Pqiinf) raisonable
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
             CALL iso_verif_aberrant_choix(Pxtiinf(iso_HDO,il),Pqiinf(il), &
                  ridicule_rain,deltalim_snow, 'stewart_sublim 175')
-        endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
-        if (iso_eau.gt.0) THEN
-            if (q(il)+Eqi(il)*fac_ftmr(il).ge.0.0) THEN
-            if (iso_verif_egalite_choix_nostop( &
+        endif !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO).AND.
+        IF (iso_eau.gt.0) THEN
+            IF (q(il)+Eqi(il)*fac_ftmr(il).ge.0.0) THEN
+            IF (iso_verif_egalite_choix_nostop( &
                         (xtnew(iso_eau,il)), &
                         (q(il)+Eqi(il)*fac_ftmr(il)), &
                         'stewart_sublim 108', &
-                        errmax,errmaxrel).eq.1) THEN
+                        errmax,errmaxrel).EQ.1) THEN
               WRITE(*,*) 'q(il)=',q(il)
               WRITE(*,*) 'Eqi(il)=',Eqi(il)
@@ -4718,12 +4718,12 @@
             endif !if (iso_verif_egalite_choix_nostop
             endif !if (q(il)+Eqi(il)*fac_ftmr(il).ge.0.0) THEN
-            if (iso_verif_egalite_choix_nostop( &
+            IF (iso_verif_egalite_choix_nostop( &
                         (Pxtiinf(iso_eau,il)), &
                         (Pqiinf(il)),'stewart_sublim 204', &
-                        errmax,errmaxrel).eq.1) THEN
+                        errmax,errmaxrel).EQ.1) THEN
               WRITE(*,*) 'Pqisup(il)=',Pqisup(il)
               stop
             endif !if (iso_verif_egalite_choix_nostop
-        endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+        endif !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
 #endif
         ! end verif
@@ -4766,8 +4766,8 @@
          ! calcul d'intégral soit simple, soit par Rieman.
   
-         integer ncas ! dimension officielle des variables
-         integer ncas_rieman,ncas_Jsimple ! nombre de variables à compresser
-         integer cas_rieman(ncas),cas_Jsimple(ncas) ! tableaux d'index
-         real m_cas(ncas),m(ncas), &
+         INTEGER ncas ! dimension officielle des variables
+         INTEGER ncas_rieman,ncas_Jsimple ! nombre de variables à compresser
+         INTEGER cas_rieman(ncas),cas_Jsimple(ncas) ! tableaux d'index
+         REAL m_cas(ncas),m(ncas), &
        m0_cas(ncas),m0(ncas), &
        qp0_cas(ncas),qp0(ncas), &
@@ -4785,7 +4785,7 @@
        Pqiinf_cas(ncas),Pqiinf(ncas), &
        fac_ftmr_cas(ncas),fac_ftmr(ncas)
-         real h(ncas)
+         REAL h(ncas)
 !         integer ntot_cas(ncas)
-         integer il,ixt        
+         INTEGER il,ixt
 
 
@@ -4803,5 +4803,5 @@
 !         WRITE(*,*) 'ncas_Jsimple=',ncas_Jsimple
 #endif      
-        if (ncas_Jsimple.gt.0) THEN
+        IF (ncas_Jsimple.gt.0) THEN
          do il=1,ncas_Jsimple
 !           WRITE(*,*) 'compress_stewart 50: il=',il
@@ -4837,5 +4837,5 @@
          enddo !do il=1,ncas_Jsimple
         endif !if (ncas_Jsimple.gt.0) THEN
-        if (ncas_rieman.gt.0) THEN
+        IF (ncas_rieman.gt.0) THEN
          do il=1,ncas_rieman
            m0_cas(il+ncas_Jsimple)=m0(cas_rieman(il))
@@ -4920,10 +4920,10 @@
 
          ! des compressions des cas de calcul de J dans stewart_explicit
-         integer ncas,ncas_rieman,ncas_Jsimple
-         integer cas_rieman(ncas),cas_Jsimple(ncas)
-         real Exi_cas(niso,ncas),Exi(niso,ncas), &
+         INTEGER ncas,ncas_rieman,ncas_Jsimple
+         INTEGER cas_rieman(ncas),cas_Jsimple(ncas)
+         REAL Exi_cas(niso,ncas),Exi(niso,ncas), &
              xtnew_cas(niso,ncas),xtnew(niso,ncas), &
              Pxtiinf_cas(niso,ncas),Pxtiinf(niso,ncas)
-         integer il,ixt
+         INTEGER il,ixt
 
 
@@ -4967,20 +4967,20 @@
          ! appel_stewart
 
-         integer ncas,ncum
-         integer cas(ncum)
-         real xtevap_cas(niso,ncum)
-         real xtp_cas(niso,ncum)
-         real xtwater_cas(niso,ncum)
+         INTEGER ncas,ncum
+         INTEGER cas(ncum)
+         REAL xtevap_cas(niso,ncum)
+         REAL xtp_cas(niso,ncum)
+         REAL xtwater_cas(niso,ncum)
 
          ! outputs
-         real xtwater(ntraciso,ncum)
-         real xtp(ntraciso,ncum)
-         real xtevap(ntraciso,ncum)
+         REAL xtwater(ntraciso,ncum)
+         REAL xtp(ntraciso,ncum)
+         REAL xtevap(ntraciso,ncum)
 
          ! locals
-         integer il,ixt
-#ifdef ISOVERIF
-         real Exi_cas(niso,ncum)
-         real Exi(ntraciso,ncum)
+         INTEGER il,ixt
+#ifdef ISOVERIF
+         REAL Exi_cas(niso,ncum)
+         REAL Exi(ntraciso,ncum)
 #endif         
 
@@ -5029,14 +5029,14 @@
 
          ! compression dans le cas condensation_facftmr
-         integer nd,ncum,nloc
-         integer ncas
-         integer cas(ncum)
-         integer i
-         real T_cas(ncum),T(ncum), &
+         INTEGER nd,ncum,nloc
+         INTEGER ncas
+         INTEGER cas(ncum)
+         INTEGER i
+         REAL T_cas(ncum),T(ncum), &
           xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum), &
           water_cas(ncum),water(ncum), &
           delP_cas(ncum),Ph(nloc,ND), &
           sigd_cas(ncum),sigd(ncum)
-         real Eqi_prime_cas(ncum),Eqi_prime(ncum), &
+         REAL Eqi_prime_cas(ncum),Eqi_prime(ncum), &
           Pqisup_cas(ncum),Pqisup(ncum),  &
           Pxtisup_cas(niso,ncum),Pxtisup(ntraciso,ncum),  &
@@ -5044,6 +5044,6 @@
           xtp_avantevap_cas(niso,ncum),xtp_avantevap(ntraciso,ncum), &
           fac_ftmr_cas(ncum),fac_ftmr(ncum)
-         real evap_cas(ncum),evap(ncum),qp_cas(ncum),qp(ncum)
-         integer il,ixt
+         REAL evap_cas(ncum),evap(ncum),qp_cas(ncum),qp(ncum)
+         INTEGER il,ixt
 
           do il=1,ncas
@@ -5060,6 +5060,6 @@
             evap_cas(il)=evap(cas(il))
             qp_cas(il)=qp(cas(il))
-            if (iso_verif_positif_nostop(sigd_cas(il)-1e-3, &
-                'compress_cond_facftmr 5215').eq.1) THEN
+            IF (iso_verif_positif_nostop(sigd_cas(il)-1e-3, &
+                'compress_cond_facftmr 5215').EQ.1) THEN
                 WRITE(*,*) 'il,cas(il),sigd_cas(il)=',il,cas(il),sigd_cas(il)
                 CALL abort_physic('isotopes_routines_mod', 'compress_cond_facftmr 5215: sigd_cas<1e3', 1)
@@ -5104,9 +5104,9 @@
 
          ! compression dans le cas condensation_facftmr
-         integer nloc,nd,ncum
-         integer ncas
-         integer cas(ncum)
-         integer i
-         real T_cas(ncum),T(ncum),  &
+         INTEGER nloc,nd,ncum
+         INTEGER ncas
+         INTEGER cas(ncum)
+         INTEGER i
+         REAL T_cas(ncum),T(ncum),  &
           xt_cas(niso,ncum),q_cas(ncum),xt(ntraciso,ncum),q(ncum),  &
           xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum), &
@@ -5114,5 +5114,5 @@
           delP_cas(ncum),Ph(nloc,ND), &
           sigd_cas(ncum), sigd(ncum)
-         real Eqi_prime_cas(ncum),Eqi_prime(ncum), &
+         REAL Eqi_prime_cas(ncum),Eqi_prime(ncum), &
           Pqisup_cas(ncum),Pqisup(ncum),  &
           Pxtisup_cas(niso,ncum),Pxtisup(ntraciso,ncum), &
@@ -5120,7 +5120,7 @@
           xtp_avantevap_cas(niso,ncum),xtp_avantevap(ntraciso,ncum)
 #ifdef ISOVERIF         
-         real evap_cas(ncum),evap(ncum),qp_cas(ncum),qp(ncum)
+         REAL evap_cas(ncum),evap(ncum),qp_cas(ncum),qp(ncum)
 #endif         
-         integer il,ixt
+         INTEGER il,ixt
 
           do il=1,ncas
@@ -5137,6 +5137,6 @@
             qp_cas(il)=qp(cas(il))
             evap_cas(il)=evap(cas(il))
-            if (iso_verif_positif_nostop(sigd_cas(il)-1e-3, &
-                'compress_cond_nofftmr 5294').eq.1) THEN
+            IF (iso_verif_positif_nostop(sigd_cas(il)-1e-3, &
+                'compress_cond_nofftmr 5294').EQ.1) THEN
                 WRITE(*,*) 'il,cas(il),sigd_cas(il)=',il,cas(il),sigd_cas(il)
                 CALL abort_physic('isotopes_routines_mod', 'compress_cond_nofftmr 5294: sigd_cas<1e3', 1)
@@ -5177,18 +5177,18 @@
 
          ! compression dans le cas condensation_facftmr
-         integer nloc,nd,ncum
-         integer ncas
-         integer cas(ncum)
-         integer i
-         real xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum), &
+         INTEGER nloc,nd,ncum
+         INTEGER ncas
+         INTEGER cas(ncum)
+         INTEGER i
+         REAL xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum), &
           water_cas(ncum),water(ncum), &
           delP_cas(ncum),Ph(nloc,ND)
-         real Pqisup_cas(ncum),Pqisup(ncum),  &
+         REAL Pqisup_cas(ncum),Pqisup(ncum),  &
           Pxtisup_cas(niso,ncum),Pxtisup(ntraciso,ncum),  &
           xtp_avantevap_cas(niso,ncum),xtp_avantevap(ntraciso,ncum)
 #ifdef ISOVERIF         
-         real evap_cas(ncum),evap(ncum),qp_cas(ncum),qp(ncum)
+         REAL evap_cas(ncum),evap(ncum),qp_cas(ncum),qp(ncum)
 #endif         
-         integer il,ixt
+         INTEGER il,ixt
 
           do il=1,ncas
@@ -5247,10 +5247,10 @@
          ! compression dans le cas condensation_facftmr
         ! inputs et outputs  
-         integer iflag_con   
-         integer nloc,nd,ncum
-         integer ncas
-         integer cas(ncum)
-         integer i
-         real xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum), &
+         INTEGER iflag_con
+         INTEGER nloc,nd,ncum
+         INTEGER ncas
+         INTEGER cas(ncum)
+         INTEGER i
+         REAL xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum), &
           water_cas(ncum),water(ncum), &
           qs_cas(ncum),qs(ncum), &
@@ -5259,7 +5259,7 @@
           delP_cas(ncum),Ph(nloc,ND), &
           sigd_cas(ncum),sigd(ncum)
-         real qp_cas(ncum),qp(ncum)
-#ifdef ISOVERIF
-         real evap_cas(ncum),evap(ncum)
+         REAL qp_cas(ncum),qp(ncum)
+#ifdef ISOVERIF
+         REAL evap_cas(ncum),evap(ncum)
 !         real 
 !         integer iso_verif_positif_nostop
@@ -5274,7 +5274,7 @@
           fac_ftmr_cas(ncum),fac_ftmr(ncum), &
           Eqi(ncum),Eqi_cas(ncum)
-         integer INB_cas(ncum),INB(ncum)
+         INTEGER INB_cas(ncum),INB(ncum)
          ! locals
-         integer il,ixt
+         INTEGER il,ixt
 
           do il=1,ncas
@@ -5312,5 +5312,5 @@
       !    Eqi_prime sont les même que Eqi_par
           do il=1,ncas
-            if ((water(cas(il)).gt.ridicule/100).and. &
+            IF ((water(cas(il)).gt.ridicule/100).AND. &
                   (Pqiinf_par(cas(il)).le.0.0)) THEN
              ! on ne peut pas utiliser la méthode 1, car KE prédit de l'eau
@@ -5319,11 +5319,11 @@
              Pqiinf_stewart(il)=Pqiinf(cas(il))
              Eqi_stewart(il)=Eqi_par(cas(il))
-           else !if ((water(il,i).gt.ridicule/100).and.(Pqiinf_par.le.0.0)) THEN
+           else !if ((water(il,i).gt.ridicule/100).AND.(Pqiinf_par.le.0.0)) THEN
              ! il n'y a pas d'obstacles à l'utilisation de 1)
              Pqiinf_stewart(il)=Pqiinf_par(cas(il))
-             if (iflag_con.eq.30) THEN
+             IF (iflag_con.EQ.30) THEN
                 Eqi_stewart(il)=Eqi_prime(cas(il))
-             else !if (iflag_con.eq.30) THEN
-                if (Eqi(cas(il)).ge.0.0) THEN
+             else !if (iflag_con.EQ.30) THEN
+                IF (Eqi(cas(il)).ge.0.0) THEN
                    Eqi_stewart(il)=Eqi(cas(il))
                 else !if (Eqi(cas(il)).gt.0.0) THEN
@@ -5335,6 +5335,6 @@
                    Eqi_stewart(il)=Eqi_prime(cas(il))
                 endif !if (Eqi(cas(il)).gt.0.0) THEN
-             endif !if (iflag_con.eq.30) THEN
-           endif !if ((water(il,i).gt.ridicule/100).and.(Pqiinf_par.le.0.0)) THEN
+             endif !if (iflag_con.EQ.30) THEN
+           endif !if ((water(il,i).gt.ridicule/100).AND.(Pqiinf_par.le.0.0)) THEN
          enddo !do il=1,ncas
 
@@ -5342,9 +5342,9 @@
 #ifdef ISOVERIF
          do il=1,ncas 
-          if ((iso_verif_positif_nostop(( &
-              Eqi_stewart(il)),'compress_stewart 977a').eq.1) &
-              .or.(iso_verif_positif_nostop(( &
+          IF ((iso_verif_positif_nostop(( &
+              Eqi_stewart(il)),'compress_stewart 977a').EQ.1) &
+              .OR.(iso_verif_positif_nostop(( &
               Eqi_stewart(il))*fac_ftmr_cas(il), &
-              'compress_stewart 977b').eq.1)) THEN
+              'compress_stewart 977b').EQ.1)) THEN
               WRITE(*,*) 'Pqiinf=',Pqiinf(cas(il))
               WRITE(*,*) 'Pqisup=',Pqisup(cas(il))
@@ -5368,6 +5368,6 @@
 #ifdef ISOVERIF
         do il=1,ncas
-          if ((abs(water_cas(il)).ge.ridicule/10.) &
-                 .and.(Pqiinf_stewart(il).le.0.0)) THEN
+          IF ((abs(water_cas(il)).ge.ridicule/10.) &
+                 .AND.(Pqiinf_stewart(il).le.0.0)) THEN
               WRITE(*,*) 'compress_stewart 498: evap liq:'
               WRITE(*,*) 'water(il,i)=', water_cas(il)
@@ -5412,5 +5412,5 @@
 USE isotopes_verif_mod
 #ifdef ISOTRAC
-use isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
+USE isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
 #endif
 #endif
@@ -5418,17 +5418,17 @@
 
          ! compression dans le cas condensation_facftmr
-         integer iflag_con      
-         integer nloc,nd,ncum
-         integer ncas
-         integer cas(ncum)
-         integer i
-         real T_cas(ncum),T(ncum), &
+         INTEGER iflag_con
+         INTEGER nloc,nd,ncum
+         INTEGER ncas
+         INTEGER cas(ncum)
+         INTEGER i
+         REAL T_cas(ncum),T(ncum), &
           delP_cas(ncum),Ph(nloc,ND), &
           water_cas(ncum),water(ncum), &
           xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum)
-         real qp_cas(ncum),qp(ncum)
-         real sigd_cas(ncum),sigd(ncum)
+         REAL qp_cas(ncum),qp(ncum)
+         REAL sigd_cas(ncum),sigd(ncum)
 #ifdef ISOVERIF  
-         real evap_cas(ncum),evap(ncum)
+         REAL evap_cas(ncum),evap(ncum)
 #endif         
          real  fac_ftmr_cas(ncum),fac_ftmr(ncum), &
@@ -5440,7 +5440,7 @@
           Pqiinf(ncum),Eqi_par(ncum),Pqiinf_par(ncum),Eqi_prime(ncum), &
           Eqi(ncum),Eqi_cas(ncum)
-          integer frac_sublim
-          integer INB_cas(ncum),INB(ncum)
-          integer il,ixt
+          INTEGER frac_sublim
+          INTEGER INB_cas(ncum),INB(ncum)
+          INTEGER il,ixt
 
           do il=1,ncas
@@ -5469,5 +5469,5 @@
 !     :   qp_avantevap_cas(1),qp_avantevap(cas(1))   
 
-          if (frac_sublim.eq.1) THEN
+          IF (frac_sublim.EQ.1) THEN
             do il=1,ncas           
              T_cas(il)=T(cas(il))           
@@ -5484,5 +5484,5 @@
       !    Eqi_prime sont les même que Eqi_par
           do il=1,ncas
-            if ((water(cas(il)).gt.ridicule/100).and. &
+            IF ((water(cas(il)).gt.ridicule/100).AND. &
                   (Pqiinf_par(cas(il)).le.0.0)) THEN
              ! on ne peut pas utiliser la méthode 1, car KE prédit de l'eau
@@ -5491,23 +5491,23 @@
              Pqiinf_stewart(il)=Pqiinf(cas(il))
              Eqi_stewart(il)=Eqi_par(cas(il))
-           else !if ((water(il,i).gt.ridicule/100).and.(Pqiinf_par.le.0.0)) THEN
+           else !if ((water(il,i).gt.ridicule/100).AND.(Pqiinf_par.le.0.0)) THEN
              ! il n'y a pas d'obstacles à l'utilisation de 1)
              Pqiinf_stewart(il)=Pqiinf_par(cas(il))
-             if (iflag_con.eq.30) THEN
+             IF (iflag_con.EQ.30) THEN
                 Eqi_stewart(il)=Eqi_prime(cas(il))
-             else !if (iflag_con.eq.30) THEN
+             else !if (iflag_con.EQ.30) THEN
                 ! pour quoi avait-on fait un traitement différent dans
                 ! le cas  iflag_con=3?? C'est vraiment le bordel ici!
-                if ((Eqi_prime(cas(il)).gt.0.0).and. &
-                     (Pqiinf(cas(il)).ge.Pqisup(cas(il))).and. &
-                     (Pqisup(cas(il)).gt.0.0).and. &
+                IF ((Eqi_prime(cas(il)).gt.0.0).AND. &
+                     (Pqiinf(cas(il)).ge.Pqisup(cas(il))).AND. &
+                     (Pqisup(cas(il)).gt.0.0).AND. &
                      (Pqisup(cas(il))-Eqi_prime(cas(il)).gt.0.0)) THEN
                      ! rustine au cas patho en 1D pour -90hPa/d   
                      Eqi_stewart(il)=Eqi_prime(cas(il))
-                else !if (Eqi_prime(il).gt.0.0).and.
+                else !if (Eqi_prime(il).gt.0.0).AND.
                      Eqi_stewart(il)=Eqi(cas(il))
-                endif !if (Eqi_prime(il).gt.0.0).and.
-             endif !if (iflag_con.eq.30) THEN
-           endif !if ((water(il,i).gt.ridicule/100).and.(Pqiinf_par.le.0.0)) THEN
+                endif !if (Eqi_prime(il).gt.0.0).AND.
+             endif !if (iflag_con.EQ.30) THEN
+           endif !if ((water(il,i).gt.ridicule/100).AND.(Pqiinf_par.le.0.0)) THEN
          enddo !do il=1,ncas_evap_glace 
 
@@ -5520,6 +5520,6 @@
 !        WRITE(*,*) 'Pqisup_cas=',Pqisup_cas(il)
         do il=1,ncas
-          if ((abs(water_cas(il)).ge.ridicule/10.) &
-                 .and.(Pqiinf_stewart(il).le.0.0)) THEN
+          IF ((abs(water_cas(il)).ge.ridicule/10.) &
+                 .AND.(Pqiinf_stewart(il).le.0.0)) THEN
               WRITE(*,*) 'compress_stewart 498: evap glace:'
               WRITE(*,*) 'water(il,i)=', water_cas(il)
@@ -5546,15 +5546,15 @@
 
         ! inputs         
-         integer ncas
-         integer cas(ncas)
-         integer klon         
-         real zxt_cas(niso,ncas),zxtrfln_cas(niso,ncas)
+         INTEGER ncas
+         INTEGER cas(ncas)
+         INTEGER klon
+         REAL zxt_cas(niso,ncas),zxtrfln_cas(niso,ncas)
 
          ! outputs
-         real zxt(ntraciso,klon)
-         real zxtrfl(ntraciso,klon),zxtrfln(ntraciso,klon)
+         REAL zxt(ntraciso,klon)
+         REAL zxtrfl(ntraciso,klon),zxtrfln(ntraciso,klon)
 
          ! locals
-         integer il,ixt
+         INTEGER il,ixt
 
          do il=1,ncas
@@ -5579,13 +5579,13 @@
          IMPLICIT NONE
 
-         integer ncas
-         integer cas(ncas)
-         integer klon,klev
-         real zxt(niso,klon)
-         real zxtrfl(niso,klon)
-         real delP(ncas),paprs(klon,klev+1)
-         real zxt_cas(niso,ncas), zxtrfl_cas(niso,ncas)
-         integer k
-         integer il,ixt
+         INTEGER ncas
+         INTEGER cas(ncas)
+         INTEGER klon,klev
+         REAL zxt(niso,klon)
+         REAL zxtrfl(niso,klon)
+         REAL delP(ncas),paprs(klon,klev+1)
+         REAL zxt_cas(niso,ncas), zxtrfl_cas(niso,ncas)
+         INTEGER k
+         INTEGER il,ixt
 
          do il=1,ncas
@@ -5616,21 +5616,21 @@
          IMPLICIT NONE
 
-         integer ncas
-         integer cas(ncas)
-         integer klon,klev
-         real zq(klon), zxt(ntraciso,klon)
-         real zq_cas(ncas),zxt_cas(niso,ncas)         
-         real zxtrfl_cas(niso,ncas)
-         real zxtrfl_ancien(ntraciso,klon)
-         real delP(ncas),paprs(klon,klev+1)
-         real zqs(klon),zqs_cas(ncas)
-         real zt_cas(ncas),zt(klon) 
-         real zqev_diag_cas(ncas),zqev_diag(klon)
-         real zrfln_cas(ncas)
-         real zrfln(klon)
-         real zrfl_cas(ncas)
-         real zrfl_ancien(klon)
-         integer k
-         integer il,ixt
+         INTEGER ncas
+         INTEGER cas(ncas)
+         INTEGER klon,klev
+         REAL zq(klon), zxt(ntraciso,klon)
+         REAL zq_cas(ncas),zxt_cas(niso,ncas)
+         REAL zxtrfl_cas(niso,ncas)
+         REAL zxtrfl_ancien(ntraciso,klon)
+         REAL delP(ncas),paprs(klon,klev+1)
+         REAL zqs(klon),zqs_cas(ncas)
+         REAL zt_cas(ncas),zt(klon)
+         REAL zqev_diag_cas(ncas),zqev_diag(klon)
+         REAL zrfln_cas(ncas)
+         REAL zrfln(klon)
+         REAL zrfl_cas(ncas)
+         REAL zrfl_ancien(klon)
+         INTEGER k
+         INTEGER il,ixt
 
          do il=1,ncas
@@ -5671,28 +5671,28 @@
 
         ! inputs         
-         integer ncas
-         integer cas(ncas)
-         integer klon
-         real zq(klon), zxt(ntraciso,klon)
-         real zxtrfl_ancien(ntraciso,klon)
-         real zt(klon) 
-         real zqev_diag(klon)
-         real zrfln(klon)
-         integer k,klev
-         real paprs(klon,klev+1)
-         integer frac_sublim
+         INTEGER ncas
+         INTEGER cas(ncas)
+         INTEGER klon
+         REAL zq(klon), zxt(ntraciso,klon)
+         REAL zxtrfl_ancien(ntraciso,klon)
+         REAL zt(klon)
+         REAL zqev_diag(klon)
+         REAL zrfln(klon)
+         INTEGER k,klev
+         REAL paprs(klon,klev+1)
+         INTEGER frac_sublim
 
          ! outputs
-         real zq_cas(ncas),zxt_cas(niso,ncas)         
-         real zxtrfl_cas(niso,ncas)         
-         real zt_cas(ncas)
-         real zqev_diag_cas(ncas)
-         real zrfln_cas(ncas)         
-         real zrfl_cas(ncas)
-         real zrfl_ancien(klon)
-         real delP(ncas)
+         REAL zq_cas(ncas),zxt_cas(niso,ncas)
+         REAL zxtrfl_cas(niso,ncas)
+         REAL zt_cas(ncas)
+         REAL zqev_diag_cas(ncas)
+         REAL zrfln_cas(ncas)
+         REAL zrfl_cas(ncas)
+         REAL zrfl_ancien(klon)
+         REAL delP(ncas)
          
          ! locals
-         integer il,ixt 
+         INTEGER il,ixt
 !#ifdef ISOVERIF
 !         real 
@@ -5709,5 +5709,5 @@
           zq_cas(il)=zq(cas(il))
           zqev_diag_cas(il)=zqev_diag(cas(il))   
-          if (frac_sublim.eq.1) THEN
+          IF (frac_sublim.EQ.1) THEN
             zt_cas(il)=zt(cas(il))
           endif
@@ -5715,5 +5715,5 @@
          
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
             do il=1,ncas
 !              WRITE(*,*) 'il=',il
@@ -5753,8 +5753,8 @@
 
         ! **inputs:
-        integer ncas
+        INTEGER ncas
         ! arguments de la fonction à intégrer:
-        real qp0(ncas)
-        real A(ncas),m(ncas),m0(ncas),beta(niso,ncas), &
+        REAL qp0(ncas)
+        REAL A(ncas),m(ncas),m0(ncas),beta(niso,ncas), &
                  gama(niso,ncas),f0(ncas),g0(ncas)
 !        integer ntot(ncas) 
@@ -5763,15 +5763,15 @@
         
         ! ** output
-        real I(niso,ncas) ! integrale
+        REAL I(niso,ncas) ! integrale
         
         ! **locals
         ! nombre max d'itération dans integrale rieman
-        integer j
-        integer il,ixt,k
-        real dxj(ncas)
-        integer ndeg ! degrès du polynome de Legendre 
+        INTEGER j
+        INTEGER il,ixt,k
+        REAL dxj(ncas)
+        INTEGER ndeg ! degrès du polynome de Legendre
         parameter (ndeg=5)   
-        real w(ndeg),z(ndeg)
-        real fj
+        REAL w(ndeg),z(ndeg)
+        REAL fj
             
 !        real xj        
@@ -5787,5 +5787,5 @@
 #ifdef ISOVERIF     
       do il=1,ncas   
-        if (m0(il).lt.m(il)) THEN
+        IF (m0(il).lt.m(il)) THEN
             WRITE(*,*) 'integrale_rieman 25'
             WRITE(*,*) 'binf=',m(il),' bsup=',m0(il)
@@ -5799,13 +5799,13 @@
         !*** calculs
 
-        if (ndeg.eq.1) THEN
+        IF (ndeg.EQ.1) THEN
            z(1)=0.0
            w(1)=2.0
-         else if (ndeg.eq.2) THEN
+         ELSE IF (ndeg.EQ.2) THEN
            z(1)=-0.577350269189
            z(2)=0.577350269189
            w(1)=1.0
            w(2)=1.0
-        else if (ndeg.eq.3) THEN
+        ELSE IF (ndeg.EQ.3) THEN
            z(1)=-0.774596669241
            z(2)=0.0
@@ -5814,5 +5814,5 @@
            w(2)=0.8888888888888
            w(3)=0.5555555555555
-        else if (ndeg.eq.4) THEN
+        ELSE IF (ndeg.EQ.4) THEN
            z(1)=-0.861136311594
            z(2)=-0.3399810435848
@@ -5823,5 +5823,5 @@
            w(3)=0.6521451548625
            w(4)=0.34785484513745 
-        else if (ndeg.eq.5) THEN
+        ELSE IF (ndeg.EQ.5) THEN
            z(1)=-0.90617984593866399280
            z(2)=-0.53846931010568309104
@@ -5954,9 +5954,9 @@
 
       !*inputs et outputs
-      integer ncum ! dimension horiz effective
-      logical lwork(nloc)
-      integer NA,ND,nloc ! dimensions officielles
-      real PH(nloc,ND),T(nloc,ND),EVAP(nloc,NA)
-      real XTWDTRAIN(ntraciso,nloc),WDTRAIN(nloc), &
+      INTEGER ncum ! dimension horiz effective
+      LOGICAL lwork(nloc)
+      INTEGER NA,ND,nloc ! dimensions officielles
+      REAL PH(nloc,ND),T(nloc,ND),EVAP(nloc,NA)
+      REAL XTWDTRAIN(ntraciso,nloc),WDTRAIN(nloc), &
             WATER(nloc,NA), Q(nloc,NA), XT(ntraciso,nloc,ND), &
                  QS(nloc,ND),QP(nloc,NA), &
@@ -5964,26 +5964,26 @@
           XTEVAP(ntraciso,nloc,NA), &
             WT(nloc,NA), MP(nloc,NA)
-      real sigd
-      integer i,INB(nloc)
-      logical cvflag_grav
-      real ginv
-      real Mpmin
+      REAL sigd
+      INTEGER i,INB(nloc)
+      LOGICAL cvflag_grav
+      REAL ginv
+      REAL Mpmin
 
       !* variables intermediaires
-      integer ixt,j,il
-      real qeff(ncum)
-      real xtp_avantevap(ntraciso,ncum),qp_avantevap(ncum)
+      INTEGER ixt,j,il
+      REAL qeff(ncum)
+      REAL xtp_avantevap(ntraciso,ncum),qp_avantevap(ncum)
 !      real Exi(niso,ncum) ! equivalent à Eqi_prime
-      real Pqisup(ncum),Pqiinf(ncum),Eqi(ncum) 
-      real Pqiinf_par(ncum), Eqi_prime(ncum),  &
+      REAL Pqisup(ncum),Pqiinf(ncum),Eqi(ncum)
+      REAL Pqiinf_par(ncum), Eqi_prime(ncum),  &
                  Eqi_plus1(ncum), Eqi_par(ncum)
-      real Pqiinf_stewart(ncum), Eqi_stewart(ncum)
-      real Exi_prime(ntraciso,ncum)
-      real Pxtiinf_stewart(niso,ncum),  &
+      REAL Pqiinf_stewart(ncum), Eqi_stewart(ncum)
+      REAL Exi_prime(ntraciso,ncum)
+      REAL Pxtiinf_stewart(niso,ncum),  &
                 Exi_stewart(niso,ncum)
-      real Exi_plus1(niso,ncum)
-      real Pxtisup(ntraciso,ncum), Pxtiinf(niso,ncum)
-      real xtnew(niso,ncum)
-      real fac_ftmr(ncum) ! facteur de conversion des flux en mixing ratio
+      REAL Exi_plus1(niso,ncum)
+      REAL Pxtisup(ntraciso,ncum), Pxtiinf(niso,ncum)
+      REAL xtnew(niso,ncum)
+      REAL fac_ftmr(ncum) ! facteur de conversion des flux en mixing ratio
 !      real Risup(ntraciso,ncum), Rcond(ntraciso,ncum), 
 !     :           Renv(ntraciso,ncum) 
@@ -5993,31 +5993,31 @@
 !     real fcond(ncum), fice(ncum), cond(ncum)
 !      real zxtalphal(niso,ncum), zxtalphai(niso,ncum)
-      real g
-      real rat(ncum)
-      real ztglace_kelvin
+      REAL g
+      REAL rat(ncum)
+      REAL ztglace_kelvin
       parameter (ztglace_kelvin=273.15)
 
-      integer frac_sublim
+      INTEGER frac_sublim
       !real      
       !real real_to_double
 
       ! compteurs de parsage
-      integer icas_condensation_facftmr,ncas_condensation_facftmr
-      integer icas_condensation_nofacftmr,ncas_condensation_nofacftmr
-      integer icas_noevap,ncas_noevap
-      integer icas_evap_liq,ncas_evap_liq
-      integer icas_evap_glace,ncas_evap_glace
-      integer ncas_tot
+      INTEGER icas_condensation_facftmr,ncas_condensation_facftmr
+      INTEGER icas_condensation_nofacftmr,ncas_condensation_nofacftmr
+      INTEGER icas_noevap,ncas_noevap
+      INTEGER icas_evap_liq,ncas_evap_liq
+      INTEGER icas_evap_glace,ncas_evap_glace
+      INTEGER ncas_tot
 
       ! tableaux d'indice issus du parsage
-      integer cas_condensation_facftmr(ncum)
-      integer cas_condensation_nofacftmr(ncum)
-      integer cas_noevap(ncum)
-      integer cas_evap_liq(ncum)
-      integer cas_evap_glace(ncum)
+      INTEGER cas_condensation_facftmr(ncum)
+      INTEGER cas_condensation_nofacftmr(ncum)
+      INTEGER cas_noevap(ncum)
+      INTEGER cas_evap_liq(ncum)
+      INTEGER cas_evap_glace(ncum)
 
 #ifdef ISOVERIF
       ! tracage des cas
-      integer trace_cas(ncum)
+      INTEGER trace_cas(ncum)
 !      integer iso_verif_positif_nostop
 !      integer iso_verif_positif_choix_nostop
@@ -6027,13 +6027,13 @@
 !      integer iso_verif_egalite_choix_nostop
 !      real deltaD
-      real Exi_cas(niso,ncum),Exi(ntraciso,ncum)
+      REAL Exi_cas(niso,ncum),Exi(ntraciso,ncum)
 #endif      
 
       ! outputs des calculs, compressés
-      real xtevap_cas(niso,ncum),xtp_cas(niso,ncum), &
+      REAL xtevap_cas(niso,ncum),xtp_cas(niso,ncum), &
                  xtwater_cas(niso,ncum)
 
       ! inputs des calculs, compréssés
-      real T_cas(ncum),delP_cas(ncum), &
+      REAL T_cas(ncum),delP_cas(ncum), &
                 xtevapsup_cas(niso,ncum),evap_cas(ncum), &
                 qp_cas(ncum),wt_cas(ncum), &
@@ -6041,5 +6041,5 @@
                 qs_cas(ncum),water_cas(ncum), &
                 sigd_cas(ncum)
-        real sigd_vec(ncum)
+        REAL sigd_vec(ncum)
       real  qp_avantevap_cas(ncum), &
         xtp_avantevap_cas(niso,ncum), &
@@ -6050,10 +6050,10 @@
       real  qp_avantevaptrac_cas(ncum), &
         xtp_avantevaptrac_cas(niso,ncum)
-        integer izone ,iiso
-      real xtaddp_tag(niso,ncum)
-      real ptrac(ncum)
-      real hdiag(ncum)
+        INTEGER izone ,iiso
+      REAL xtaddp_tag(niso,ncum)
+      REAL ptrac(ncum)
+      REAL hdiag(ncum)
 #endif      
-      integer INB_cas(ncum)
+      INTEGER INB_cas(ncum)
               
 
@@ -6063,5 +6063,5 @@
 
       !gravité:
-      if (cvflag_grav) THEN
+      IF (cvflag_grav) THEN
           g=1/ginv
       else
@@ -6082,10 +6082,10 @@
       
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
         do il=1,ncum 
-         if (i.le.inb(il) .and. lwork(il)) THEN
+         IF (i.le.inb(il) .AND. lwork(il)) THEN
           CALL iso_verif_egalite_choix(xt(iso_eau,il,i),q(il,i), &
                  'appel stewart 58',errmax,errmaxrel)
-         endif !if (i.le.inb(il) .and. lwork(il)) THEN
+         endif !if (i.le.inb(il) .AND. lwork(il)) THEN
         enddo !do il=1,ncum    
       endif !if (iso_eau.gt.0) THEN
@@ -6097,18 +6097,18 @@
 #endif      
 #endif
-      if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+      IF ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
          do il=1,ncum 
-             if (i.le.inb(il) .and. lwork(il)) THEN
+             IF (i.le.inb(il) .AND. lwork(il)) THEN
                 xt(iso_eau,il,i)=  q(il,i)
-             endif !if (i.le.inb(il) .and. lwork(il)) THEN
+             endif !if (i.le.inb(il) .AND. lwork(il)) THEN
            enddo !do il=1,ncum     
-      endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+      endif !if ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
       ! verif que les vapeurs du ddft plus haut sont bonnes
       ! si i=INB, on ne verifie rien car pas de vapeur au dessus de INB
 #ifdef ISOVERIF
        do il=1,ncum 
-         if (i.lt.inb(il) .and. lwork(il)) THEN
+         IF (i.lt.inb(il) .AND. lwork(il)) THEN
           do j=i+1,INB(il)
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(xtp(iso_eau,il,j),qp(il,j), &
                  'appel_stewart 66',errmax,errmaxrel)
@@ -6123,17 +6123,17 @@
 #endif  
          enddo !do j=i+1,INB
-        endif ! (i.lt.inb(il) .and. lwork(il)) THEN
+        endif ! (i.lt.inb(il) .AND. lwork(il)) THEN
        enddo !do il=1,ncum 
 #endif
 
-      if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+      IF ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
        do il=1,ncum 
-        if (i.lt.inb(il) .and. lwork(il)) THEN
+        IF (i.lt.inb(il) .AND. lwork(il)) THEN
          do j=i+1,INB(il)
           xtp(iso_eau,il,j)=qp(il,j)          
          enddo !do j=i+1,INB
-        endif ! (i.lt.inb(il) .and. lwork(il)) THEN
+        endif ! (i.lt.inb(il) .AND. lwork(il)) THEN
        enddo !do il=1,ncum 
-      endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+      endif !if ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
       ! end verif des inputs 
 
@@ -6142,10 +6142,10 @@
       
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) THEN
-        if (Mp(il,i).gt.Mp(il,i+1)) THEN
+       IF (i.le.inb(il) .AND. lwork(il)) THEN
+        IF (Mp(il,i).gt.Mp(il,i+1)) THEN
           ! cas entrainant
           fac_ftmr(il)=1.0/Mp(il,i)
         else !if (Mp(il,i).gt.Mp(il,i+1)) THEN
-          if (Mp(il,i+1).gt.Mpmin) THEN
+          IF (Mp(il,i+1).gt.Mpmin) THEN
               ! cas non entrainant, mais flux existe
               fac_ftmr(il)=1.0/Mp(il,i+1)
@@ -6155,5 +6155,5 @@
           endif !if (Mp(il,i+1).gt.Mpmin) THEN
         endif !if (Mp(il,i).gt.Mp(il,i+1)) THEN
-       endif ! (i.le.inb(il) .and. lwork(il)) THEN
+       endif ! (i.le.inb(il) .AND. lwork(il)) THEN
       enddo !do il=1,ncum
 
@@ -6161,7 +6161,7 @@
             
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) THEN
-        if (i.lt.INB(il)) THEN
-         if (Mp(il,i).gt.Mp(il,i+1)) THEN
+       IF (i.le.inb(il) .AND. lwork(il)) THEN
+        IF (i.lt.INB(il)) THEN
+         IF (Mp(il,i).gt.Mp(il,i+1)) THEN
           ! cas entrainant
           rat(il)=Mp(il,i+1)/Mp(il,i)
@@ -6172,5 +6172,5 @@
           enddo
          else !if (Mp(il,i).gt.Mp(il,i+1)) THEN
-           if (Mp(il,i+1).gt.Mpmin) THEN
+           IF (Mp(il,i+1).gt.Mpmin) THEN
               ! cas non entrainant, mais flux existe
               qp_avantevap(il)=qp(il,i+1)
@@ -6185,5 +6185,5 @@
               ! l'environnement
               qp_avantevap(il)=qp(il,i)
-              if (qp(il,i).gt.0) THEN
+              IF (qp(il,i).gt.0) THEN
 #ifdef ISOVERIF
                 CALL iso_verif_positif_strict(q(il,i), &
@@ -6207,5 +6207,5 @@
           ! l'environnement
           qp_avantevap(il)=qp(il,i)
-          if (qp(il,i).gt.0) THEN
+          IF (qp(il,i).gt.0) THEN
             do ixt=1,ntraciso
              xtp_avantevap(ixt,il)=xt(ixt,il,i)/q(il,i)*qp(il,i)
@@ -6218,16 +6218,16 @@
           endif !if (qp(il,i).gt.0) THEN
         endif ! if i.lt.INB(il)
-       endif ! (i.le.inb(il) .and. lwork(il)) THEN
+       endif ! (i.le.inb(il) .AND. lwork(il)) THEN
       enddo !do il=1,ncum
 
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
         do il=1,ncum 
-          if (i.le.inb(il) .and. lwork(il)) THEN
+          IF (i.le.inb(il) .AND. lwork(il)) THEN
             CALL iso_verif_egalite_choix( &
                 (xtp_avantevap(iso_eau,il)), &
                 (qp_avantevap(il)), &
                  'appel stewart 95',errmax,errmaxrel)
-          endif ! (i.le.inb(il) .and. lwork(il)) THEN
+          endif ! (i.le.inb(il) .AND. lwork(il)) THEN
         enddo !do il=1,ncum
       endif !if (iso_eau.gt.0) THEN
@@ -6238,5 +6238,5 @@
       
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) THEN
+       IF (i.le.inb(il) .AND. lwork(il)) THEN
         Pqisup(il)=sigd_vec(il)/g*wt(il,i)*water(il,i+1)+wdtrain(il)/g
         Pqiinf(il)=sigd_vec(il)/g*wt(il,i)*water(il,i) ! ce qu'on aurait dans si ce
@@ -6253,10 +6253,10 @@
                  +xtwdtrain(ixt,il)/g
         enddo
-       endif !if (i.le.inb(il) .and. lwork(il)) THEN
+       endif !if (i.le.inb(il) .AND. lwork(il)) THEN
       enddo !do il=1,ncum 
 
 #ifdef ISOVERIF      
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) THEN
+       IF (i.le.inb(il) .AND. lwork(il)) THEN
          CALL iso_verif_egalite_choix((Pqiinf(il)),  &
                (Pqiinf_par(il)),'appel_setwart 218', &
@@ -6264,10 +6264,10 @@
        endif
 !#ifdef ISOTRAC
-!        if ((option_traceurs.eq.17).or.
-!     :           (option_traceurs.eq.18)) THEN
+!        if ((option_traceurs.EQ.17).OR.
+!     :           (option_traceurs.EQ.18)) THEN
 !        if (iso_verif_positif_nostop((        
 !     :          Pxtisup(index_trac(izone_cond,iso_eau),il)
 !     :          -Pxtisup(iso_eau,il)),
-!     :          'appel_stewart 332').eq.1) THEN
+!     :          'appel_stewart 332').EQ.1) THEN
 !          WRITE(*,*) 'Pxtisup(:,il)=',Pxtisup(:,il)
 !          WRITE(*,*) 'xtwater(:,il,i+1)=',xtwater(:,il,i+1)
@@ -6275,5 +6275,5 @@
 !          stop
 !        endif !if (iso_verif_positif_nostop(Pxtisup(iso_eau,il)-
-!        endif !if ((option_traceurs.eq.17).or.    
+!        endif !if ((option_traceurs.EQ.17).OR.
 !#endif       
       enddo !do il=1,ncum 
@@ -6290,8 +6290,8 @@
       ! petite vérif sur les flux
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) THEN
-         if ((Eqi_par(il).lt.0.0) &
-                .and.(Pqiinf_par(il).le.0.0) &
-               .and.(water(il,i).gt.ridicule/10.)) THEN
+       IF (i.le.inb(il) .AND. lwork(il)) THEN
+         IF ((Eqi_par(il).lt.0.0) &
+                .AND.(Pqiinf_par(il).le.0.0) &
+               .AND.(water(il,i).gt.ridicule/10.)) THEN
             ! dans ce cas, on a de l'eau sortant dont il faut déterminer la
             ! composition, mais pourtant le bilan de masse indique qu'il
@@ -6301,5 +6301,5 @@
 !            WRITE(*,*) 'appel_stewart 239: cas génant'
 
-            if (Eqi_prime(il)*fac_ftmr(il).lt. &
+            IF (Eqi_prime(il)*fac_ftmr(il).lt. &
                 qp_avantevap(il)*1e-2) THEN
                 ! ouf: Eqi_prime a peut d'effet sur la vapeur du ddft.
@@ -6313,8 +6313,8 @@
             endif
           endif
-        endif !if (i.le.inb(il) .and. lwork(il)) THEN
+        endif !if (i.le.inb(il) .AND. lwork(il)) THEN
       enddo !do il=1,ncum
 
-      if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+      IF ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
           do il=1,ncum
             xtp_avantevap(iso_eau,il)=qp_avantevap(il)
@@ -6333,5 +6333,5 @@
       ! initialisation de l'outil de tracage de cas:
       do il=1,ncum
-        if (i.le.inb(il) .and. lwork(il)) THEN
+        IF (i.le.inb(il) .AND. lwork(il)) THEN
           trace_cas(il)=0
         else
@@ -6348,7 +6348,7 @@
 #endif      
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) THEN
+       IF (i.le.inb(il) .AND. lwork(il)) THEN
 !        WRITE(*,*) 'tmp 417: il,Eqi_prime=',il,Eqi_prime(il)
-        if ((Eqi_prime(il).lt.-ridicule*1e-3).or. &
+        IF ((Eqi_prime(il).lt.-ridicule*1e-3).OR. &
               (Eqi_prime(il)*fac_ftmr(il).lt.-ridicule*10)) THEN
             ! modif le 10 mai 2009: si Eqi_prime très petit, on le
@@ -6359,5 +6359,5 @@
           ! 1: Eqi_prime<0: condensation
 !          WRITE(*,*) 'tmp 426: condensation'
-          if (fac_ftmr(il).gt.ridicule/100.) THEN
+          IF (fac_ftmr(il).gt.ridicule/100.) THEN
             ! si fac_ftmr très petit, on le traite comme du 0
             ! 1.1: si Mpi>0
@@ -6375,7 +6375,7 @@
 #endif
           endif !if (fac_ftmr.gt.0.0) THEN
-!        else if ((abs(Eqi_prime(il)).lt.ridicule*1e-3).and.
+!        ELSE IF ((abs(Eqi_prime(il)).lt.ridicule*1e-3).AND.
 !     :      (abs(Eqi_prime(il)*fac_ftmr(il)).lt.ridicule*10)) THEN
-        else if ((Eqi_prime(il).lt.ridicule*1e-3).and. & 
+        ELSE IF ((Eqi_prime(il).lt.ridicule*1e-3).AND. &
            (Eqi_prime(il)*fac_ftmr(il).lt.ridicule*10)) THEN
             ! 2: Eqi_prime est compris entre 1e-14 et -1e-14: rien 
@@ -6394,5 +6394,5 @@
 #ifdef ISOVERIF
             trace_cas(il)=2
-            if ((Pqisup(il).le.0.0).and. &
+            IF ((Pqisup(il).le.0.0).AND. &
                 (water(il,i).gt.ridicule)) THEN
             WRITE(*,*) 'appel_stewart 420: water=',water(il,i)
@@ -6407,7 +6407,7 @@
 !        WRITE(*,*) 'tmp 473: evap'
         ! quelques vérifs du bilan de masse d'eau 
-             if (iso_verif_positif_nostop(( &
+             IF (iso_verif_positif_nostop(( &
                  Pqisup(il)-Eqi_prime(il)), &
-                 'appel_stewart 388').eq.1) THEN
+                 'appel_stewart 388').EQ.1) THEN
                WRITE(*,*) 'Pqisup=',Pqisup(il)
                WRITE(*,*) 'Eqi_prime=',Eqi_prime(il)
@@ -6416,7 +6416,7 @@
 !               stop
               endif
-              if (iso_verif_positif_choix_nostop(( &
+              IF (iso_verif_positif_choix_nostop(( &
                 Pqisup(il)-Pqiinf_par(il)),errmax, &
-                'appel_stewart 442').eq.1) THEN
+                'appel_stewart 442').EQ.1) THEN
                 WRITE(*,*) 'appel_stewart 174'
                 WRITE(*,*) 'Pqisup=',Pqisup(il), &
@@ -6424,6 +6424,6 @@
                 stop
               endif               
-              if (iso_verif_positif_nostop((Eqi_par(il)), &
-                'appel_stewart 559b').eq.1) THEN
+              IF (iso_verif_positif_nostop((Eqi_par(il)), &
+                'appel_stewart 559b').EQ.1) THEN
                 WRITE(*,*) 'Eqi(il),Eqi_plus1(il),Eqi_prime(il)=', &
                        Eqi(il),Eqi_plus1(il),Eqi_prime(il)
@@ -6432,5 +6432,5 @@
               endif
 #endif              
-              if (T(il,i).ge.ztglace_kelvin) THEN
+              IF (T(il,i).ge.ztglace_kelvin) THEN
                 ! 3.1: evap des gouttes
                 icas_evap_liq=icas_evap_liq+1  
@@ -6448,5 +6448,5 @@
               endif !if (T(il,i).ge.ztglace_kelvin) THEN
           endif !if (Eqi_prime.lt.0.0) THEN
-       endif !if (i.le.inb(il) .and. lwork(il)) THEN
+       endif !if (i.le.inb(il) .AND. lwork(il)) THEN
       enddo  !do il=1,ncum 
 
@@ -6464,5 +6464,5 @@
       ncas_tot=0
       do il=1,ncum
-        if (i.le.inb(il) .and. lwork(il)) THEN
+        IF (i.le.inb(il) .AND. lwork(il)) THEN
             ncas_tot=ncas_tot+1
         endif
@@ -6475,5 +6475,5 @@
 !      WRITE(*,*) 'ncas_evap_liq_=',ncas_evap_liq
 !      WRITE(*,*) 'ncas_evap_glace=',ncas_evap_glace
-      if (ncas_tot.ne.ncas_condensation_facftmr &
+      IF (ncas_tot.NE.ncas_condensation_facftmr &
                +ncas_condensation_nofacftmr&
                +ncas_noevap&
@@ -6482,5 +6482,5 @@
          WRITE(*,*) 'mauvais parsage'
          stop
-       endif !if (ncas_tot.ne.ncas_condensation_facftmr
+       endif !if (ncas_tot.NE.ncas_condensation_facftmr
 #endif      
 
@@ -6488,5 +6488,5 @@
       ! ****** traitement vectoriel du cas 1.1
 
-      if (ncas_condensation_facftmr.gt.0) THEN
+      IF (ncas_condensation_facftmr.gt.0) THEN
       CALL compress_cond_facftmr(ncas_condensation_facftmr,   &
          cas_condensation_facftmr, &
@@ -6523,5 +6523,5 @@
               'appel_stewart 460: compression condensation_facftmr', &
               errmax,errmax)
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
          CALL iso_verif_egalite_choix( &
               (xtp_avantevap_cas(iso_eau,il)), &
@@ -6586,5 +6586,5 @@
 
 #ifdef ISOVERIF 
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
           do il=1,ncas_condensation_facftmr
             CALL iso_verif_egalite_choix( &
@@ -6635,5 +6635,5 @@
 !     :           xtp_avantevap(1:ntraciso:3,
 !     :           cas_condensation_facftmr(il))
-!               if (il.eq.cas_condensation_facftmr(602)) THEN
+!               if (il.EQ.cas_condensation_facftmr(602)) THEN
 !                WRITE(*,*) 'appel_stewart 638: il=602'
 !                WRITE(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
@@ -6658,5 +6658,5 @@
         ! ****** traitement vectoriel du cas 1.2
 
-      if (ncas_condensation_nofacftmr.gt.0) THEN
+      IF (ncas_condensation_nofacftmr.gt.0) THEN
       CALL compress_cond_nofftmr(ncas_condensation_nofacftmr, &
          cas_condensation_nofacftmr, &
@@ -6778,5 +6778,5 @@
         ! ****** traitement vectoriel du cas 2
 
-      if (ncas_noevap.gt.0) THEN
+      IF (ncas_noevap.gt.0) THEN
       CALL compress_noevap(ncas_noevap, &
          cas_noevap, &
@@ -6802,5 +6802,5 @@
                 water(cas_noevap(il),i), &
                 'appel_stewart 693: compression',errmax,errmaxrel)
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite_choix( &
                 (Pxtisup_cas(iso_eau,il)), &
@@ -6893,5 +6893,5 @@
         ! ****** traitement vectoriel du cas 3.1
 
-      if (ncas_evap_liq.gt.0) THEN
+      IF (ncas_evap_liq.gt.0) THEN
       CALL compress_evap_liq(30,ncas_evap_liq, &
          cas_evap_liq, &
@@ -6939,5 +6939,5 @@
               'appel_stewart 783: compression evap_liq', &
                 errmax,errmax)
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite_choix( &
               (xtp_avantevap_cas(iso_eau,il)), &
@@ -6988,5 +6988,5 @@
 
        ! initialisation dans le cas où la revap est taggée:
-       if (option_revap.eq.1) THEN
+       IF (option_revap.EQ.1) THEN
          do il=1,ncas_evap_liq  
            do iiso=1,niso
@@ -6997,5 +6997,5 @@
              enddo  !do iiso=1,niso  
          enddo !do il=1,ncas_evap_glace  
-       endif !if (option_revap.eq.1) th
+       endif !if (option_revap.EQ.1) th
 
 
@@ -7043,5 +7043,5 @@
 !       WRITE(*,*) 'xtp_avantevaptrac_cas(iso_eau,2)=',
 !     :           xtp_avantevaptrac_cas(iso_eau,2)
-       if (iso_eau.gt.0) THEN
+       IF (iso_eau.gt.0) THEN
            do il=1,ncas_evap_liq
 !             WRITE(*,*) 'appel_stewart tmp 943: il=',il
@@ -7066,17 +7066,17 @@
                 'appel_stewart 961',  &
                 errmax,errmaxrel)
-!             if ((option_traceurs.eq.17).or.
-!     :           (option_traceurs.eq.18)) THEN
-!               if (izone.eq.izone_cond) THEN
+!             if ((option_traceurs.EQ.17).OR.
+!     :           (option_traceurs.EQ.18)) THEN
+!               if (izone.EQ.izone_cond) THEN
 !                CALL iso_verif_positif((
 !     :           Pxtisup_cas(iso_eau,il)
 !     :           -Pxtisup(iso_eau,cas_evap_liq(il))),
 !     :           'appel_stewart_vectall 1114')
-!               else !if (izone.eq.izone_cond) THEN
+!               else !if (izone.EQ.izone_cond) THEN
 !                CALL iso_verif_positif((
 !     :           -Pxtisup_cas(iso_eau,il)),
 !     :           'appel_stewart_vectall 1118')
-!               endif !if (izone.eq.izone_cond) THEN
-!             endif   !if ((option_traceurs.eq.17).or.
+!               endif !if (izone.EQ.izone_cond) THEN
+!             endif   !if ((option_traceurs.EQ.17).OR.
            enddo !do il=1,ncas_evap_liq
        endif !if (iso_eau.gt.0) THEN
@@ -7106,14 +7106,14 @@
               'appel stewart 745')
         enddo !do ixt=1,niso
-!        if ((option_traceurs.eq.17).or.(option_traceurs.eq.18)) THEN
-!            if (izone.eq.izone_cond) THEN
+!        if ((option_traceurs.EQ.17).OR.(option_traceurs.EQ.18)) THEN
+!            if (izone.EQ.izone_cond) THEN
 !              CALL iso_verif_positif(xtwater_cas(iso_eau,il)
 !     :           -xtwater(iso_eau,cas_evap_liq(il),i),
 !     :           'appel_stewart_vectall 1138')
-!            else !if (izone.eq.izone_cond) THEN
+!            else !if (izone.EQ.izone_cond) THEN
 !                CALL iso_verif_positif(-xtwater_cas(iso_eau,il),
 !     :           'appel_stewart_vectall 1147')
-!            endif !if (izone.eq.izone_cond) THEN
-!        endif !if ((option_traceurs.eq.17).or.        
+!            endif !if (izone.EQ.izone_cond) THEN
+!        endif !if ((option_traceurs.EQ.17).OR.
       enddo !do il=1,ncas_evap_liq
 #endif       
@@ -7133,10 +7133,10 @@
        do il=1,ncas_evap_liq
            
-           if (iso_verif_traceur_nostop(xtp(1,cas_evap_liq(il),i), &
-                'appel_stewart_vectall 1256').eq.1) THEN
+           IF (iso_verif_traceur_nostop(xtp(1,cas_evap_liq(il),i), &
+                'appel_stewart_vectall 1256').EQ.1) THEN
              WRITE(*,*) 'il,cas_evap_liq(il)=',il,cas_evap_liq(il)
              WRITE(*,*) 'trace_cas(cas_evap_liq(il))=', &
                 trace_cas(cas_evap_liq(il))
-             if (trace_cas(cas_evap_liq(il)).eq.31) THEN
+             IF (trace_cas(cas_evap_liq(il)).EQ.31) THEN
                  WRITE(*,*) 'cas evap_liq'
                  WRITE(*,*) 'xtp(:,cas_evap_liq(il),i)=', &
@@ -7154,5 +7154,5 @@
                  WRITE(*,*) 'h(il)=',thumxt1+(1.0-thumxt1)* &
                         qp_avantevap_cas(il)/qs_cas(il)
-             endif !if (trace_cas(il).eq.31) THEN
+             endif !if (trace_cas(il).EQ.31) THEN
                 ! en cas de problème ci, activer l'option débug de
                 ! stewart_explicit
@@ -7180,5 +7180,5 @@
                 ! ****** traitement vectoriel du cas 3.2
 
-      if (ncas_evap_glace.gt.0) THEN
+      IF (ncas_evap_glace.gt.0) THEN
       CALL compress_evap_glace(30, &
          ncas_evap_glace,cas_evap_glace, &
@@ -7233,5 +7233,5 @@
               'appel_stewart 914: compression evap_glace', &
                 errmax,errmax)
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite_choix( &
               (xtp_avantevap_cas(iso_eau,il)), &
@@ -7274,5 +7274,5 @@
 
        ! initialisation dans le cas où la revap est taggée:
-       if (option_revap.eq.1) THEN
+       IF (option_revap.EQ.1) THEN
          do il=1,ncas_evap_glace   
            do iiso=1,niso
@@ -7283,5 +7283,5 @@
            enddo  !do iiso=1,niso  
          enddo !do il=1,ncas_evap_glace  
-       endif !if (option_revap.eq.1) THEN
+       endif !if (option_revap.EQ.1) THEN
        do izone=1,ntraceurs_zone
 !       WRITE(*,*) 'tmp appel_stewart 1284: izone=',izone
@@ -7347,6 +7347,6 @@
 !     :           (1:ntraciso,cas_evap_glace(il))
 !           WRITE(*,*) 'xtp=',xtp(1:ntraciso,cas_evap_glace(il),i)
-           if (iso_verif_traceur_nostop(xtp(1,cas_evap_glace(il),i), &
-                'appel_stewart_vectall 1314').eq.1) THEN
+           IF (iso_verif_traceur_nostop(xtp(1,cas_evap_glace(il),i), &
+                'appel_stewart_vectall 1314').EQ.1) THEN
              WRITE(*,*) 'il,cas_evap_glace(il)=',il,cas_evap_glace(il)
              WRITE(*,*) 'trace_cas(cas_evap_glace(il))=', &
@@ -7382,5 +7382,5 @@
 #ifdef ISOVERIF
         do il=1,ncum 
-           if (i.le.inb(il) .and. lwork(il)) THEN
+           IF (i.le.inb(il) .AND. lwork(il)) THEN
 !             WRITE(*,*) 'appel_stewart 1380 temp: il,trace_cas(il)=',
 !     &          il,trace_cas(il)  
@@ -7393,26 +7393,26 @@
                         'appel_stewart 1661')
              enddo !do ixt=1,ntraciso
-             if (iso_eau.gt.0) THEN
-              if (iso_verif_egalite_choix_nostop(xtwater(iso_eau,il,i), &
+             IF (iso_eau.gt.0) THEN
+              IF (iso_verif_egalite_choix_nostop(xtwater(iso_eau,il,i), &
               water(il,i),'appel stewart 1277, fin, water', &
-              errmax,errmaxrel).eq.1) THEN
+              errmax,errmaxrel).EQ.1) THEN
                WRITE(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
                stop 
               endif  !if (iso_verif_egalite_choix_nostop(  
-              if (iso_verif_egalite_choix_nostop( &
+              IF (iso_verif_egalite_choix_nostop( &
               xtp(iso_eau,il,i),qp(il,i),'appel stewart 1278', &
-              errmax,errmaxrel*50).eq.1) THEN
+              errmax,errmaxrel*50).EQ.1) THEN
                WRITE(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
                stop 
               endif  !if (iso_verif_egalite_choix_nostop(
-              if (iso_verif_egalite_choix_nostop( &
+              IF (iso_verif_egalite_choix_nostop( &
               xtevap(iso_eau,il,i),evap(il,i), &
               'appel stewart 1279', &
-              errmax,errmaxrel).eq.1) THEN
+              errmax,errmaxrel).EQ.1) THEN
                WRITE(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
                stop 
               endif  !if (iso_verif_egalite_choix_nostop(
              endif !if (iso_eau.gt.0) THEN
-             if ((iso_HDO.gt.0).and. &
+             IF ((iso_HDO.gt.0).AND. &
                 (qp(il,i).gt.ridicule)) THEN
                 CALL iso_verif_aberrant( &
@@ -7421,5 +7421,5 @@
              endif  ! if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
-!           if (il.eq.602) THEN
+!           if (il.EQ.602) THEN
 !              WRITE(*,*) 'appel_stewart 1334: il,i=',il,i
 !              WRITE(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
@@ -7432,22 +7432,22 @@
            CALL iso_verif_traceur(xtwater(1,il,i), &
                 'appel_stewart_vectall 1636')
-!           if ((option_traceurs.eq.17).or.
-!     &          (option_traceurs.eq.18)) THEN
+!           if ((option_traceurs.EQ.17).OR.
+!     &          (option_traceurs.EQ.18)) THEN
 !            if (iso_verif_positif_nostop(xtwater(
 !     &          index_trac(izone_cond,iso_eau),il,i)
 !     &          -xtwater(iso_eau,il,i),
-!     &          'appel_stewart_vectall 1457').eq.1) THEN
+!     &          'appel_stewart_vectall 1457').EQ.1) THEN
 !             WRITE(*,*) 'il,trace_cas=',il,trace_cas(il)
 !             stop
 !            endif !if (iso_verif_positif_nostop(xtwater(iso_eau,il,i)-
-!           endif !if ((option_traceurs.eq.17).or.
+!           endif !if ((option_traceurs.EQ.17).OR.
 #endif  
-           endif !if (i.le.inb(il) .and. lwork(il)) THEN
+           endif !if (i.le.inb(il) .AND. lwork(il)) THEN
         enddo !do il=1,ncum 
 #endif
 
-       if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+       IF ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
          do il=1,ncum 
-           if (i.le.inb(il) .and. lwork(il)) THEN
+           IF (i.le.inb(il) .AND. lwork(il)) THEN
              xtwater(iso_eau,il,i)= water(il,i)
              xtp(iso_eau,il,i)=qp(il,i) 
@@ -7465,5 +7465,5 @@
 #endif            
 #endif             
-           endif !if (i.le.inb(il) .and. lwork(il)) THEN
+           endif !if (i.le.inb(il) .AND. lwork(il)) THEN
           enddo !do il=1,ncum  
         endif !if (bidouille_anti_divergence) THEN
@@ -7494,7 +7494,7 @@
 
         ! inputs
-        integer ncas
-        real ztglace_kelvin
-        real T_cas(ncas),delP_cas(ncas), &
+        INTEGER ncas
+        REAL ztglace_kelvin
+        REAL T_cas(ncas),delP_cas(ncas), &
                 xtevapsup_cas(niso,ncas),water_cas(ncas)
         real  qp_avantevap_cas(ncas), &
@@ -7502,23 +7502,23 @@
         Pqisup_cas(ncas), Pxtisup_cas(niso,ncas),  &
         Eqi_prime_cas(ncas),fac_ftmr_cas(ncas)
-         real g,sigd(ncas)                  
-#ifdef ISOVERIF
-         real evap_cas(ncas),qp_cas(ncas)
-         integer oktrac
+         REAL g,sigd(ncas)
+#ifdef ISOVERIF
+         REAL evap_cas(ncas),qp_cas(ncas)
+         INTEGER oktrac
 #endif         
 
         ! outputs
-        real xtevap_cas(niso,ncas),xtp_cas(niso,ncas), &
+        REAL xtevap_cas(niso,ncas),xtp_cas(niso,ncas), &
                  xtwater_cas(niso,ncas)
 
         ! locals
-        real Risup(niso,ncas), Rcond(niso,ncas)
-        real xtice(ntraciso,ncas), xtliq(ntraciso,ncas)
-        real xtp0(ntraciso,ncas), qp0(ncas)
+        REAL Risup(niso,ncas), Rcond(niso,ncas)
+        REAL xtice(ntraciso,ncas), xtliq(ntraciso,ncas)
+        REAL xtp0(ntraciso,ncas), qp0(ncas)
         ! rq: xtice,xtliq,xtp0 sont de dimension ntraciso car condiso_liq_ice_vectall prend des choses de dimension ntraciso. Mais c'est une perte de mémoire. Seuls les premiers niso sont utilisés
-        real fcond(ncas), fice(ncas), cond(ncas)
-        real Exi_prime(niso,ncas)
-        integer il,ixt
-        real zxtalphal,zxtalphai
+        REAL fcond(ncas), fice(ncas), cond(ncas)
+        REAL Exi_prime(niso,ncas)
+        INTEGER il,ixt
+        REAL zxtalphal,zxtalphai
 !#ifdef ISOVERIF
 !        real 
@@ -7531,5 +7531,5 @@
        do il=1,ncas
 #ifdef ISOVERIF
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix( &
                 (xtp_avantevap_cas(iso_eau,il)), &
@@ -7539,9 +7539,9 @@
          CALL iso_verif_noNaN((Eqi_prime_cas(il)), &
                 'appel_stewart 1357a')
-         if (iso_verif_noNaN_nostop((fac_ftmr_cas(il)), &
-                'appel_stewart 1357b').eq.1) THEN
+         IF (iso_verif_noNaN_nostop((fac_ftmr_cas(il)), &
+                'appel_stewart 1357b').EQ.1) THEN
             WRITE(*,*) 'il=',il
          endif
-!         if (il.eq.1) THEN
+!         if (il.EQ.1) THEN
 !         WRITE(*,*) 'Eqi_prime_cas=',Eqi_prime_cas(il)
 !         WRITE(*,*) 'fac_ftmr_cas=',fac_ftmr_cas(il)
@@ -7551,6 +7551,6 @@
 #endif   
         
-        if ((Eqi_prime_cas(il).gt.-ridicule*1e-2).and.    & 
-           (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.-ridicule*10).and. &
+        IF ((Eqi_prime_cas(il).gt.-ridicule*1e-2).AND.    &
+           (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.-ridicule*10).AND. &
            (Pqisup_cas(il).le.0.0)) THEN
           fcond(il)=1.0
@@ -7560,5 +7560,5 @@
 !     &         il,cond(il),Eqi_prime_cas(il),fac_ftmr_cas(il)
 !#endif          
-        else !if ((Eqi_prime_cas(il).gt.-ridicule*1e-2).and.    
+        else !if ((Eqi_prime_cas(il).gt.-ridicule*1e-2).AND.
          fcond(il)=-Eqi_prime_cas(il)/(Pqisup_cas(il)-Eqi_prime_cas(il))
          cond(il)=-Eqi_prime_cas(il)*fac_ftmr_cas(il)
@@ -7570,5 +7570,5 @@
         endif
 
-         if (T_cas(il).ge.ztglace_kelvin) THEN
+         IF (T_cas(il).ge.ztglace_kelvin) THEN
                fice(il)=0.0
          else
@@ -7576,5 +7576,5 @@
          endif 
 
-         if (cond(il).gt.qp_avantevap_cas(il)) THEN
+         IF (cond(il).gt.qp_avantevap_cas(il)) THEN
              ! dans ce cas, qp doit être nul. on vérifie et si oui, on
              ! met cond=qp_avantevap_cas
@@ -7590,5 +7590,5 @@
               enddo !do ixt=1,niso  
          else ! if (cond(il).gt.qp_avantevap_cas(il)) THEN
-           if (cond(il).lt.1e-11) THEN
+           IF (cond(il).lt.1e-11) THEN
               ! pour des raisons numériques, ça ne marchera pas
               cond(il)=cond(il)*1e4
@@ -7614,6 +7614,6 @@
 #endif
 #ifdef ISOVERIF     
-         if (iso_verif_positif_nostop(qp0(il)-cond(il), &
-                'appel_stewart 1664').eq.1) THEN
+         IF (iso_verif_positif_nostop(qp0(il)-cond(il), &
+                'appel_stewart 1664').EQ.1) THEN
            WRITE(*,*) 'il,qp0,cond=',il,qp0(il),cond(il)
            WRITE(*,*) 'qp_avantevap_cas,qp_cas=', &
@@ -7624,5 +7624,5 @@
            stop
          endif
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(xtp0(iso_eau,il), &
                 qp0(il),'appel_stewart 1353',errmax,errmaxrel)
@@ -7636,9 +7636,9 @@
 
         do il=1,ncas
-          if (cond(il).gt.ridicule*1e-2) THEN
+          IF (cond(il).gt.ridicule*1e-2) THEN
             do ixt=1,niso
               Rcond(ixt,il)=(xtice(ixt,il)+xtliq(ixt,il))/cond(il)
             enddo !do ixt=1,niso
-          else if ((cond(il).gt.0.0).and.(qp0(il).gt.ridicule)) THEN
+          ELSE IF ((cond(il).gt.0.0).AND.(qp0(il).gt.ridicule)) THEN
             do ixt=1,niso
               CALL fractcalk(ixt,T_cas(il),zxtalphal,zxtalphai)
@@ -7655,8 +7655,8 @@
 
 #ifdef ISOVERIF 
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
          do il=1,ncas
 !           WRITE(*,*) 'tmp il,cond(il)=',il ,cond(il)
-          if (cond(il).gt.errmax/50) THEN
+          IF (cond(il).gt.errmax/50) THEN
               CALL iso_verif_egalite_choix( &
                (Rcond(iso_eau,il)),1.0, &
@@ -7669,5 +7669,5 @@
           ! le 30 avril 2012: on remplace 0 par ridicule*1e-2
           ! le 2 juillet 2012: on remplace ridicule*1e-2 par ridicule*1e-4
-          if (Pqisup_cas(il).gt.ridicule*1e-4) THEN
+          IF (Pqisup_cas(il).gt.ridicule*1e-4) THEN
              do ixt=1,niso
                Risup(ixt,il)=Pxtisup_cas(ixt,il)/Pqisup_cas(il)
@@ -7697,8 +7697,8 @@
 
           do ixt=1,niso
-            if ((iso_verif_noNaN_nostop((Rcond(ixt,il)), &
-               'appel_stewart 1482, cas 1.1, Rcond').eq.1).or. &
+            IF ((iso_verif_noNaN_nostop((Rcond(ixt,il)), &
+               'appel_stewart 1482, cas 1.1, Rcond').EQ.1).OR. &
                (iso_verif_noNaN_nostop((Risup(ixt,il)), &
-               'appel_stewart 1484, cas 1.1, Risup').eq.1)) THEN
+               'appel_stewart 1484, cas 1.1, Risup').EQ.1)) THEN
                WRITE(*,*) 'ixt,il=',ixt,il
                WRITE(*,*) 'Pxtisup_cas(ixt,il)=',Pxtisup_cas(ixt,il)
@@ -7759,6 +7759,6 @@
           do il=1,ncas
              do ixt=1,niso
-              if (iso_verif_noNaN_nostop(xtwater_cas(ixt,il), &
-                'appel_stewart 1487').eq.1) THEN
+              IF (iso_verif_noNaN_nostop(xtwater_cas(ixt,il), &
+                'appel_stewart 1487').EQ.1) THEN
                 WRITE(*,*) 'ixt,il=',ixt,il
                 WRITE(*,*) 'water_cas(il)=',water_cas(il)
@@ -7778,10 +7778,10 @@
 #endif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             do il=1,ncas
               CALL iso_verif_egalite_choix(xtwater_cas(iso_eau,il), &
                 water_cas(il),'appel_stewart 262, cas 1.1', &
                 errmax,errmaxrel)
-              if ((xtwater_cas(iso_eau,il).eq.0.0).and. &
+              IF ((xtwater_cas(iso_eau,il).EQ.0.0).AND. &
                 (water_cas(il).gt.ridicule)) THEN
                WRITE(*,*) 'appel_stewart 1535, cas 1.1, il=',il
@@ -7796,13 +7796,13 @@
                stop
               endif
-              if (oktrac.eq.0) THEN
+              IF (oktrac.EQ.0) THEN
              CALL iso_verif_egalite_choix(xtp_cas(iso_eau,il), &
                 qp_cas(il), &
                 'appel_stewart 269, cas 1.1', &
                 errmax,errmaxrel)
-              if (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il), &
+              IF (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il), &
                 evap_cas(il), &
                 'appel_stewart 275, cas 1.1', &
-                errmax,errmaxrel).eq.1) THEN
+                errmax,errmaxrel).EQ.1) THEN
 !                WRITE(*,*) 'il,cas_condensation_facftmr(il)=',
 !     &                  il,cas_condensation_facftmr(il)
@@ -7816,11 +7816,11 @@
                 stop
               endif !if (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il),
-              endif ! if (oktrac.eq.0) THEN
+              endif ! if (oktrac.EQ.0) THEN
              enddo !do il=1,ncas_condensation_facftmr  
             endif ! if (iso_eau.gt.0) THEN
-            if (oktrac.eq.0) THEN
-            if (iso_HDO.gt.0) THEN
+            IF (oktrac.EQ.0) THEN
+            IF (iso_HDO.gt.0) THEN
              do il=1,ncas 
-              if (qp_cas(il).gt.ridicule) THEN
+              IF (qp_cas(il).gt.ridicule) THEN
                 CALL iso_verif_aberrant(xtp_cas(iso_HDO,il)/ &
                 qp_cas(il), 'appel_stewart 613')
@@ -7828,8 +7828,8 @@
              enddo !do il=1,ncas
             endif  ! if (iso_HDO.gt.0) THEN
-           else !if (oktrac.eq.0) THEN
-             if ((iso_HDO.gt.0).and.(iso_eau.gt.0)) THEN
+           else !if (oktrac.EQ.0) THEN
+             IF ((iso_HDO.gt.0).AND.(iso_eau.gt.0)) THEN
               do il=1,ncas
-               if (xtp_cas(iso_eau,il).gt.ridicule) THEN
+               IF (xtp_cas(iso_eau,il).gt.ridicule) THEN
                 CALL iso_verif_aberrant(xtp_cas(iso_HDO,il)/ &
                 xtp_cas(iso_eau,il), &
@@ -7838,5 +7838,5 @@
                enddo ! do il=1,ncas
               endif  ! if (iso_HDO.gt.0) THEN
-           endif  !if (oktrac.eq.0) THEN
+           endif  !if (oktrac.EQ.0) THEN
 #endif   
 
@@ -7861,7 +7861,7 @@
 
         ! inputs
-        integer ncas
-        real ztglace_kelvin
-        real T_cas(ncas),delP_cas(ncas), &
+        INTEGER ncas
+        REAL ztglace_kelvin
+        REAL T_cas(ncas),delP_cas(ncas), &
                 xtevapsup_cas(niso,ncas),water_cas(ncas), &
                 q_cas(ncas),xt_cas(niso,ncas)
@@ -7870,26 +7870,26 @@
         Pqisup_cas(ncas), Pxtisup_cas(niso,ncas),  &
         Eqi_prime_cas(ncas)
-         real g,sigd_cas(ncas)
+         REAL g,sigd_cas(ncas)
          
 #ifdef ISOVERIF
-         integer oktrac
-         real evap_cas(ncas),qp_cas(ncas)
+         INTEGER oktrac
+         REAL evap_cas(ncas),qp_cas(ncas)
 #endif
         ! outputs
-        real xtevap_cas(niso,ncas),xtp_cas(niso,ncas), &
+        REAL xtevap_cas(niso,ncas),xtp_cas(niso,ncas), &
                  xtwater_cas(niso,ncas)
 
         ! locals
-        real Risup(niso,ncas), Rcond(niso,ncas), &
+        REAL Risup(niso,ncas), Rcond(niso,ncas), &
                 Renv(niso,ncas)
-        real zxtalphal(niso,ncas), zxtalphai(niso,ncas)
-        real fcond(ncas)
-        real Exi_prime(niso,ncas)
-        integer il,ixt
+        REAL zxtalphal(niso,ncas), zxtalphai(niso,ncas)
+        REAL fcond(ncas)
+        REAL Exi_prime(niso,ncas)
+        INTEGER il,ixt
         !real 
 
         CALL fractcalk_vectall(T_cas,zxtalphal,zxtalphai,ncas)
         do il=1,ncas
-          if (Pqisup_cas(il)-Eqi_prime_cas(il).gt.0.0) THEN
+          IF (Pqisup_cas(il)-Eqi_prime_cas(il).gt.0.0) THEN
             fcond(il)=-Eqi_prime_cas(il) &
                 /(Pqisup_cas(il)-Eqi_prime_cas(il))
@@ -7897,10 +7897,10 @@
               fcond(il)=1.0
           endif
-          if (qp_avantevap_cas(il).gt.0) THEN
+          IF (qp_avantevap_cas(il).gt.0) THEN
              do ixt=1,niso  
                Renv(ixt,il)=xtp_avantevap_cas(ixt,il) &
                 /qp_avantevap_cas(il)
              enddo !do ixt=1,niso  
-          else if (q_cas(il).gt.0.0) then !if (qp_avantevap_cas(il).gt.0) THEN
+          ELSE IF (q_cas(il).gt.0.0) then !if (qp_avantevap_cas(il).gt.0) THEN
              do ixt=1,niso  
                Renv(ixt,il)=xt_cas(ixt,il)/q_cas(il)
@@ -7919,5 +7919,5 @@
          enddo !do il=1,ncas
          do il=1,ncas
-           if (T_cas(il).ge.ztglace_Kelvin) THEN
+           IF (T_cas(il).ge.ztglace_Kelvin) THEN
              do ixt=1,niso
               Rcond(ixt,il)=zxtalphal(ixt,il)*Renv(ixt,il)
@@ -7930,5 +7930,5 @@
          enddo !do il=1,ncas
         do il=1,ncas
-          if (Pqisup_cas(il).gt.0.0) THEN
+          IF (Pqisup_cas(il).gt.0.0) THEN
              do ixt=1,niso
                Risup(ixt,il)=Pxtisup_cas(ixt,il)/Pqisup_cas(il)
@@ -7945,5 +7945,5 @@
          enddo !do il=1,ncas
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
           do il=1,ncas
              CALL iso_verif_egalite_choix( &
@@ -7986,6 +7986,6 @@
               CALL iso_verif_noNAN(xtp_cas(ixt,il), &
                         'appel stewart 265.12: cas 1.2')
-              if (iso_verif_noNAN_nostop(xtevap_cas(ixt,il), &
-                'appel_stewart 286.12: cas 1.2, xtevap').eq.1) THEN
+              IF (iso_verif_noNAN_nostop(xtevap_cas(ixt,il), &
+                'appel_stewart 286.12: cas 1.2, xtevap').EQ.1) THEN
                 WRITE(*,*) 'ixt,il=',ixt,il
                 WRITE(*,*) 'Exi_prime(ixt,il)=',Exi_prime(ixt,il)
@@ -7999,5 +7999,5 @@
             enddo !do ixt=1,niso   
           enddo !do il=1,ncas    
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             do il=1,ncas 
               CALL iso_verif_egalite_choix(xtwater_cas(iso_eau,il), &
@@ -8005,5 +8005,5 @@
                 'appel_stewart 262.12, cas 1.2', &
                 errmax,errmaxrel)
-              if ((xtwater_cas(iso_eau,il).eq.0).and. &
+              IF ((xtwater_cas(iso_eau,il).EQ.0).AND. &
                 (water_cas(il).gt.ridicule)) THEN
                WRITE(*,*) 'appel_stewart 263.12, cas 1.2'
@@ -8013,5 +8013,5 @@
                stop
               endif
-              if (oktrac.eq.0) THEN
+              IF (oktrac.EQ.0) THEN
               CALL iso_verif_egalite_choix(xtp_cas(iso_eau,il), &
                 qp_cas(il) &
@@ -8020,11 +8020,11 @@
                 evap_cas(il),'appel_stewart 275.12, cas 1.2', &
                 errmax,errmaxrel)
-              endif !if (oktrac.eq.0) THEN
+              endif !if (oktrac.EQ.0) THEN
              enddo !do il=1,ncas
             endif ! if (iso_eau.gt.0) THEN
-            if (oktrac.eq.0) THEN
-            if (iso_HDO.gt.0) THEN
+            IF (oktrac.EQ.0) THEN
+            IF (iso_HDO.gt.0) THEN
              do il=1,ncas
-              if (qp_cas(il).gt.ridicule) THEN
+              IF (qp_cas(il).gt.ridicule) THEN
                 CALL iso_verif_aberrant(xtp_cas(iso_HDO,il)/ &
                 qp_cas(il), &
@@ -8033,8 +8033,8 @@
               enddo ! do il=1,ncas
             endif  ! if (iso_HDO.gt.0) THEN
-           else !if (oktrac.eq.0) THEN
-             if ((iso_HDO.gt.0).and.(iso_eau.gt.0)) THEN
+           else !if (oktrac.EQ.0) THEN
+             IF ((iso_HDO.gt.0).AND.(iso_eau.gt.0)) THEN
               do il=1,ncas
-               if (xtp_cas(iso_eau,il).gt.ridicule) THEN
+               IF (xtp_cas(iso_eau,il).gt.ridicule) THEN
                 CALL iso_verif_aberrant(xtp_cas(iso_HDO,il)/ &
                 xtp_cas(iso_eau,il), &
@@ -8043,5 +8043,5 @@
                enddo ! do il=1,ncas
               endif  ! if (iso_HDO.gt.0) THEN
-           endif !if (oktrac.eq.0) THEN
+           endif !if (oktrac.EQ.0) THEN
 #endif
 
@@ -8065,20 +8065,20 @@
 
         ! inputs
-        integer ncas
-        real xtevapsup_cas(niso,ncas),water_cas(ncas)
+        INTEGER ncas
+        REAL xtevapsup_cas(niso,ncas),water_cas(ncas)
         real  xtp_avantevap_cas(niso,ncas), &
         Pqisup_cas(ncas), Pxtisup_cas(niso,ncas)
 #ifdef ISOVERIF        
-        real evap_cas(ncas),qp_cas(ncas)
-        integer oktrac ! si traceurs, certaines verifs ne sont pas
+        REAL evap_cas(ncas),qp_cas(ncas)
+        INTEGER oktrac ! si traceurs, certaines verifs ne sont pas
                 !valides
 #endif
         ! outputs
-        real xtevap_cas(niso,ncas),xtp_cas(niso,ncas), &
+        REAL xtevap_cas(niso,ncas),xtp_cas(niso,ncas), &
                  xtwater_cas(niso,ncas)
 
         ! locals
-        real Risup(niso,ncas)
-        integer il,ixt
+        REAL Risup(niso,ncas)
+        INTEGER il,ixt
         !real 
 
@@ -8094,5 +8094,5 @@
 #ifdef ISOVERIF       
        do il=1,ncas
-        if ((Pqisup_cas(il).le.0.0).and. &
+        IF ((Pqisup_cas(il).le.0.0).AND. &
                 (water_cas(il).gt.ridicule*10)) THEN
             ! 27 mai 2009: on est plus laxiste dans le cas des traceurs
@@ -8103,5 +8103,5 @@
             stop
          endif
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix( &
                 (Pxtisup_cas(iso_eau,il)), &
@@ -8114,5 +8114,5 @@
 #endif        
         do il=1,ncas
-         if (Pqisup_cas(il).gt.0.0) THEN
+         IF (Pqisup_cas(il).gt.0.0) THEN
             do ixt=1,niso  
               Risup(ixt,il)=Pxtisup_cas(ixt,il)/Pqisup_cas(il)
@@ -8137,10 +8137,10 @@
             enddo !do ixt=1,niso   
           enddo !do il=1,ncas_noevap     
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             do il=1,ncas
               CALL iso_verif_egalite_choix(xtwater_cas(iso_eau,il), &
                 water_cas(il),'appel_stewart 262.2, cas 1.1', &
                 errmax,errmaxrel)
-              if ((xtwater_cas(iso_eau,il).eq.0).and. &
+              IF ((xtwater_cas(iso_eau,il).EQ.0).AND. &
                 (water_cas(il).gt.ridicule)) THEN
                WRITE(*,*) 'appel_stewart 263.2, cas 1.1'
@@ -8149,5 +8149,5 @@
                stop
               endif
-              if (oktrac.eq.0) THEN
+              IF (oktrac.EQ.0) THEN
 !                  WRITE(*,*) 'appel_stewart 1743 noevap tmp: il=',il
              CALL iso_verif_egalite_choix(xtp_cas(iso_eau,il), &
@@ -8158,11 +8158,11 @@
                 'appel_stewart 275.2, cas 1.1', &
                 errmax,errmaxrel)
-             endif !if (oktrac.eq.0) THEN
+             endif !if (oktrac.EQ.0) THEN
              enddo !do il=1,ncas
             endif ! if (iso_eau.gt.0) THEN
-            if (oktrac.eq.0) THEN
-            if (iso_HDO.gt.0) THEN
+            IF (oktrac.EQ.0) THEN
+            IF (iso_HDO.gt.0) THEN
               do il=1,ncas
-                if (qp_cas(il).gt.ridicule) THEN
+                IF (qp_cas(il).gt.ridicule) THEN
                 CALL iso_verif_aberrant( &
                 xtp_cas(iso_HDO,il)/qp_cas(il), &
@@ -8171,5 +8171,5 @@
               enddo !do il=1,ncas 
             endif  ! if (iso_HDO.gt.0) THEN
-            endif !if (oktrac.eq.0) THEN
+            endif !if (oktrac.EQ.0) THEN
 #endif           
 
@@ -8203,8 +8203,8 @@
 
         ! inputs
-        integer ncas
-        real xtp_avantevap_cas(niso,ncas), &
+        INTEGER ncas
+        REAL xtp_avantevap_cas(niso,ncas), &
                 qp_avantevap_cas(ncas)
-        real xtp_avantevaptrac_cas(niso,ncas), &
+        REAL xtp_avantevaptrac_cas(niso,ncas), &
                 qp_avantevaptrac_cas(ncas)
         ! dans le cas des traceurs: xtp_avantevaptrac_cas est la
@@ -8213,22 +8213,22 @@
         ! on rééquilibre la goutte avec le total de toutes les zones,
         ! mais c'est xtp_avantevaptrac_cas qui recoit l'évap
-        real Pqisup_cas(ncas), Pxtisup_cas(niso,ncas)
-        real Pqiinf_stewart(ncas), Eqi_stewart(ncas)
-        real fac_ftmr_cas(ncas),Eqi_prime_cas(ncas)
-        real T_cas(ncas),delP_cas(ncas), &
+        REAL Pqisup_cas(ncas), Pxtisup_cas(niso,ncas)
+        REAL Pqiinf_stewart(ncas), Eqi_stewart(ncas)
+        REAL fac_ftmr_cas(ncas),Eqi_prime_cas(ncas)
+        REAL T_cas(ncas),delP_cas(ncas), &
                 xtevapsup_cas(niso,ncas), &
                 wt_cas(ncas),qeff(ncas), &
                 qs_cas(ncas),water_cas(ncas), &
                 qp_cas(ncas)
-        integer oktrac      
+        INTEGER oktrac
 #ifdef ISOTRAC        
-        real ptrac(ncas)  
-        real hdiag(ncas)
+        REAL ptrac(ncas)
+        REAL hdiag(ncas)
 #endif        
 #ifdef ISOVERIF        
-        real evap_cas(ncas)   
+        REAL evap_cas(ncas)
 #endif        
-        integer INB_cas(ncas),i
-        real g,sigd(ncas)
+        INTEGER INB_cas(ncas),i
+        REAL g,sigd(ncas)
         ! outputs
         real  xtp_cas(niso,ncas),xtwater_cas(niso,ncas), &
@@ -8236,8 +8236,8 @@
 
         ! locals        
-        integer il,ixt        
-        real Pxtiinf_stewart(niso,ncas),  &
+        INTEGER il,ixt
+        REAL Pxtiinf_stewart(niso,ncas),  &
                 Exi_stewart(niso,ncas)
-        real xtnew(niso,ncas)
+        REAL xtnew(niso,ncas)
 !#ifdef ISOVERIF
 !        integer iso_verif_egalite_choix_nostop
@@ -8255,5 +8255,5 @@
 !     :           qp_avantevap_cas(162)
 !        endif !if (ncas_evap_liq.ge.162) THEN
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
           do il=1,ncas
 !            WRITE(*,*) 'appel tmp 1492: il=',il
@@ -8277,10 +8277,10 @@
 #ifdef ISOTRAC       
        ! à l'avenir, il faudra faire les choses plus proprement!
-       if (oktrac.eq.1) THEN
+       IF (oktrac.EQ.1) THEN
            ! on renormalise le flux de précip et d'évap
            ! on suppose que la seule différence entre les différentes
            ! zones, c'est la compo du liquide
            do il=1,ncas
-            if (ptrac(il).gt.1e-20) THEN
+            IF (ptrac(il).gt.1e-20) THEN
              Pqisup_cas(il)=Pqisup_cas(il)/ptrac(il)
              Eqi_stewart(il)=Eqi_stewart(il)/ptrac(il)
@@ -8306,9 +8306,9 @@
             endif !if (ptrac(il).gt.0.0) THEN
            enddo !do il=1,ncas
-       endif !if (oktrac.eq.1) THEN
+       endif !if (oktrac.EQ.1) THEN
 #endif       
         
 
-        if (no_pce.eq.1) THEN
+        IF (no_pce.EQ.1) THEN
             CALL stewart_sublim_nofrac_vectall( &
              ncas,qp_avantevap_cas(1), &
@@ -8317,5 +8317,5 @@
              Pxtiinf_stewart(1,1),xtnew(1,1),Exi_stewart(1,1), &
              fac_ftmr_cas(1))
-        else !if (no_pce.eq.1) THEN
+        else !if (no_pce.EQ.1) THEN
       CALL stewart_explicite_vectall(ncas, &
              qp_avantevap_cas(1),xtp_avantevap_cas(1,1), &
@@ -8329,8 +8329,8 @@
 #endif
         )
-         endif !if (no_pce.eq.1) THEN
+         endif !if (no_pce.EQ.1) THEN
 #ifdef ISOTRAC      
       ! à l'avenir, il faudra faire les choses plus proprement!
-      if (oktrac.eq.1) THEN
+      IF (oktrac.EQ.1) THEN
            ! on renormalise le flux de précip et d'évap
            ! on suppose que la seule différence entre les différentes
@@ -8349,9 +8349,9 @@
              hdiag(il)=qeff(il)/qs_cas(il)
            enddo !do il=1,ncas
-       endif !if (oktrac.eq.1) THEN
-#endif
-
-#ifdef ISOVERIF
-       if (iso_eau.gt.0) THEN
+       endif !if (oktrac.EQ.1) THEN
+#endif
+
+#ifdef ISOVERIF
+       IF (iso_eau.gt.0) THEN
           do il=1,ncas     
                 CALL iso_verif_egalite_choix( &
@@ -8365,5 +8365,5 @@
                 'appel_stewart 586', &
                 errmax,errmaxrel)
-                if (Pqiinf_stewart(il).gt.ridicule) THEN
+                IF (Pqiinf_stewart(il).gt.ridicule) THEN
                   CALL iso_verif_egalite_choix(( &
                    Pxtiinf_stewart(iso_eau,il)/Pqiinf_stewart(il)), &
@@ -8388,10 +8388,10 @@
         ! qui sort de la boite i (Pqiinf_par)
         do il=1,ncas
-          if (abs(water_cas(il)).lt.ridicule/10.) THEN
+          IF (abs(water_cas(il)).lt.ridicule/10.) THEN
             do ixt=1,niso
                xtwater_cas(ixt,il)=0.0
             enddo !do ixt=1,niso
-          else !if (water(il,i).eq.0.0) THEN
-             if (Pqiinf_stewart(il).gt.0.0) then  !if (Pxtiinf_par(iso_eau).gt.0.0) THEN
+          else !if (water(il,i).EQ.0.0) THEN
+             IF (Pqiinf_stewart(il).gt.0.0) then  !if (Pxtiinf_par(iso_eau).gt.0.0) THEN
                do ixt=1,niso 
                  xtwater_cas(ixt,il)=water_cas(il) &
@@ -8405,5 +8405,5 @@
                 enddo !do ixt=1,niso
              endif
-           endif !if (water(il,i).eq.0.0) THEN
+           endif !if (water(il,i).EQ.0.0) THEN
          enddo !do il=1,ncas
         
@@ -8414,11 +8414,11 @@
                'appel_stewart 566')
         enddo !do ixt=1,niso
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
          CALL iso_verif_egalite_choix(xtwater_cas(iso_eau,il), &
                 water_cas(il),'appel_stewart 568',errmax,errmaxrel)
-         if (water_cas(il).gt.ridicule*10) THEN
-             if (iso_verif_egalite_choix_nostop( &
+         IF (water_cas(il).gt.ridicule*10) THEN
+             IF (iso_verif_egalite_choix_nostop( &
                 xtwater_cas(iso_eau,il)/water_cas(il),1.0, &
-                'appel stewart 155',errmax*10,errmaxrel*10).eq.1) THEN
+                'appel stewart 155',errmax*10,errmaxrel*10).EQ.1) THEN
 !               WRITE(*,*) 'i=',i
                WRITE(*,*) 'Tevap=',T_cas(il)
@@ -8442,5 +8442,5 @@
         ! calcule xtevapi.    
        do il=1,ncas
-        if (Eqi_stewart(il).gt.0.0) THEN
+        IF (Eqi_stewart(il).gt.0.0) THEN
          do ixt=1,niso          
           xtevap_cas(ixt,il)=Eqi_prime_cas(il) &
@@ -8464,12 +8464,12 @@
           CALL iso_verif_noNAN(xtevap_cas(ixt,il),'appel stewart 131')
         enddo ! do ixt=1,nisio
-        if (oktrac.eq.0) THEN
+        IF (oktrac.EQ.0) THEN
             ! dans le cas traceur, le calcul de evap_cas est plus
             ! compliqué: il faut le faire plus proprement dans
             ! compress_stewart
-        if (iso_eau.gt.0) THEN
-            if (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il), &
+        IF (iso_eau.gt.0) THEN
+            IF (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il), &
                  evap_cas(il),'appel stewart 142', &
-                errmax,errmaxrel).eq.1) THEN
+                errmax,errmaxrel).EQ.1) THEN
               WRITE(*,*) 'il=',il
               WRITE(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
@@ -8484,8 +8484,8 @@
             endif
         endif !if (iso_eau.gt.0) THEN
-        endif !if (oktrac.eq.0) THEN
+        endif !if (oktrac.EQ.0) THEN
 #ifdef ISOTRAC
-        if (oktrac.eq.1) THEN
-        if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) THEN
+        IF (oktrac.EQ.1) THEN
+        IF ((iso_eau.gt.0).AND.(iso_HDO.gt.0)) THEN
              CALL iso_verif_aberrant_choix( &
                 (xtp_avantevaptrac_cas(iso_HDO,il)), &
@@ -8493,5 +8493,5 @@
                 ridicule_trac,deltalimtrac, &
                 'appel_stewart 2053')
-        endif !if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) THEN
+        endif !if ((iso_eau.gt.0).AND.(iso_HDO.gt.0)) THEN
         endif
 #endif
@@ -8502,7 +8502,7 @@
       
       do il=1,ncas
-       if (i.lt.INB_cas(il)) THEN
-          if (fac_ftmr_cas(il).gt.0.0) THEN
-             if (Eqi_stewart(il)*fac_ftmr_cas(il).gt.ridicule) THEN
+       IF (i.lt.INB_cas(il)) THEN
+          IF (fac_ftmr_cas(il).gt.0.0) THEN
+             IF (Eqi_stewart(il)*fac_ftmr_cas(il).gt.ridicule) THEN
                do ixt=1,niso               
                !   xtp(ixt,il,i)=xtnew(ixt)*qp(il,i)/xtnew(4)
@@ -8512,6 +8512,6 @@
                enddo !do ixt=1,niso
              else ! if (Eqi_stewart.gt.ridicule) THEN
-                if (qp_cas(il).gt.0.0) THEN
-                    if (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.ridicule) &
+                IF (qp_cas(il).gt.0.0) THEN
+                    IF (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.ridicule) &
                          THEN
                         ! il va manquer quelque chose: il faut augmenter
@@ -8545,10 +8545,10 @@
             endif !if (Eqi_stewart.gt.ridicule) THEN
 #ifdef ISOVERIF       
-!            if (il.eq.87) THEN
+!            if (il.EQ.87) THEN
 !                WRITE(*,*) 'appel_stewart 2244: tmp, après calcul xtp'
 !                WRITE(*,*) 'xtnew(:,il)=',xtnew(:,il)
 !                WRITE(*,*) 'Pxtiinf_stewart(:,il)=',
 !     :             Pxtiinf_stewart(:,il)
-!            endif  !if (il.eq.87) THEN
+!            endif  !if (il.EQ.87) THEN
             do ixt=1,niso
                 CALL iso_verif_noNAN(xtp_cas(ixt,il), &
@@ -8556,6 +8556,6 @@
             enddo ! do ixt=1,niso
 #ifdef ISOTRAC
-            if (oktrac.eq.1) THEN
-            if ((iso_HDO.gt.0).and.(iso_eau.gt.0)) THEN
+            IF (oktrac.EQ.1) THEN
+            IF ((iso_HDO.gt.0).AND.(iso_eau.gt.0)) THEN
                 ! le 10 mai 2009: on remonte le seuil de vérif de deltaD
                 ! aberrant car dans le cas des traceurs, des très
@@ -8563,8 +8563,8 @@
                 ! influencées par des évaps qui peuvent être aberantes
                 ! si ces evaps sont petites
-                if (iso_verif_aberrant_choix_nostop( &
+                IF (iso_verif_aberrant_choix_nostop( &
                 xtp_cas(iso_HDO,il),xtp_cas(iso_eau,il), &
                 ridicule_trac,deltalimtrac, &
-                'appel_stewart 2090').eq.1) THEN
+                'appel_stewart 2090').EQ.1) THEN
                   WRITE(*,*) 'xtp_avantevaptrac_cas(iso_eau),deltaD=', &
                    xtp_avantevaptrac_cas(iso_eau,il),deltaD &
@@ -8601,18 +8601,18 @@
                 endif
         endif !if (iso_HDO.gt.0) THEN
-       endif !if (oktrac.eq.1) THEN
+       endif !if (oktrac.EQ.1) THEN
 #endif
 ! #ifdef ISOTRAC
-          if (oktrac.eq.0) THEN
-            if (iso_eau.gt.0) THEN
+          IF (oktrac.EQ.0) THEN
+            IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(xtp_cas(iso_eau,il), &
               qp_cas(il),'appel stewart 688', &
                 errmax,errmaxrel*30)
            endif !if (iso_eau.gt.0) THEN
-           if ((iso_HDO.gt.0).and. &
+           IF ((iso_HDO.gt.0).AND. &
                 (qp_cas(il).gt.ridicule)) THEN
-             if (iso_verif_aberrant_nostop(xtp_cas(iso_HDO,il)/ &
+             IF (iso_verif_aberrant_nostop(xtp_cas(iso_HDO,il)/ &
               qp_cas(il), &
-              'appel_stewart_vectall 1079').eq.1) THEN
+              'appel_stewart_vectall 1079').EQ.1) THEN
                WRITE(*,*) 'i,qp(cas_evap_liq(il),i)=', &
                         i,qp_cas(il)
@@ -8623,5 +8623,5 @@
              endif
            endif !if (iso_HDO.gt.0) THEN
-        endif ! if (oktrac.eq.0) THEN
+        endif ! if (oktrac.EQ.0) THEN
 #endif              
 
@@ -8652,6 +8652,6 @@
         enddo !do ixt=1,niso
 #ifdef ISOTRAC
-        if ((iso_HDO.gt.0).and.(iso_eau.gt.0)) THEN
-          if (oktrac.eq.1) THEN
+        IF ((iso_HDO.gt.0).AND.(iso_eau.gt.0)) THEN
+          IF (oktrac.EQ.1) THEN
               CALL iso_verif_aberrant_choix( &
                 xtp_cas(iso_HDO,il),xtp_cas(iso_eau,il), &
@@ -8663,12 +8663,12 @@
       
 !#ifdef ISOTRAC
-      if (oktrac.eq.0) THEN
-      if (iso_eau.gt.0) THEN
+      IF (oktrac.EQ.0) THEN
+      IF (iso_eau.gt.0) THEN
        do il=1,ncas       
-        if (iso_verif_egalite_choix_nostop( &
+        IF (iso_verif_egalite_choix_nostop( &
                  xtp_cas(iso_eau,il), &
                  qp_cas(il), &
                 'appel stewart 197', &
-                errmax,errmaxrel*50).eq.1) THEN
+                errmax,errmaxrel*50).EQ.1) THEN
           WRITE(*,*) 'i=',i,' INB=',INB_cas(il)
           WRITE(*,*) 'Tevap=',T_cas(il)
@@ -8692,9 +8692,9 @@
         enddo !do il=1,ncas
       endif !if (iso_eau.gt.0) THEN
-      if (iso_HDO.gt.0) THEN
+      IF (iso_HDO.gt.0) THEN
        do il=1,ncas
 !        WRITE(*,*) 'appel_stewart 2166: fin make_cas_evap_liq, ',
 !     &       'il,deltaDqp=',il,deltaD(xtp_cas(iso_HDO,il)/qp_cas(il))
-        if (qp_cas(il).gt.ridicule) THEN
+        IF (qp_cas(il).gt.ridicule) THEN
           CALL iso_verif_aberrant( &
                 xtp_cas(iso_HDO,il)/qp_cas(il), &
@@ -8703,5 +8703,5 @@
        enddo !do il=1,ncas     
       endif 
-      endif ! if (oktrac.eq.0) THEN
+      endif ! if (oktrac.EQ.0) THEN
 !#endif
 ! ISOTRAC
@@ -8733,32 +8733,32 @@
 
         ! inputs
-        integer ncas
-        real xtp_avantevap_cas(niso,ncas), &
+        INTEGER ncas
+        REAL xtp_avantevap_cas(niso,ncas), &
                 qp_avantevap_cas(ncas)
-        real xtp_avantevaptrac_cas(niso,ncas), &
+        REAL xtp_avantevaptrac_cas(niso,ncas), &
                 qp_avantevaptrac_cas(ncas)
-        real Pqisup_cas(ncas), Pxtisup_cas(niso,ncas)
-        real Pqiinf_stewart(ncas), Eqi_stewart(ncas)
-        real fac_ftmr_cas(ncas),Eqi_prime_cas(ncas)
-        real T_cas(ncas),delP_cas(ncas), &
+        REAL Pqisup_cas(ncas), Pxtisup_cas(niso,ncas)
+        REAL Pqiinf_stewart(ncas), Eqi_stewart(ncas)
+        REAL fac_ftmr_cas(ncas),Eqi_prime_cas(ncas)
+        REAL T_cas(ncas),delP_cas(ncas), &
                 xtevapsup_cas(niso,ncas), &
                 wt_cas(ncas),qeff(ncas), &
                 qs_cas(ncas),water_cas(ncas)
-        real qp_cas(ncas)      
-#ifdef ISOVERIF
-        real evap_cas(ncas)
-        integer oktrac
+        REAL qp_cas(ncas)
+#ifdef ISOVERIF
+        REAL evap_cas(ncas)
+        INTEGER oktrac
 #endif        
-        real g,sigd(ncas)
-        integer frac_sublim
-        integer INB_cas(ncas),i
+        REAL g,sigd(ncas)
+        INTEGER frac_sublim
+        INTEGER INB_cas(ncas),i
         ! outputs
         real  xtp_cas(niso,ncas),xtwater_cas(niso,ncas), &
                 xtevap_cas(niso,ncas)
         ! locals        
-        integer il,ixt
-        real Pxtiinf_stewart(niso,ncas),  &
+        INTEGER il,ixt
+        REAL Pxtiinf_stewart(niso,ncas),  &
                 Exi_stewart(niso,ncas)
-        real xtnew(niso,ncas)     
+        REAL xtnew(niso,ncas)
 !#ifdef ISOVERIF
 !        real 
@@ -8770,5 +8770,5 @@
 #ifdef ISOVERIF  
 !      WRITE(*,*) 'appel_stewart 2052: entrée dans make_cas_evap_glace'
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
           do il=1,ncas
             CALL iso_verif_egalite_choix( &
@@ -8796,5 +8796,5 @@
       !    Eqi_prime sont les même que Eqi_par
 
-      if (frac_sublim.eq.1) THEN
+      IF (frac_sublim.EQ.1) THEN
             CALL stewart_glace_vectall(ncas, &
              qp_avantevap_cas(1),xtp_avantevap_cas(1,1),Pqisup_cas(1), &
@@ -8803,5 +8803,5 @@
              fac_ftmr_cas(1), &
              T_cas(1))
-      else !if (frac_sublim.eq.1) THEN
+      else !if (frac_sublim.EQ.1) THEN
 !#ifdef ISOVERIF
 !            WRITE(*,*) 'appel_stewart_explicite 2736'
@@ -8813,8 +8813,8 @@
              Pxtiinf_stewart(1,1),xtnew(1,1),Exi_stewart(1,1), &
              fac_ftmr_cas(1))
-      endif !if (frac_sublim.eq.1) THEN
+      endif !if (frac_sublim.EQ.1) THEN
 #ifdef ISOVERIF
 !       WRITE(*,*) 'appel_stewart 2096: dans make_cas_evap_glace'
-       if (iso_eau.gt.0) THEN
+       IF (iso_eau.gt.0) THEN
           do il=1,ncas       
              CALL iso_verif_egalite_choix( &
@@ -8827,9 +8827,9 @@
                 'appel_stewart 586', &
                errmax,errmaxrel)
-             if (Pqiinf_stewart(il).gt.ridicule) THEN
-                if (iso_verif_egalite_choix_nostop(( &
+             IF (Pqiinf_stewart(il).gt.ridicule) THEN
+                IF (iso_verif_egalite_choix_nostop(( &
                 Pxtiinf_stewart(iso_eau,il)/Pqiinf_stewart(il)), &
                 1.,'appel_setwart 575b', errmax*10, errmaxrel*10) &
-                 .eq.1) THEN
+                 .EQ.1) THEN
                    WRITE(*,*) 'Pqiinf_stewart(il)=',Pqiinf_stewart(il)
 !                   WRITE(*,*) 'Pqiinf_par(il)=',Pqiinf_par(il)
@@ -8847,10 +8847,10 @@
         ! qui sort de la boite i (Pqiinf_par)
         do il=1,ncas
-          if (abs(water_cas(il)).lt.ridicule/10.) THEN
+          IF (abs(water_cas(il)).lt.ridicule/10.) THEN
             do ixt=1,niso
                xtwater_cas(ixt,il)=water_cas(il)*Rdefault(ixt)
             enddo !do ixt=1,niso
-          else !if (water(il,i).eq.0.0) THEN
-             if (Pqiinf_stewart(il).gt.0.0) then  !if (Pxtiinf_par(iso_eau).gt.0.0) THEN
+          else !if (water(il,i).EQ.0.0) THEN
+             IF (Pqiinf_stewart(il).gt.0.0) then  !if (Pxtiinf_par(iso_eau).gt.0.0) THEN
                do ixt=1,niso 
                  xtwater_cas(ixt,il)=water_cas(il) &
@@ -8864,5 +8864,5 @@
                 enddo !do ixt=1,niso
              endif
-           endif !if (water(il,i).eq.0.0) THEN
+           endif !if (water(il,i).EQ.0.0) THEN
          enddo !do il=1,ncas
         
@@ -8874,11 +8874,11 @@
                 'appel_stewart 566b')
         enddo !do ixt=1,niso
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
          CALL iso_verif_egalite_choix(xtwater_cas(iso_eau,il), &
                 water_cas(il),'appel_stewart 568b',errmax,errmaxrel)
-         if (water_cas(il).gt.ridicule*10) THEN
-             if (iso_verif_egalite_choix_nostop( &
+         IF (water_cas(il).gt.ridicule*10) THEN
+             IF (iso_verif_egalite_choix_nostop( &
                 xtwater_cas(iso_eau,il)/water_cas(il),1.0, &
-                'appel stewart 155b',errmax*10,errmaxrel*10).eq.1) THEN
+                'appel stewart 155b',errmax*10,errmaxrel*10).EQ.1) THEN
                WRITE(*,*) 'i=',i
                WRITE(*,*) 'Tevap=',T_cas(il)
@@ -8902,5 +8902,5 @@
         ! calcule xtevapi.    
        do il=1,ncas
-        if (Eqi_stewart(il).gt.0.0) THEN
+        IF (Eqi_stewart(il).gt.0.0) THEN
          do ixt=1,niso          
           xtevap_cas(ixt,il)=Eqi_prime_cas(il) &
@@ -8924,12 +8924,12 @@
           CALL iso_verif_noNAN(xtevap_cas(ixt,il),'appel stewart 131b')
         enddo ! do ixt=1,niso
-        if (oktrac.eq.0) THEN
+        IF (oktrac.EQ.0) THEN
             ! dans le cas traceur, le calcul de evap_cas est plus
             ! compliqué: il faut le faire plus proprement dans
             ! compress_stewart
-        if (iso_eau.gt.0) THEN
-            if (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il), &
+        IF (iso_eau.gt.0) THEN
+            IF (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il), &
               evap_cas(il), &
-              'appel stewart 142b',errmax,errmaxrel).eq.1) THEN
+              'appel stewart 142b',errmax,errmaxrel).EQ.1) THEN
                 WRITE(*,*) 'i,il=',i,il
                 WRITE(*,*) 'Exi_stewart(iso_eau,il),Eqi_stewart(il)=', &
@@ -8943,5 +8943,5 @@
             endif !if (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il),
         endif !if (iso_eau.gt.0) THEN
-       endif ! if (oktrac.eq.0) THEN
+       endif ! if (oktrac.EQ.0) THEN
       enddo !do il=1,ncas 
 #endif
@@ -8952,7 +8952,7 @@
       ! deduction de XTP partir de Exi
       do il=1,ncas
-       if (i.lt.INB_cas(il)) THEN
-          if (fac_ftmr_cas(il).gt.0.0) THEN
-            if (Eqi_stewart(il)*fac_ftmr_cas(il).gt.ridicule) THEN
+       IF (i.lt.INB_cas(il)) THEN
+          IF (fac_ftmr_cas(il).gt.0.0) THEN
+            IF (Eqi_stewart(il)*fac_ftmr_cas(il).gt.ridicule) THEN
                do ixt=1,niso     
                !   xtp(ixt,il,i)=xtnew(ixt)*qp(il,i)/xtnew(4)           
@@ -8962,6 +8962,6 @@
                enddo !do ixt=1,niso
              else ! if (Eqi_stewart.gt.ridicule) THEN
-                if (qp_cas(il).gt.0.0) THEN
-                    if (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.ridicule) &
+                IF (qp_cas(il).gt.0.0) THEN
+                    IF (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.ridicule) &
                          THEN
                         ! il va manquer quelque chose: il faut augmenter
@@ -8995,10 +8995,10 @@
                        'appel stewart 684b')
                 enddo ! do ixt=1,niso
-             if (oktrac.eq.0) THEN
-                if (iso_eau.gt.0) THEN
-                  if (iso_verif_egalite_choix_nostop( &
+             IF (oktrac.EQ.0) THEN
+                IF (iso_eau.gt.0) THEN
+                  IF (iso_verif_egalite_choix_nostop( &
                     xtp_cas(iso_eau,il),qp_cas(il), &
                     'appel stewart 688b',errmax,errmaxrel*30) &
-                    .eq.1) THEN
+                    .EQ.1) THEN
                     WRITE(*,*) 'il=',il
                     WRITE(*,*) 'xtp_avantevaptrac_cas(iso_eau,il)=', &
@@ -9013,5 +9013,5 @@
                   endif
                endif !if (iso_eau.gt.0) THEN
-              if ((iso_HDO.gt.0).and. &
+              IF ((iso_HDO.gt.0).AND. &
                 (qp_cas(il).gt.ridicule)) THEN
                 CALL iso_verif_aberrant( &
@@ -9019,5 +9019,5 @@
                 'appel_stewart 1384')
               endif  ! if (iso_HDO.gt.0) THEN
-            endif ! if (oktrac.eq.0) THEN
+            endif ! if (oktrac.EQ.0) THEN
 #endif 
 
@@ -9048,12 +9048,12 @@
          enddo !do ixt=1,niso
         enddo ! do il=1,ncas
-        if (oktrac.eq.0) THEN
-        if (iso_eau.gt.0) THEN
+        IF (oktrac.EQ.0) THEN
+        IF (iso_eau.gt.0) THEN
         do il=1,ncas
-        if (iso_verif_egalite_choix_nostop( &
+        IF (iso_verif_egalite_choix_nostop( &
                  xtp_cas(iso_eau,il), &
                  qp_cas(il), &
                 'appel stewart 197b: cas_evap_glace', &
-                errmax,errmaxrel*50).eq.1) THEN
+                errmax,errmaxrel*50).EQ.1) THEN
           WRITE(*,*) 'i,il=',i,il,' INB(il)=',INB_cas(il)
 !     &          ,' cas(il)=',cas_evap_glace(il)
@@ -9079,7 +9079,7 @@
          enddo !do il=1,ncas
         endif
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
           do il=1,ncas
-            if (qp_cas(il).gt.ridicule) THEN
+            IF (qp_cas(il).gt.ridicule) THEN
                 CALL iso_verif_aberrant( &
                 xtp_cas(iso_HDO,il)/qp_cas(il), &
@@ -9088,5 +9088,5 @@
           enddo !do il=1,ncas
         endif  ! if (iso_HDO.gt.0) THEN
-       endif ! if (oktrac.eq.0) THEN
+       endif ! if (oktrac.EQ.0) THEN
 !       WRITE(*,*) 'appel_stewart 2331: sortie de make_cas_evap_glace'
 #endif
@@ -9130,9 +9130,9 @@
 
       !*inputs et outputs
-      integer ncum ! dimension horiz effective
-      logical lwork(nloc)
-      integer NA,ND,nloc ! dimensions officielles
-      real PH(nloc,ND),T(nloc,ND),EVAP(nloc,NA)
-      real XTWDTRAIN(ntraciso,nloc),WDTRAIN(nloc), &
+      INTEGER ncum ! dimension horiz effective
+      LOGICAL lwork(nloc)
+      INTEGER NA,ND,nloc ! dimensions officielles
+      REAL PH(nloc,ND),T(nloc,ND),EVAP(nloc,NA)
+      REAL XTWDTRAIN(ntraciso,nloc),WDTRAIN(nloc), &
             WATER(nloc,NA), Q(nloc,NA), XT(ntraciso,nloc,ND), &
                  QS(nloc,ND),QP(nloc,NA), &
@@ -9140,26 +9140,26 @@
           XTEVAP(ntraciso,nloc,NA), &
             WT(nloc,NA), MP(nloc,NA)
-      real sigd(nloc)
-      integer i,INB(nloc)
-      logical cvflag_grav
-      real ginv
-      real Mpmin
+      REAL sigd(nloc)
+      INTEGER i,INB(nloc)
+      LOGICAL cvflag_grav
+      REAL ginv
+      REAL Mpmin
 
       !* variables intermediaires
-      integer ixt,j,il
-      real qeff(ncum)
-      real xtp_avantevap(ntraciso,ncum),qp_avantevap(ncum)
+      INTEGER ixt,j,il
+      REAL qeff(ncum)
+      REAL xtp_avantevap(ntraciso,ncum),qp_avantevap(ncum)
 !      real Exi(niso,ncum) ! equivalent à Eqi_prime
-      real Pqisup(ncum),Pqiinf(ncum),Eqi(ncum) 
-      real Pqiinf_par(ncum), Eqi_prime(ncum),  &
+      REAL Pqisup(ncum),Pqiinf(ncum),Eqi(ncum)
+      REAL Pqiinf_par(ncum), Eqi_prime(ncum),  &
                  Eqi_plus1(ncum), Eqi_par(ncum)
-      real Pqiinf_stewart(ncum), Eqi_stewart(ncum)
-      real Exi_prime(ntraciso,ncum)
-      real Pxtiinf_stewart(niso,ncum),  &
+      REAL Pqiinf_stewart(ncum), Eqi_stewart(ncum)
+      REAL Exi_prime(ntraciso,ncum)
+      REAL Pxtiinf_stewart(niso,ncum),  &
                 Exi_stewart(niso,ncum)
-      real Exi_plus1(niso,ncum)
-      real Pxtisup(ntraciso,ncum), Pxtiinf(niso,ncum)
-      real xtnew(niso,ncum)
-      real fac_ftmr(ncum) ! facteur de conversion des flux en mixing ratio
+      REAL Exi_plus1(niso,ncum)
+      REAL Pxtisup(ntraciso,ncum), Pxtiinf(niso,ncum)
+      REAL xtnew(niso,ncum)
+      REAL fac_ftmr(ncum) ! facteur de conversion des flux en mixing ratio
 !      real Risup(ntraciso,ncum), Rcond(ntraciso,ncum), 
 !     :           Renv(ntraciso,ncum) 
@@ -9169,29 +9169,29 @@
 !     real fcond(ncum), fice(ncum), cond(ncum)
 !      real zxtalphal(niso,ncum), zxtalphai(niso,ncum)
-      real g
-      real rat(ncum)
-      real ztglace_kelvin
+      REAL g
+      REAL rat(ncum)
+      REAL ztglace_kelvin
       parameter (ztglace_kelvin=273.15)
 
-      integer frac_sublim
+      INTEGER frac_sublim
       !real      
       !real real_to_double
 
       ! compteurs de parsage
-      integer icas_condensation_facftmr,ncas_condensation_facftmr
-      integer icas_condensation_nofacftmr,ncas_condensation_nofacftmr
-      integer icas_noevap,ncas_noevap
-      integer icas_evap_liq,ncas_evap_liq
-      integer icas_evap_glace,ncas_evap_glace
-      integer ncas_tot
+      INTEGER icas_condensation_facftmr,ncas_condensation_facftmr
+      INTEGER icas_condensation_nofacftmr,ncas_condensation_nofacftmr
+      INTEGER icas_noevap,ncas_noevap
+      INTEGER icas_evap_liq,ncas_evap_liq
+      INTEGER icas_evap_glace,ncas_evap_glace
+      INTEGER ncas_tot
 
       ! tableaux d'indice issus du parsage
-      integer cas_condensation_facftmr(ncum)
-      integer cas_condensation_nofacftmr(ncum)
-      integer cas_noevap(ncum)
-      integer cas_evap_liq(ncum)
-      integer cas_evap_glace(ncum)
-
-      integer trace_cas(ncum)
+      INTEGER cas_condensation_facftmr(ncum)
+      INTEGER cas_condensation_nofacftmr(ncum)
+      INTEGER cas_noevap(ncum)
+      INTEGER cas_evap_liq(ncum)
+      INTEGER cas_evap_glace(ncum)
+
+      INTEGER trace_cas(ncum)
 #ifdef ISOVERIF
       ! tracage des cas
@@ -9210,5 +9210,5 @@
 !      integer iso_verif_egalite_choix_nostop
 !      real deltaD
-      real Exi_cas(niso,ncum),Exi(ntraciso,ncum)
+      REAL Exi_cas(niso,ncum),Exi(ntraciso,ncum)
 #endif    
 !      integer iso_verif_noNAN_nostop
@@ -9216,9 +9216,9 @@
 
       ! outputs des calculs, compressés
-      real xtevap_cas(niso,ncum),xtp_cas(niso,ncum), &
+      REAL xtevap_cas(niso,ncum),xtp_cas(niso,ncum), &
                  xtwater_cas(niso,ncum)
 
       ! inputs des calculs, compréssés
-      real T_cas(ncum),delP_cas(ncum), &
+      REAL T_cas(ncum),delP_cas(ncum), &
                 xtevapsup_cas(niso,ncum),evap_cas(ncum), &
                 qp_cas(ncum),wt_cas(ncum), &
@@ -9234,10 +9234,10 @@
       real  qp_avantevaptrac_cas(ncum), &
         xtp_avantevaptrac_cas(niso,ncum)
-        integer izone ,iiso
-      real xtaddp_tag(niso,ncum)
-      real ptrac(ncum)
-      real hdiag(ncum)
+        INTEGER izone ,iiso
+      REAL xtaddp_tag(niso,ncum)
+      REAL ptrac(ncum)
+      REAL hdiag(ncum)
 #endif      
-      integer INB_cas(ncum)
+      INTEGER INB_cas(ncum)
               
 
@@ -9247,5 +9247,5 @@
 
       !gravité:
-      if (cvflag_grav) THEN
+      IF (cvflag_grav) THEN
           g=1/ginv
       else
@@ -9261,10 +9261,10 @@
       
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
         do il=1,ncum 
-         if (i.le.inb(il) .and. lwork(il)) THEN
+         IF (i.le.inb(il) .AND. lwork(il)) THEN
           CALL iso_verif_egalite_choix(xt(iso_eau,il,i),q(il,i), &
                  'appel_stewart_np 58',errmax,errmaxrel)
-         endif !if (i.le.inb(il) .and. lwork(il)) THEN
+         endif !if (i.le.inb(il) .AND. lwork(il)) THEN
         enddo !do il=1,ncum    
       endif !if (iso_eau.gt.0) THEN
@@ -9276,16 +9276,16 @@
 #endif      
 #endif
-      if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+      IF ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
          do il=1,ncum 
-             if (i.le.inb(il) .and. lwork(il)) THEN
+             IF (i.le.inb(il) .AND. lwork(il)) THEN
                 xt(iso_eau,il,i)=  q(il,i)
-             endif !if (i.le.inb(il) .and. lwork(il)) THEN
+             endif !if (i.le.inb(il) .AND. lwork(il)) THEN
            enddo !do il=1,ncum     
-      endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+      endif !if ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
       ! verif que les vapeurs du ddft plus haut sont bonnes
       ! si i=INB, on ne verifie rien car pas de vapeur au dessus de INB
 #ifdef ISOVERIF
        do il=1,ncum 
-         if (i.lt.inb(il) .and. lwork(il)) THEN
+         IF (i.lt.inb(il) .AND. lwork(il)) THEN
           do j=i+1,INB(il)
             do ixt=1,ntraciso
@@ -9294,12 +9294,12 @@
             enddo
          enddo !do j=i+1,INB
-        endif ! (i.lt.inb(il) .and. lwork(il)) THEN
+        endif ! (i.lt.inb(il) .AND. lwork(il)) THEN
        enddo !do il=1,ncum 
 #endif
 #ifdef ISOVERIF
        do il=1,ncum 
-         if (i.lt.inb(il) .and. lwork(il)) THEN
+         IF (i.lt.inb(il) .AND. lwork(il)) THEN
           do j=i+1,INB(il)
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(xtp(iso_eau,il,j),qp(il,j), &
                  'appel_stewart_np 66',errmax,errmaxrel)
@@ -9310,17 +9310,17 @@
 #endif  
          enddo !do j=i+1,INB
-        endif ! (i.lt.inb(il) .and. lwork(il)) THEN
+        endif ! (i.lt.inb(il) .AND. lwork(il)) THEN
        enddo !do il=1,ncum 
 #endif
 
-      if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+      IF ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
        do il=1,ncum 
-        if (i.lt.inb(il) .and. lwork(il)) THEN
+        IF (i.lt.inb(il) .AND. lwork(il)) THEN
          do j=i+1,INB(il)
           xtp(iso_eau,il,j)=qp(il,j)          
          enddo !do j=i+1,INB
-        endif ! (i.lt.inb(il) .and. lwork(il)) THEN
+        endif ! (i.lt.inb(il) .AND. lwork(il)) THEN
        enddo !do il=1,ncum 
-      endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+      endif !if ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
       ! end verif des inputs 
 
@@ -9329,10 +9329,10 @@
       
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) THEN
-        if ((Mp(il,i).gt.Mp(il,i+1)).and.(Mp(il,i).gt.Mpmin)) THEN
+       IF (i.le.inb(il) .AND. lwork(il)) THEN
+        IF ((Mp(il,i).gt.Mp(il,i+1)).AND.(Mp(il,i).gt.Mpmin)) THEN
           ! cas entrainant
           fac_ftmr(il)=1.0/Mp(il,i)
         else !if ((Mp(il,i).gt.Mp(il,i+1))
-          if (Mp(il,i+1).gt.Mpmin) THEN
+          IF (Mp(il,i+1).gt.Mpmin) THEN
               ! cas non entrainant, mais flux existe
               fac_ftmr(il)=1.0/Mp(il,i+1)
@@ -9345,5 +9345,5 @@
         
 #endif        
-       endif ! (i.le.inb(il) .and. lwork(il)) THEN
+       endif ! (i.le.inb(il) .AND. lwork(il)) THEN
       enddo !do il=1,ncum
 
@@ -9351,7 +9351,7 @@
             
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) THEN
-        if (i.lt.INB(il)) THEN
-         if ((Mp(il,i).gt.Mp(il,i+1)).and.(Mp(il,i).gt.Mpmin)) THEN
+       IF (i.le.inb(il) .AND. lwork(il)) THEN
+        IF (i.lt.INB(il)) THEN
+         IF ((Mp(il,i).gt.Mp(il,i+1)).AND.(Mp(il,i).gt.Mpmin)) THEN
           ! cas entrainant
           rat(il)=Mp(il,i+1)/Mp(il,i)
@@ -9362,5 +9362,5 @@
           enddo
          else !if (Mp(il,i).gt.Mp(il,i+1)) THEN
-           if (Mp(il,i+1).gt.Mpmin) THEN
+           IF (Mp(il,i+1).gt.Mpmin) THEN
               ! cas non entrainant, mais flux existe
               qp_avantevap(il)=qp(il,i+1)
@@ -9375,5 +9375,5 @@
               ! l'environnement
               qp_avantevap(il)=qp(il,i)
-              if (qp(il,i).gt.0) THEN
+              IF (qp(il,i).gt.0) THEN
 #ifdef ISOVERIF
                 CALL iso_verif_positif_strict(q(il,i), &
@@ -9397,5 +9397,5 @@
           ! l'environnement
           qp_avantevap(il)=qp(il,i)
-          if (qp(il,i).gt.0) THEN
+          IF (qp(il,i).gt.0) THEN
             do ixt=1,ntraciso
              xtp_avantevap(ixt,il)=xt(ixt,il,i)/q(il,i)*qp(il,i)
@@ -9409,16 +9409,16 @@
           endif !if (qp(il,i).gt.0) THEN
         endif ! if i.lt.INB(il)
-       endif ! (i.le.inb(il) .and. lwork(il)) THEN
+       endif ! (i.le.inb(il) .AND. lwork(il)) THEN
       enddo !do il=1,ncum
 
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
         do il=1,ncum 
-          if (i.le.inb(il) .and. lwork(il)) THEN
+          IF (i.le.inb(il) .AND. lwork(il)) THEN
             CALL iso_verif_egalite_choix( &
                  (xtp_avantevap(iso_eau,il)), &
                  (qp_avantevap(il)), &
                   'appel_stewart_np 95',errmax,errmaxrel)
-          endif ! (i.le.inb(il) .and. lwork(il)) THEN
+          endif ! (i.le.inb(il) .AND. lwork(il)) THEN
         enddo !do il=1,ncum
       endif !if (iso_eau.gt.0) THEN
@@ -9429,5 +9429,5 @@
       
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) THEN
+       IF (i.le.inb(il) .AND. lwork(il)) THEN
         Pqisup(il)=sigd(il)/g*wt(il,i)*water(il,i+1)+wdtrain(il)/g
         Pqiinf(il)=sigd(il)/g*wt(il,i)*water(il,i) ! ce qu'on aurait dans si ce
@@ -9441,7 +9441,7 @@
         ! mais donne pbs en 1D. On met une rustine, mais c'est pas bien
         ! justifié. Il faudrait reprendre ça proprement un jour.
-        if ((Eqi_prime(il).gt.0.0).and. &
-            (Pqiinf(il).ge.Pqisup(il)).and. &
-            (Pqisup(il).gt.0.0).and. &
+        IF ((Eqi_prime(il).gt.0.0).AND. &
+            (Pqiinf(il).ge.Pqisup(il)).AND. &
+            (Pqisup(il).gt.0.0).AND. &
             (Pqisup(il)-Eqi_prime(il).gt.0.0)) THEN
                 ! rustine au cas patho en 1D pour -90hPa/d
@@ -9455,5 +9455,5 @@
                  +xtwdtrain(ixt,il)/g
         enddo
-       endif !if (i.le.inb(il) .and. lwork(il)) THEN
+       endif !if (i.le.inb(il) .AND. lwork(il)) THEN
       enddo !do il=1,ncum 
 
@@ -9471,8 +9471,8 @@
 !      WRITE(*,*) 'qp_avantevap=',qp_avantevap(il)
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) THEN
+       IF (i.le.inb(il) .AND. lwork(il)) THEN
          do ixt=1,niso
-          if (iso_verif_noNaN_nostop((Pxtisup(ixt,il)), &
-              'appel_setwart_vectall_np 338').eq.1) THEN
+          IF (iso_verif_noNaN_nostop((Pxtisup(ixt,il)), &
+              'appel_setwart_vectall_np 338').EQ.1) THEN
             WRITE(*,*) 'il,i,ixt=',il,i,ixt
             WRITE(*,*) 'xtwater(ixt,il,i+1)=',xtwater(ixt,il,i+1)
@@ -9484,5 +9484,5 @@
           endif
          enddo !do ixt=1,niso
-       endif !if (i.le.inb(il) .and. lwork(il)) THEN
+       endif !if (i.le.inb(il) .AND. lwork(il)) THEN
       enddo !do il=1,ncum 
 #endif
@@ -9495,5 +9495,5 @@
 !     :     Pqiinf_par(il),Eqi_par(il)
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) THEN
+       IF (i.le.inb(il) .AND. lwork(il)) THEN
          CALL iso_verif_egalite_choix((Pqiinf(il)), &
               (Pqiinf_par(il)),'appel_stewart_np 218', &
@@ -9501,10 +9501,10 @@
        endif
 !#ifdef ISOTRAC
-!        if ((option_traceurs.eq.17).or.
-!     :           (option_traceurs.eq.18)) THEN
+!        if ((option_traceurs.EQ.17).OR.
+!     :           (option_traceurs.EQ.18)) THEN
 !        if (iso_verif_positif_nostop((        
 !     :          Pxtisup(index_trac(izone_cond,iso_eau),il)
 !     :          -Pxtisup(iso_eau,il)),
-!     :          'appel_stewart_np 332').eq.1) THEN
+!     :          'appel_stewart_np 332').EQ.1) THEN
 !          WRITE(*,*) 'Pxtisup(:,il)=',Pxtisup(:,il)
 !          WRITE(*,*) 'xtwater(:,il,i+1)=',xtwater(:,il,i+1)
@@ -9512,5 +9512,5 @@
 !          stop
 !        endif !if (iso_verif_positif_nostop(Pxtisup(iso_eau,il)-
-!        endif !if ((option_traceurs.eq.17).or.    
+!        endif !if ((option_traceurs.EQ.17).OR.
 !#endif       
       enddo !do il=1,ncum 
@@ -9525,8 +9525,8 @@
       ! petite vérif sur les flux
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) THEN
-         if ((Eqi_par(il).lt.0.0) &
-                .and.(Pqiinf_par(il).le.0.0) &
-               .and.(water(il,i).gt.ridicule/10.)) THEN
+       IF (i.le.inb(il) .AND. lwork(il)) THEN
+         IF ((Eqi_par(il).lt.0.0) &
+                .AND.(Pqiinf_par(il).le.0.0) &
+               .AND.(water(il,i).gt.ridicule/10.)) THEN
             ! dans ce cas, on a de l'eau sortant dont il faut déterminer la
             ! composition, mais pourtant le bilan de masse indique qu'il
@@ -9538,5 +9538,5 @@
 #endif                
 
-            if (Eqi_prime(il)*fac_ftmr(il).lt. &
+            IF (Eqi_prime(il)*fac_ftmr(il).lt. &
                 qp_avantevap(il)*1e-2) THEN
                 ! ouf: Eqi_prime a peut d'effet sur la vapeur du ddft.
@@ -9553,13 +9553,13 @@
             endif
           endif
-        endif !if (i.le.inb(il) .and. lwork(il)) THEN
+        endif !if (i.le.inb(il) .AND. lwork(il)) THEN
       enddo !do il=1,ncum
 
-      if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+      IF ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
           do il=1,ncum
             xtp_avantevap(iso_eau,il)=qp_avantevap(il)
             Pxtisup(iso_eau,il)=Pqisup(il)
           enddo
-      endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+      endif !if ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
       ! ******** parsage des différents cas + quelques vérifs
       icas_condensation_facftmr=0
@@ -9571,5 +9571,5 @@
       ! initialisation de l'outil de tracage de cas:
       do il=1,ncum
-        if (i.le.inb(il) .and. lwork(il)) THEN
+        IF (i.le.inb(il) .AND. lwork(il)) THEN
           trace_cas(il)=0
         else
@@ -9585,6 +9585,6 @@
 !#endif      
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) THEN
-        if ((Eqi_prime(il).lt.-ridicule*1e-3).or. &
+       IF (i.le.inb(il) .AND. lwork(il)) THEN
+        IF ((Eqi_prime(il).lt.-ridicule*1e-3).OR. &
               (Eqi_prime(il)*fac_ftmr(il).lt.-ridicule*10)) THEN
             ! modif le 10 mai 2009: si Eqi_prime très petit, on le
@@ -9592,5 +9592,5 @@
             ! modif 15 mai 2009: on rajoute condition sur Eqi*fac_ftmr
             ! 1: Eqi_prime<0: condensation
-          if (fac_ftmr(il).gt.ridicule/100.) THEN
+          IF (fac_ftmr(il).gt.ridicule/100.) THEN
             ! si fac_ftmr très petit, on le traite comme du 0
             ! 1.1: si Mpi>0
@@ -9608,5 +9608,5 @@
 !#endif
           endif !if (fac_ftmr.gt.0.0) THEN
-        else if ((Eqi_prime(il).lt.ridicule*1e-3).and. &
+        ELSE IF ((Eqi_prime(il).lt.ridicule*1e-3).AND. &
            (Eqi_prime(il)*fac_ftmr(il).lt.ridicule*10)) THEN
             ! 2: Eqi_prime est compris entre 1e-14 et -1e-14: rien 
@@ -9626,5 +9626,5 @@
             enddo
 #ifdef ISOVERIF
-            if ((Pqisup(il).le.0.0).and. &
+            IF ((Pqisup(il).le.0.0).AND. &
                 (water(il,i).gt.ridicule)) THEN
               WRITE(*,*) 'appel_stewart_np 420: water=',water(il,i)
@@ -9633,9 +9633,9 @@
               stop
             endif    
-            if (iso_eau.gt.0) THEN
-             if (iso_verif_egalite_choix_nostop( &
+            IF (iso_eau.gt.0) THEN
+             IF (iso_verif_egalite_choix_nostop( &
                 (qp_avantevap(il)), &
                 qp(il,i),'appel_stewart_np 521', &
-                errmax,errmaxrel).eq.1) THEN
+                errmax,errmaxrel).EQ.1) THEN
                WRITE(*,*) 'Mp(il,i)=',Mp(il,i)
                WRITE(*,*) 'Mp(il,i+1)=',Mp(il,i+1)
@@ -9657,5 +9657,5 @@
 !             if (iso_verif_positif_nostop((
 !     :            Pqisup(il)-Eqi_prime(il)),
-!     :            'appel_stewart_np 388 nostop ').eq.1) THEN
+!     :            'appel_stewart_np 388 nostop ').EQ.1) THEN
 !               WRITE(*,*) 'il,Pqisup=',il,Pqisup(il)
 !               WRITE(*,*) 'Eqi_prime=',Eqi_prime(il)
@@ -9664,7 +9664,7 @@
 !!               stop
 !              endif
-              if (iso_verif_positif_choix_nostop(( &
+              IF (iso_verif_positif_choix_nostop(( &
                 Pqisup(il)-Pqiinf_par(il)),errmax, &
-                'appel_stewart_np 442').eq.1) THEN
+                'appel_stewart_np 442').EQ.1) THEN
                 WRITE(*,*) 'appel_stewart_np 174'
                 WRITE(*,*) 'Pqisup=',Pqisup(il), &
@@ -9672,6 +9672,6 @@
                 stop
               endif               
-              if (iso_verif_positif_nostop((Eqi_par(il)), &
-                'appel_stewart_np 559b').eq.1) THEN
+              IF (iso_verif_positif_nostop((Eqi_par(il)), &
+                'appel_stewart_np 559b').EQ.1) THEN
                 WRITE(*,*) 'Eqi(il),Eqi_plus1(il),Eqi_prime(il)=', &
                        Eqi(il),Eqi_plus1(il),Eqi_prime(il)
@@ -9680,5 +9680,5 @@
               endif
 #endif              
-              if (T(il,i).ge.ztglace_kelvin) THEN
+              IF (T(il,i).ge.ztglace_kelvin) THEN
                 ! 3.1: evap des gouttes
                 icas_evap_liq=icas_evap_liq+1  
@@ -9696,5 +9696,5 @@
               endif !if (T(il,i).ge.ztglace_kelvin) THEN
           endif !if (Eqi_prime.lt.0.0) THEN
-       endif !if (i.le.inb(il) .and. lwork(il)) THEN
+       endif !if (i.le.inb(il) .AND. lwork(il)) THEN
       enddo  !do il=1,ncum 
 
@@ -9712,5 +9712,5 @@
       ncas_tot=0
       do il=1,ncum
-        if (i.le.inb(il) .and. lwork(il)) THEN
+        IF (i.le.inb(il) .AND. lwork(il)) THEN
             ncas_tot=ncas_tot+1
         endif
@@ -9723,5 +9723,5 @@
 !      WRITE(*,*) 'ncas_evap_liq_=',ncas_evap_liq
 !      WRITE(*,*) 'ncas_evap_glace=',ncas_evap_glace
-      if (ncas_tot.ne.ncas_condensation_facftmr &
+      IF (ncas_tot.NE.ncas_condensation_facftmr &
                +ncas_condensation_nofacftmr &
                +ncas_noevap &
@@ -9736,5 +9736,5 @@
       ! ****** traitement vectoriel du cas 1.1
 
-      if (ncas_condensation_facftmr.gt.0) THEN
+      IF (ncas_condensation_facftmr.gt.0) THEN
 !#ifdef ISOVERIF        
 !      WRITE(*,*) 'cas_condensation_facftmr(1)=', &
@@ -9777,5 +9777,5 @@
               'appel_stewart_np 460: compress condensation_facftmr', &
               errmax,errmax)
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
          CALL iso_verif_egalite_choix( &
               (xtp_avantevap_cas(iso_eau,il)), &
@@ -9840,5 +9840,5 @@
 
 #ifdef ISOVERIF 
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
           do il=1,ncas_condensation_facftmr
             CALL iso_verif_egalite_choix( &
@@ -9889,5 +9889,5 @@
 !     :           xtp_avantevap(1:ntraciso:3,
 !     :           cas_condensation_facftmr(il))
-!               if (il.eq.cas_condensation_facftmr(602)) THEN
+!               if (il.EQ.cas_condensation_facftmr(602)) THEN
 !                WRITE(*,*) 'appel_stewart_np 638: il=602'
 !                WRITE(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
@@ -9912,5 +9912,5 @@
         ! ****** traitement vectoriel du cas 1.2
 
-      if (ncas_condensation_nofacftmr.gt.0) THEN
+      IF (ncas_condensation_nofacftmr.gt.0) THEN
       CALL compress_cond_nofftmr(ncas_condensation_nofacftmr, &
          cas_condensation_nofacftmr, &
@@ -10041,5 +10041,5 @@
         ! ****** traitement vectoriel du cas 2
 
-      if (ncas_noevap.gt.0) THEN
+      IF (ncas_noevap.gt.0) THEN
       CALL compress_noevap(ncas_noevap, &
          cas_noevap, &
@@ -10065,13 +10065,13 @@
                 water(cas_noevap(il),i), &
                 'appel_stewart_np 693: compression',errmax,errmaxrel)
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite_choix( &
                 (Pxtisup_cas(iso_eau,il)), &
                 (Pqisup_cas(il)), &
                 'appel_stewart_np 759',errmax,errmaxrel)
-        if (iso_verif_egalite_choix_nostop( &
+        IF (iso_verif_egalite_choix_nostop( &
                 (xtp_avantevap(iso_eau,cas_noevap(il))), &
                 qp(cas_noevap(il),i), &
-                'appel_stewart_np 739',errmax,errmaxrel).eq.1) THEN
+                'appel_stewart_np 739',errmax,errmaxrel).EQ.1) THEN
            WRITE(*,*) 'il,cas_noevap=',il,cas_noevap(il)
            stop
@@ -10168,5 +10168,5 @@
         ! ****** traitement vectoriel du cas 3.1
 
-      if (ncas_evap_liq.gt.0) THEN
+      IF (ncas_evap_liq.gt.0) THEN
       CALL compress_evap_liq(3,ncas_evap_liq, &
          cas_evap_liq, &
@@ -10221,5 +10221,5 @@
               'appel_stewart_np 783: compression evap_liq', &
                 errmax,errmax)
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite_choix( &
               (xtp_avantevap_cas(iso_eau,il)), &
@@ -10283,5 +10283,5 @@
 
        ! initialisation dans le cas où la revap est taggée:
-       if (option_revap.eq.1) THEN
+       IF (option_revap.EQ.1) THEN
          do il=1,ncas_evap_liq  
            do iiso=1,niso
@@ -10336,5 +10336,5 @@
 !       WRITE(*,*) 'xtp_avantevaptrac_cas(iso_eau,2)=',
 !     :           xtp_avantevaptrac_cas(iso_eau,2)
-       if (iso_eau.gt.0) THEN
+       IF (iso_eau.gt.0) THEN
            do il=1,ncas_evap_liq
 !             WRITE(*,*) 'appel_stewart_np tmp 943: il=',il
@@ -10359,17 +10359,17 @@
                 'appel_stewart_np 961', &
                 errmax,errmaxrel)
-!             if ((option_traceurs.eq.17).or.
-!     :           (option_traceurs.eq.18)) THEN
-!               if (izone.eq.izone_cond) THEN
+!             if ((option_traceurs.EQ.17).OR.
+!     :           (option_traceurs.EQ.18)) THEN
+!               if (izone.EQ.izone_cond) THEN
 !                CALL iso_verif_positif((
 !     :           Pxtisup_cas(iso_eau,il)
 !     :           -Pxtisup(iso_eau,cas_evap_liq(il))),
 !     :           'appel_stewart_np 1114')
-!               else !if (izone.eq.izone_cond) THEN
+!               else !if (izone.EQ.izone_cond) THEN
 !                CALL iso_verif_positif((
 !     :           -Pxtisup_cas(iso_eau,il)),
 !     :           'appel_stewart_np 1118')
-!               endif !if (izone.eq.izone_cond) THEN
-!             endif   !if ((option_traceurs.eq.17).or.
+!               endif !if (izone.EQ.izone_cond) THEN
+!             endif   !if ((option_traceurs.EQ.17).OR.
            enddo !do il=1,ncas_evap_liq
        endif !if (iso_eau.gt.0) THEN
@@ -10419,10 +10419,10 @@
        do il=1,ncas_evap_liq
            
-           if (iso_verif_traceur_nostop(xtp(1,cas_evap_liq(il),i), &
-                'appel_stewart_np 1256').eq.1) THEN
+           IF (iso_verif_traceur_nostop(xtp(1,cas_evap_liq(il),i), &
+                'appel_stewart_np 1256').EQ.1) THEN
              WRITE(*,*) 'il,cas_evap_liq(il)=',il,cas_evap_liq(il)
              WRITE(*,*) 'trace_cas(cas_evap_liq(il))=', &
                 trace_cas(cas_evap_liq(il))
-             if (trace_cas(cas_evap_liq(il)).eq.31) THEN
+             IF (trace_cas(cas_evap_liq(il)).EQ.31) THEN
                  WRITE(*,*) 'cas evap_liq'
                  WRITE(*,*) 'xtp(:,cas_evap_liq(il),i)=', &
@@ -10440,5 +10440,5 @@
                  WRITE(*,*) 'h(il)=',thumxt1+(1.0-thumxt1)* &
                         qp_avantevap_cas(il)/qs_cas(il)
-             endif !if (trace_cas(il).eq.31) THEN
+             endif !if (trace_cas(il).EQ.31) THEN
                 ! en cas de problème ci, activer l'option débug de
                 ! stewart_explicit
@@ -10467,5 +10467,5 @@
                 ! ****** traitement vectoriel du cas 3.2
 
-      if (ncas_evap_glace.gt.0) THEN
+      IF (ncas_evap_glace.gt.0) THEN
       CALL compress_evap_glace(3, &
          ncas_evap_glace,cas_evap_glace, &
@@ -10522,5 +10522,5 @@
               'appel_stewart_np 914: compression evap_glace', &
                 errmax,errmax)
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite_choix( &
               (xtp_avantevap_cas(iso_eau,il)), &
@@ -10575,5 +10575,5 @@
 
        ! initialisation dans le cas où la revap est taggée:
-       if (option_revap.eq.1) THEN
+       IF (option_revap.EQ.1) THEN
          do il=1,ncas_evap_glace   
            do iiso=1,niso
@@ -10643,6 +10643,6 @@
 !     :           (1:ntraciso,cas_evap_glace(il))
 !           WRITE(*,*) 'xtp=',xtp(1:ntraciso,cas_evap_glace(il),i)
-           if (iso_verif_traceur_nostop(xtp(1,cas_evap_glace(il),i), &
-                'appel_stewart_np 1314').eq.1) THEN
+           IF (iso_verif_traceur_nostop(xtp(1,cas_evap_glace(il),i), &
+                'appel_stewart_np 1314').EQ.1) THEN
              WRITE(*,*) 'il,cas_evap_glace(il)=',il,cas_evap_glace(il)
              WRITE(*,*) 'trace_cas(cas_evap_glace(il))=', &
@@ -10678,44 +10678,44 @@
 #ifdef ISOVERIF
         do il=1,ncum 
-           if (i.le.inb(il) .and. lwork(il)) THEN
+           IF (i.le.inb(il) .AND. lwork(il)) THEN
              do ixt=1,ntraciso
-               if ((iso_verif_noNAN_nostop(xtevap(ixt,il,i), &
-                  'appel_stewart_np 1661').eq.1).or. &
+               IF ((iso_verif_noNAN_nostop(xtevap(ixt,il,i), &
+                  'appel_stewart_np 1661').EQ.1).OR. &
                   (iso_verif_noNAN_nostop(xtp(ixt,il,i), &
-                  'appel_stewart_np 1382').eq.1).or. &
+                  'appel_stewart_np 1382').EQ.1).OR. &
                   (iso_verif_noNAN_nostop(xtwater(ixt,il,i), &
-                  'appel_stewart_np 1381').eq.1)) THEN
+                  'appel_stewart_np 1381').EQ.1)) THEN
                  WRITE(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
                  stop
                endif
              enddo
-         endif !if (i.le.inb(il) .and. lwork(il)) THEN
+         endif !if (i.le.inb(il) .AND. lwork(il)) THEN
        enddo !do il=1,ncum 
 #endif  
 #ifdef ISOVERIF
         do il=1,ncum 
-           if (i.le.inb(il) .and. lwork(il)) THEN
-             if (iso_eau.gt.0) THEN
-              if (iso_verif_egalite_choix_nostop(xtwater(iso_eau,il,i), &
+           IF (i.le.inb(il) .AND. lwork(il)) THEN
+             IF (iso_eau.gt.0) THEN
+              IF (iso_verif_egalite_choix_nostop(xtwater(iso_eau,il,i), &
               water(il,i),'appel_stewart_np 1277, fin, water', &
-              errmax,errmaxrel).eq.1) THEN
+              errmax,errmaxrel).EQ.1) THEN
                WRITE(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
                stop 
               endif  !if (iso_verif_egalite_choix_nostop(  
-              if (iso_verif_egalite_choix_nostop( &
+              IF (iso_verif_egalite_choix_nostop( &
               xtp(iso_eau,il,i),qp(il,i),'appel_stewart_np 1278', &
-              errmax,errmaxrel*50).eq.1) THEN
+              errmax,errmaxrel*50).EQ.1) THEN
                WRITE(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
                stop 
               endif  !if (iso_verif_egalite_choix_nostop(
-              if (iso_verif_egalite_choix_nostop( &
+              IF (iso_verif_egalite_choix_nostop( &
               xtevap(iso_eau,il,i),evap(il,i), &
               'appel_stewart_np 1279', &
-              errmax,errmaxrel).eq.1) THEN
+              errmax,errmaxrel).EQ.1) THEN
                WRITE(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
                stop 
               endif  !if (iso_verif_egalite_choix_nostop(
              endif !if (iso_eau.gt.0) THEN
-             if ((iso_HDO.gt.0).and. &
+             IF ((iso_HDO.gt.0).AND. &
                 (qp(il,i).gt.ridicule)) THEN
                 CALL iso_verif_aberrant( &
@@ -10724,5 +10724,5 @@
              endif  ! if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
-!           if (il.eq.602) THEN
+!           if (il.EQ.602) THEN
 !              WRITE(*,*) 'appel_stewart_np 1334: il,i=',il,i
 !              WRITE(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
@@ -10735,22 +10735,22 @@
            CALL iso_verif_traceur(xtwater(1,il,i), &
                 'appel_stewart_np 1636')
-!           if ((option_traceurs.eq.17).or.
-!     :           (option_traceurs.eq.18)) THEN
+!           if ((option_traceurs.EQ.17).OR.
+!     :           (option_traceurs.EQ.18)) THEN
 !            if (iso_verif_positif_nostop(xtwater(
 !     :           index_trac(izone_cond,iso_eau),il,i)
 !     :           -xtwater(iso_eau,il,i),
-!     :           'appel_stewart_np 1457').eq.1) THEN
+!     :           'appel_stewart_np 1457').EQ.1) THEN
 !             WRITE(*,*) 'il,trace_cas=',il,trace_cas(il)
 !             stop
 !            endif !if (iso_verif_positif_nostop(xtwater(iso_eau,il,i)-
-!           endif !if ((option_traceurs.eq.17).or.
+!           endif !if ((option_traceurs.EQ.17).OR.
 #endif  
-           endif !if (i.le.inb(il) .and. lwork(il)) THEN
+           endif !if (i.le.inb(il) .AND. lwork(il)) THEN
         enddo !do il=1,ncum 
 #endif
 
-       if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+       IF ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
          do il=1,ncum 
-           if (i.le.inb(il) .and. lwork(il)) THEN
+           IF (i.le.inb(il) .AND. lwork(il)) THEN
              xtwater(iso_eau,il,i)= water(il,i)
              xtp(iso_eau,il,i)=qp(il,i) 
@@ -10768,5 +10768,5 @@
 #endif            
 #endif             
-           endif !if (i.le.inb(il) .and. lwork(il)) THEN
+           endif !if (i.le.inb(il) .AND. lwork(il)) THEN
           enddo !do il=1,ncum  
         endif !if (bidouille_anti_divergence) THEN
@@ -10795,21 +10795,21 @@
 
         ! inputs
-        integer ncas
-        real xtevapsup_cas(niso,ncas),water_cas(ncas)
+        INTEGER ncas
+        REAL xtevapsup_cas(niso,ncas),water_cas(ncas)
         real  xtp_avantevap_cas(niso,ncas), &
         Pqisup_cas(ncas), Pxtisup_cas(niso,ncas)
 #ifdef ISOVERIF        
-        real evap_cas(ncas),qp_cas(ncas)
-        integer oktrac ! si traceurs, certaines verifs ne sont pas
+        REAL evap_cas(ncas),qp_cas(ncas)
+        INTEGER oktrac ! si traceurs, certaines verifs ne sont pas
                 !valides
 #endif
 !        integer iso_verif_noNaN_nostop
         ! outputs
-        real xtevap_cas(niso,ncas),xtp_cas(niso,ncas), &
+        REAL xtevap_cas(niso,ncas),xtp_cas(niso,ncas), &
                  xtwater_cas(niso,ncas)
 
         ! locals
-        real Risup(niso,ncas)
-        integer il,ixt
+        REAL Risup(niso,ncas)
+        INTEGER il,ixt
         !real 
 
@@ -10825,5 +10825,5 @@
 #ifdef ISOVERIF       
        do il=1,ncas
-        if ((Pqisup_cas(il).le.0.0).and. &
+        IF ((Pqisup_cas(il).le.0.0).AND. &
                 (water_cas(il).gt.ridicule*10)) THEN
             ! 27 mai 2009: on est plus laxiste dans le cas des traceurs
@@ -10834,5 +10834,5 @@
             stop
          endif
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix( &
                 (Pxtisup_cas(iso_eau,il)), &
@@ -10846,5 +10846,5 @@
         do il=1,ncas
          ! changement: >0 -> >ridicule*1e-2
-         if (Pqisup_cas(il).gt.ridicule*1e-2) THEN
+         IF (Pqisup_cas(il).gt.ridicule*1e-2) THEN
             do ixt=1,niso  
               Risup(ixt,il)=Pxtisup_cas(ixt,il)/Pqisup_cas(il)
@@ -10865,6 +10865,6 @@
               CALL iso_verif_noNaN(xtevap_cas(ixt,il), &
                   'appel_stewart_np 286')
-              if (iso_verif_noNaN_nostop(xtwater_cas(ixt,il), &
-                  'appel_stewart_np 1594').eq.1) THEN
+              IF (iso_verif_noNaN_nostop(xtwater_cas(ixt,il), &
+                  'appel_stewart_np 1594').EQ.1) THEN
                  WRITE(*,*) 'il,ixt=',il,ixt
                  WRITE(*,*) 'water_cas(il)=',water_cas(il)
@@ -10877,10 +10877,10 @@
 #endif
 #ifdef ISOVERIF   
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             do il=1,ncas
               CALL iso_verif_egalite_choix(xtwater_cas(iso_eau,il), &
                 water_cas(il),'appel_stewart_np 262.2, cas 1.1', &
                 errmax,errmaxrel)
-              if ((xtwater_cas(iso_eau,il).eq.0).and. &
+              IF ((xtwater_cas(iso_eau,il).EQ.0).AND. &
                 (water_cas(il).gt.ridicule)) THEN
                WRITE(*,*) 'appel_stewart_np 263.2, cas 1.1'
@@ -10889,5 +10889,5 @@
                stop
               endif
-              if (oktrac.eq.0) THEN
+              IF (oktrac.EQ.0) THEN
 !                  WRITE(*,*) 'appel_stewart_np 1743 noevap tmp: il=',il
              CALL iso_verif_egalite_choix(xtp_cas(iso_eau,il), &
@@ -10898,11 +10898,11 @@
                 'appel_stewart_np 275.2, cas 1.1', &
                 errmax,errmaxrel)
-             endif !if (oktrac.eq.0) THEN
+             endif !if (oktrac.EQ.0) THEN
              enddo !do il=1,ncas
             endif ! if (iso_eau.gt.0) THEN
-            if (oktrac.eq.0) THEN
-            if (iso_HDO.gt.0) THEN
+            IF (oktrac.EQ.0) THEN
+            IF (iso_HDO.gt.0) THEN
               do il=1,ncas
-                if (qp_cas(il).gt.ridicule) THEN
+                IF (qp_cas(il).gt.ridicule) THEN
                 CALL iso_verif_aberrant( &
                 xtp_cas(iso_HDO,il)/qp_cas(il), &
@@ -10911,5 +10911,5 @@
               enddo !do il=1,ncas 
             endif  ! if (iso_HDO.gt.0) THEN
-            endif !if (oktrac.eq.0) THEN
+            endif !if (oktrac.EQ.0) THEN
 #endif           
 
@@ -10947,8 +10947,8 @@
 
         ! inputs
-        integer ncas
-        real xtp_avantevap_cas(niso,ncas), &
+        INTEGER ncas
+        REAL xtp_avantevap_cas(niso,ncas), &
                 qp_avantevap_cas(ncas)
-        real xtp_avantevaptrac_cas(niso,ncas), &
+        REAL xtp_avantevaptrac_cas(niso,ncas), &
                 qp_avantevaptrac_cas(ncas)
         ! dans le cas des traceurs: xtp_avantevaptrac_cas est la
@@ -10957,23 +10957,23 @@
         ! on rééquilibre la goutte avec le total de toutes les zones,
         ! mais c'est xtp_avantevaptrac_cas qui recoit l'évap
-        real Pqisup_cas(ncas), Pxtisup_cas(niso,ncas)
-        real Pqiinf_stewart(ncas), Eqi_stewart(ncas)
-        real fac_ftmr_cas(ncas),Eqi_prime_cas(ncas)
-        real Eqi_cas(ncas)
-        real T_cas(ncas),delP_cas(ncas), &
+        REAL Pqisup_cas(ncas), Pxtisup_cas(niso,ncas)
+        REAL Pqiinf_stewart(ncas), Eqi_stewart(ncas)
+        REAL fac_ftmr_cas(ncas),Eqi_prime_cas(ncas)
+        REAL Eqi_cas(ncas)
+        REAL T_cas(ncas),delP_cas(ncas), &
                 xtevapsup_cas(niso,ncas), &
                 wt_cas(ncas),qeff(ncas), &
                 qs_cas(ncas),water_cas(ncas), &
                 qp_cas(ncas)
-        integer oktrac      
+        INTEGER oktrac
 #ifdef ISOTRAC        
-        real ptrac(ncas)  
-        real hdiag(ncas)
+        REAL ptrac(ncas)
+        REAL hdiag(ncas)
 #endif        
 #ifdef ISOVERIF        
-        real evap_cas(ncas)   
+        REAL evap_cas(ncas)
 #endif        
-        integer INB_cas(ncas),i
-        real g,sigd(ncas)
+        INTEGER INB_cas(ncas),i
+        REAL g,sigd(ncas)
         ! outputs
         real  xtp_cas(niso,ncas),xtwater_cas(niso,ncas), &
@@ -10981,8 +10981,8 @@
 
         ! locals        
-        integer il,ixt        
-        real Pxtiinf_stewart(niso,ncas),  &
+        INTEGER il,ixt
+        REAL Pxtiinf_stewart(niso,ncas),  &
                 Exi_stewart(niso,ncas)
-        real xtnew(niso,ncas)
+        REAL xtnew(niso,ncas)
 !#ifdef ISOVERIF
 !        integer iso_verif_egalite_choix_nostop
@@ -11001,5 +11001,5 @@
 !     :           qp_avantevap_cas(162)
 !        endif !if (ncas_evap_liq.ge.162) THEN
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
           do il=1,ncas
 !            WRITE(*,*) 'appel tmp 1492: il=',il
@@ -11029,10 +11029,10 @@
 #ifdef ISOTRAC       
        ! à l'avenir, il faudra faire les choses plus proprement!
-       if (oktrac.eq.1) THEN
+       IF (oktrac.EQ.1) THEN
            ! on renormalise le flux de précip et d'évap
            ! on suppose que la seule différence entre les différentes
            ! zones, c'est la compo du liquide
            do il=1,ncas
-            if (ptrac(il).gt.1e-20) THEN
+            IF (ptrac(il).gt.1e-20) THEN
              Pqisup_cas(il)=Pqisup_cas(il)/ptrac(il)
              Eqi_stewart(il)=Eqi_stewart(il)/ptrac(il)
@@ -11058,9 +11058,9 @@
             endif !if (ptrac(il).gt.0.0) THEN
            enddo !do il=1,ncas
-       endif !if (oktrac.eq.1) THEN
+       endif !if (oktrac.EQ.1) THEN
 #endif       
         
 
-        if (no_pce.eq.1) THEN
+        IF (no_pce.EQ.1) THEN
             CALL stewart_sublim_nofrac_vectall( &
              ncas,qp_avantevap_cas(1), &
@@ -11069,5 +11069,5 @@
              Pxtiinf_stewart(1,1),xtnew(1,1),Exi_stewart(1,1), &
              fac_ftmr_cas(1))
-        else !if (no_pce.eq.1) THEN
+        else !if (no_pce.EQ.1) THEN
       CALL stewart_explicite_vectall(ncas, &
              qp_avantevap_cas(1),xtp_avantevap_cas(1,1), &
@@ -11082,8 +11082,8 @@
 #endif
         )
-         endif !if (no_pce.eq.1) THEN
+         endif !if (no_pce.EQ.1) THEN
 #ifdef ISOTRAC      
       ! à l'avenir, il faudra faire les choses plus proprement!
-      if (oktrac.eq.1) THEN
+      IF (oktrac.EQ.1) THEN
            ! on renormalise le flux de précip et d'évap
            ! on suppose que la seule différence entre les différentes
@@ -11102,9 +11102,9 @@
              hdiag(il)=qeff(il)/qs_cas(il)
            enddo !do il=1,ncas
-       endif !if (oktrac.eq.1) THEN
-#endif
-
-#ifdef ISOVERIF
-       if (iso_eau.gt.0) THEN
+       endif !if (oktrac.EQ.1) THEN
+#endif
+
+#ifdef ISOVERIF
+       IF (iso_eau.gt.0) THEN
           do il=1,ncas     
                 CALL iso_verif_egalite_choix( &
@@ -11118,5 +11118,5 @@
                 'appel_stewart_np 586', &
                 errmax,errmaxrel)
-                if (Pqiinf_stewart(il).gt.ridicule) THEN
+                IF (Pqiinf_stewart(il).gt.ridicule) THEN
                   CALL iso_verif_egalite_choix(( &
                    Pxtiinf_stewart(iso_eau,il)/Pqiinf_stewart(il)), &
@@ -11145,10 +11145,10 @@
         ! qui sort de la boite i (Pqiinf_par)
         do il=1,ncas
-          if (abs(water_cas(il)).lt.ridicule/10.) THEN
+          IF (abs(water_cas(il)).lt.ridicule/10.) THEN
             do ixt=1,niso
                xtwater_cas(ixt,il)=0.0
             enddo !do ixt=1,niso
-          else !if (water(il,i).eq.0.0) THEN
-             if (Pqiinf_stewart(il).gt.0.0) then  !if (Pxtiinf_par(iso_eau).gt.0.0) THEN
+          else !if (water(il,i).EQ.0.0) THEN
+             IF (Pqiinf_stewart(il).gt.0.0) then  !if (Pxtiinf_par(iso_eau).gt.0.0) THEN
                do ixt=1,niso 
                  xtwater_cas(ixt,il)=water_cas(il) &
@@ -11162,5 +11162,5 @@
                 enddo !do ixt=1,niso
              endif
-           endif !if (water(il,i).eq.0.0) THEN
+           endif !if (water(il,i).EQ.0.0) THEN
          enddo !do il=1,ncas
         
@@ -11171,11 +11171,11 @@
                'appel_stewart_np 566')
         enddo !do ixt=1,niso
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
          CALL iso_verif_egalite_choix(xtwater_cas(iso_eau,il), &
                 water_cas(il),'appel_stewart_np 568',errmax,errmaxrel)
-         if (water_cas(il).gt.ridicule*10) THEN
-             if (iso_verif_egalite_choix_nostop( &
+         IF (water_cas(il).gt.ridicule*10) THEN
+             IF (iso_verif_egalite_choix_nostop( &
                 xtwater_cas(iso_eau,il)/water_cas(il),1.0, &
-                'appel stewart 155',errmax*10,errmaxrel*10).eq.1) THEN
+                'appel stewart 155',errmax*10,errmaxrel*10).EQ.1) THEN
 !               WRITE(*,*) 'i=',i
                WRITE(*,*) 'Tevap=',T_cas(il)
@@ -11199,5 +11199,5 @@
         ! calcule xtevapi.    
        do il=1,ncas
-        if (Eqi_stewart(il)*fac_ftmr_cas(il).gt.ridicule) THEN
+        IF (Eqi_stewart(il)*fac_ftmr_cas(il).gt.ridicule) THEN
             ! changement le 20avril 2012: >0 -> >ridicule
          do ixt=1,niso          
@@ -11218,8 +11218,8 @@
       do il=1,ncas
         do ixt=1,niso
-         if ((iso_verif_noNAN_nostop(xtevap_cas(ixt,il), &
-          'appel stewart 131').eq.1).or. &
+         IF ((iso_verif_noNAN_nostop(xtevap_cas(ixt,il), &
+          'appel stewart 131').EQ.1).OR. &
            (iso_verif_noNAN_nostop(xtnew(ixt,il), &
-          'appel stewart 131b').eq.1)) THEN
+          'appel stewart 131b').EQ.1)) THEN
            WRITE(*,*) 'Exi_stewart(ixt,il)=',Exi_stewart(ixt,il)
            WRITE(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
@@ -11234,12 +11234,12 @@
 #ifdef ISOVERIF
       do il=1,ncas
-        if (oktrac.eq.0) THEN
+        IF (oktrac.EQ.0) THEN
             ! dans le cas traceur, le calcul de evap_cas est plus
             ! compliqué: il faut le faire plus proprement dans
             ! compress_stewart
-        if (iso_eau.gt.0) THEN
-            if (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il), &
+        IF (iso_eau.gt.0) THEN
+            IF (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il), &
                  evap_cas(il),'appel stewart 142', &
-                errmax,errmaxrel).eq.1) THEN
+                errmax,errmaxrel).EQ.1) THEN
               WRITE(*,*) 'il=',il
               WRITE(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
@@ -11254,8 +11254,8 @@
             endif
         endif !if (iso_eau.gt.0) THEN
-        endif !if (oktrac.eq.0) THEN
+        endif !if (oktrac.EQ.0) THEN
 #ifdef ISOTRAC
-        if (oktrac.eq.1) THEN
-        if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) THEN
+        IF (oktrac.EQ.1) THEN
+        IF ((iso_eau.gt.0).AND.(iso_HDO.gt.0)) THEN
              CALL iso_verif_aberrant_choix( &
                 (xtp_avantevaptrac_cas(iso_HDO,il)), &
@@ -11263,5 +11263,5 @@
                 ridicule_trac,deltalimtrac, &
                 'appel_stewart_np 2053')
-        endif !if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) THEN
+        endif !if ((iso_eau.gt.0).AND.(iso_HDO.gt.0)) THEN
         endif
 #endif
@@ -11272,7 +11272,7 @@
       
       do il=1,ncas
-       if (i.lt.INB_cas(il)) THEN
-          if (fac_ftmr_cas(il).gt.0.0) THEN
-             if (Eqi_stewart(il)*fac_ftmr_cas(il).gt.ridicule) THEN
+       IF (i.lt.INB_cas(il)) THEN
+          IF (fac_ftmr_cas(il).gt.0.0) THEN
+             IF (Eqi_stewart(il)*fac_ftmr_cas(il).gt.ridicule) THEN
                do ixt=1,niso               
                !   xtp(ixt,il,i)=xtnew(ixt)*qp(il,i)/xtnew(4)
@@ -11282,6 +11282,6 @@
                enddo !do ixt=1,niso
              else ! if (Eqi_stewart.gt.ridicule) THEN
-                if (qp_cas(il).gt.0.0) THEN
-                    if (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.ridicule) &
+                IF (qp_cas(il).gt.0.0) THEN
+                    IF (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.ridicule) &
                          THEN
                         ! il va manquer quelque chose: il faut augmenter
@@ -11315,13 +11315,13 @@
             endif !if (Eqi_stewart.gt.ridicule) THEN
 #ifdef ISOVERIF       
-!            if (il.eq.87) THEN
+!            if (il.EQ.87) THEN
 !                WRITE(*,*) 'appel_stewart_np 2244: tmp, après calcul xtp'
 !                WRITE(*,*) 'xtnew(:,il)=',xtnew(:,il)
 !                WRITE(*,*) 'Pxtiinf_stewart(:,il)=',
 !     :             Pxtiinf_stewart(:,il)
-!            endif  !if (il.eq.87) THEN
+!            endif  !if (il.EQ.87) THEN
             do ixt=1,niso
-              if (iso_verif_noNAN_nostop(xtp_cas(ixt,il), &
-                       'appel stewart 684').eq.1) THEN
+              IF (iso_verif_noNAN_nostop(xtp_cas(ixt,il), &
+                       'appel stewart 684').EQ.1) THEN
                 WRITE(*,*) 'i,INB_cas(il)=',i,INB_cas(il)
                 WRITE(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
@@ -11341,6 +11341,6 @@
 #ifdef ISOVERIF  
 #ifdef ISOTRAC 
-            if (oktrac.eq.1) THEN
-            if ((iso_HDO.gt.0).and.(iso_eau.gt.0)) THEN
+            IF (oktrac.EQ.1) THEN
+            IF ((iso_HDO.gt.0).AND.(iso_eau.gt.0)) THEN
                 ! le 10 mai 2009: on remonte le seuil de vérif de deltaD
                 ! aberrant car dans le cas des traceurs, des très
@@ -11348,8 +11348,8 @@
                 ! influencées par des évaps qui peuvent être aberantes
                 ! si ces evaps sont petites
-                if (iso_verif_aberrant_choix_nostop( &
+                IF (iso_verif_aberrant_choix_nostop( &
                 xtp_cas(iso_HDO,il),xtp_cas(iso_eau,il), &
                 ridicule_trac,deltalimtrac, &
-                'appel_stewart_np 2090').eq.1) THEN
+                'appel_stewart_np 2090').EQ.1) THEN
                   WRITE(*,*) 'xtp_avantevaptrac_cas(iso_eau),deltaD=', &
                    xtp_avantevaptrac_cas(iso_eau,il),deltaD &
@@ -11386,12 +11386,12 @@
                 endif
         endif !if (iso_HDO.gt.0) THEN
-       endif !if (oktrac.eq.1) THEN
+       endif !if (oktrac.EQ.1) THEN
 #endif
 !#ifdef ISOTRAC
-          if (oktrac.eq.0) THEN
-            if (iso_eau.gt.0) THEN
-              if (iso_verif_egalite_choix_nostop(xtp_cas(iso_eau,il), &
+          IF (oktrac.EQ.0) THEN
+            IF (iso_eau.gt.0) THEN
+              IF (iso_verif_egalite_choix_nostop(xtp_cas(iso_eau,il), &
               qp_cas(il),'appel stewart 688', &
-                errmax,errmaxrel*30).eq.1) THEN
+                errmax,errmaxrel*30).EQ.1) THEN
                   WRITE(*,*) 'il=',il
                   WRITE(*,*) 'q,xtp_avantevap_cas(iso_eau)=', &
@@ -11410,9 +11410,9 @@
               endif !if (iso_verif_egalite_choix_nostop(xtp_cas(iso_eau,il),
            endif !if (iso_eau.gt.0) THEN
-           if ((iso_HDO.gt.0).and. &
+           IF ((iso_HDO.gt.0).AND. &
                 (qp_cas(il).gt.ridicule)) THEN
-             if (iso_verif_aberrant_nostop(xtp_cas(iso_HDO,il)/ &
+             IF (iso_verif_aberrant_nostop(xtp_cas(iso_HDO,il)/ &
               qp_cas(il), &
-              'appel_stewart_np 1079').eq.1) THEN
+              'appel_stewart_np 1079').EQ.1) THEN
                WRITE(*,*) 'i,qp(cas_evap_liq(il),i)=', &
                         i,qp_cas(il)
@@ -11423,5 +11423,5 @@
              endif
            endif !if (iso_HDO.gt.0) THEN
-        endif ! if (oktrac.eq.0) THEN
+        endif ! if (oktrac.EQ.0) THEN
 #endif              
 
@@ -11456,6 +11456,6 @@
       do il=1,ncas
 #ifdef ISOTRAC
-        if ((iso_HDO.gt.0).and.(iso_eau.gt.0)) THEN
-          if (oktrac.eq.1) THEN
+        IF ((iso_HDO.gt.0).AND.(iso_eau.gt.0)) THEN
+          IF (oktrac.EQ.1) THEN
               CALL iso_verif_aberrant_choix( &
                 xtp_cas(iso_HDO,il),xtp_cas(iso_eau,il), &
@@ -11466,12 +11466,12 @@
       enddo !do il=1,ncas  
       
-      if (oktrac.eq.0) THEN
-      if (iso_eau.gt.0) THEN
+      IF (oktrac.EQ.0) THEN
+      IF (iso_eau.gt.0) THEN
        do il=1,ncas       
-        if (iso_verif_egalite_choix_nostop( &
+        IF (iso_verif_egalite_choix_nostop( &
                  xtp_cas(iso_eau,il), &
                  qp_cas(il), &
                 'appel stewart 197', &
-                errmax,errmaxrel*50).eq.1) THEN
+                errmax,errmaxrel*50).EQ.1) THEN
           WRITE(*,*) 'i=',i,' INB=',INB_cas(il)
           WRITE(*,*) 'Tevap=',T_cas(il)
@@ -11495,9 +11495,9 @@
         enddo !do il=1,ncas
       endif !if (iso_eau.gt.0) THEN
-      if (iso_HDO.gt.0) THEN
+      IF (iso_HDO.gt.0) THEN
        do il=1,ncas
 !        WRITE(*,*) 'appel_stewart_np 2166: fin make_cas_evap_liq_np, ',
 !     :        'il,deltaDqp=',il,deltaD(xtp_cas(iso_HDO,il)/qp_cas(il))
-        if (qp_cas(il).gt.ridicule) THEN
+        IF (qp_cas(il).gt.ridicule) THEN
           CALL iso_verif_aberrant( &
                 xtp_cas(iso_HDO,il)/qp_cas(il), &
@@ -11506,5 +11506,5 @@
        enddo !do il=1,ncas     
       endif 
-      endif ! if (oktrac.eq.0) THEN
+      endif ! if (oktrac.EQ.0) THEN
 #endif
 
@@ -11536,33 +11536,33 @@
 
         ! inputs
-        integer ncas
-        real xtp_avantevap_cas(niso,ncas), &
+        INTEGER ncas
+        REAL xtp_avantevap_cas(niso,ncas), &
                 qp_avantevap_cas(ncas)
-        real xtp_avantevaptrac_cas(niso,ncas), &
+        REAL xtp_avantevaptrac_cas(niso,ncas), &
                 qp_avantevaptrac_cas(ncas)
-        real Pqisup_cas(ncas), Pxtisup_cas(niso,ncas)
-        real Pqiinf_stewart(ncas), Eqi_stewart(ncas)
-        real fac_ftmr_cas(ncas),Eqi_prime_cas(ncas), &
+        REAL Pqisup_cas(ncas), Pxtisup_cas(niso,ncas)
+        REAL Pqiinf_stewart(ncas), Eqi_stewart(ncas)
+        REAL fac_ftmr_cas(ncas),Eqi_prime_cas(ncas), &
                 Eqi_cas(ncas)
-        real T_cas(ncas),delP_cas(ncas), &
+        REAL T_cas(ncas),delP_cas(ncas), &
                 xtevapsup_cas(niso,ncas), &
                 wt_cas(ncas),qeff(ncas), &
                 qs_cas(ncas),water_cas(ncas)
-        real qp_cas(ncas)      
-#ifdef ISOVERIF
-        real evap_cas(ncas)
-        integer oktrac
+        REAL qp_cas(ncas)
+#ifdef ISOVERIF
+        REAL evap_cas(ncas)
+        INTEGER oktrac
 #endif        
-        real g,sigd(ncas)
-        integer frac_sublim
-        integer INB_cas(ncas),i
+        REAL g,sigd(ncas)
+        INTEGER frac_sublim
+        INTEGER INB_cas(ncas),i
         ! outputs
         real  xtp_cas(niso,ncas),xtwater_cas(niso,ncas), &
                 xtevap_cas(niso,ncas)
         ! locals        
-        integer il,ixt
-        real Pxtiinf_stewart(niso,ncas),  &
+        INTEGER il,ixt
+        REAL Pxtiinf_stewart(niso,ncas),  &
                 Exi_stewart(niso,ncas)
-        real xtnew(niso,ncas)     
+        REAL xtnew(niso,ncas)
 !#ifdef ISOVERIF
 !        real 
@@ -11574,5 +11574,5 @@
 #ifdef ISOVERIF  
 !      WRITE(*,*) 'appel_stewart_np 2052: entrée dans make_cas_evap_glace'
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
           do il=1,ncas
             CALL iso_verif_egalite_choix( &
@@ -11600,5 +11600,5 @@
       !    Eqi_prime sont les même que Eqi_par
 
-      if (frac_sublim.eq.1) THEN
+      IF (frac_sublim.EQ.1) THEN
             CALL stewart_glace_vectall(ncas, &
              qp_avantevap_cas(1),xtp_avantevap_cas(1,1),Pqisup_cas(1), &
@@ -11607,5 +11607,5 @@
              fac_ftmr_cas(1), &
              T_cas(1))
-      else !if (frac_sublim.eq.1) THEN
+      else !if (frac_sublim.EQ.1) THEN
 !#ifdef ISOVERIF
 !            WRITE(*,*) 'appel_stewart_explicite_np 2269'
@@ -11623,8 +11623,8 @@
               Pxtiinf_stewart(1,1),xtnew(1,1),Exi_stewart(1,1), &
               fac_ftmr_cas(1))
-      endif !if (frac_sublim.eq.1) THEN
+      endif !if (frac_sublim.EQ.1) THEN
 #ifdef ISOVERIF
 !       WRITE(*,*) 'appel_stewart_np 2096: dans make_cas_evap_glace'
-       if (iso_eau.gt.0) THEN
+       IF (iso_eau.gt.0) THEN
           do il=1,ncas       
              CALL iso_verif_egalite_choix( &
@@ -11637,9 +11637,9 @@
                 'appel_stewart_np 586', &
                errmax,errmaxrel)
-             if (Pqiinf_stewart(il).gt.ridicule) THEN
-                if (iso_verif_egalite_choix_nostop(( &
+             IF (Pqiinf_stewart(il).gt.ridicule) THEN
+                IF (iso_verif_egalite_choix_nostop(( &
                 Pxtiinf_stewart(iso_eau,il)/Pqiinf_stewart(il)), &
                 1.,'appel_setwart 575b', errmax*10, errmaxrel*10) &
-                 .eq.1) THEN
+                 .EQ.1) THEN
                    WRITE(*,*) 'Pqiinf_stewart(il)=',Pqiinf_stewart(il)
 !                   WRITE(*,*) 'Pqiinf_par(il)=',Pqiinf_par(il)
@@ -11657,10 +11657,10 @@
         ! qui sort de la boite i (Pqiinf_par)
         do il=1,ncas
-          if (abs(water_cas(il)).lt.ridicule/10.) THEN
+          IF (abs(water_cas(il)).lt.ridicule/10.) THEN
             do ixt=1,niso
                xtwater_cas(ixt,il)=water_cas(il)*Rdefault(ixt)
             enddo !do ixt=1,niso
-          else !if (water(il,i).eq.0.0) THEN
-             if (Pqiinf_stewart(il).gt.0.0) then  !if (Pxtiinf_par(iso_eau).gt.0.0) THEN
+          else !if (water(il,i).EQ.0.0) THEN
+             IF (Pqiinf_stewart(il).gt.0.0) then  !if (Pxtiinf_par(iso_eau).gt.0.0) THEN
                do ixt=1,niso 
                  xtwater_cas(ixt,il)=water_cas(il) &
@@ -11674,5 +11674,5 @@
                 enddo !do ixt=1,niso
              endif
-           endif !if (water(il,i).eq.0.0) THEN
+           endif !if (water(il,i).EQ.0.0) THEN
          enddo !do il=1,ncas
         
@@ -11684,11 +11684,11 @@
                 'appel_stewart_np 566b')
         enddo !do ixt=1,niso
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
          CALL iso_verif_egalite_choix(xtwater_cas(iso_eau,il), &
                 water_cas(il),'appel_stewart_np 568b',errmax,errmaxrel)
-         if (water_cas(il).gt.ridicule*10) THEN
-             if (iso_verif_egalite_choix_nostop( &
+         IF (water_cas(il).gt.ridicule*10) THEN
+             IF (iso_verif_egalite_choix_nostop( &
                 xtwater_cas(iso_eau,il)/water_cas(il),1.0, &
-                'appel stewart 155b',errmax*10,errmaxrel*10).eq.1) THEN
+                'appel stewart 155b',errmax*10,errmaxrel*10).EQ.1) THEN
                WRITE(*,*) 'i=',i
                WRITE(*,*) 'Tevap=',T_cas(il)
@@ -11712,5 +11712,5 @@
         ! calcule xtevapi.    
        do il=1,ncas
-        if (Eqi_stewart(il)*fac_ftmr_cas(il).gt.0.0) THEN
+        IF (Eqi_stewart(il)*fac_ftmr_cas(il).gt.0.0) THEN
          do ixt=1,niso          
           xtevap_cas(ixt,il)=Eqi_cas(il) &
@@ -11732,12 +11732,12 @@
           CALL iso_verif_noNAN(xtevap_cas(ixt,il),'appel stewart 131b')
         enddo ! do ixt=1,niso
-        if (oktrac.eq.0) THEN
+        IF (oktrac.EQ.0) THEN
             ! dans le cas traceur, le calcul de evap_cas est plus
             ! compliqué: il faut le faire plus proprement dans
             ! compress_stewart
-        if (iso_eau.gt.0) THEN
-            if (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il), &
+        IF (iso_eau.gt.0) THEN
+            IF (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il), &
               evap_cas(il), &
-              'appel stewart 142b',errmax,errmaxrel).eq.1) THEN
+              'appel stewart 142b',errmax,errmaxrel).EQ.1) THEN
                 WRITE(*,*) 'i,il=',i,il
                 WRITE(*,*) 'Exi_stewart(iso_eau,il),Eqi_stewart(il)=', &
@@ -11751,5 +11751,5 @@
             endif !if (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il),
         endif !if (iso_eau.gt.0) THEN
-       endif ! if (oktrac.eq.0) THEN
+       endif ! if (oktrac.EQ.0) THEN
       enddo !do il=1,ncas 
 #endif
@@ -11771,8 +11771,8 @@
 
       do il=1,ncas
-       if (i.lt.INB_cas(il)) THEN
-          if (fac_ftmr_cas(il).gt.0.0) THEN
+       IF (i.lt.INB_cas(il)) THEN
+          IF (fac_ftmr_cas(il).gt.0.0) THEN
 !           if (Eqi_stewart(il).gt.ridicule) THEN
-            if (Eqi_stewart(il)*fac_ftmr_cas(il).gt.ridicule) THEN
+            IF (Eqi_stewart(il)*fac_ftmr_cas(il).gt.ridicule) THEN
 !               WRITE(*,*) 'appel_stewart_v_np 2633 tmp: il=',il
                do ixt=1,niso     
@@ -11784,5 +11784,5 @@
                
 #ifdef ISOVERIF
-               if (iso_eau.gt.0) THEN
+               IF (iso_eau.gt.0) THEN
                  CALL iso_verif_egalite_choix( &
                     xtp_cas(iso_eau,il),qp_cas(il), &
@@ -11792,8 +11792,8 @@
 
              else ! if (Eqi_stewart.gt.ridicule) THEN
-                if (qp_cas(il).gt.0.0) THEN
+                IF (qp_cas(il).gt.0.0) THEN
 !                    if (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.ridicule)
 !     &                   THEN
-                        if ((Eqi_prime_cas(il)-Eqi_stewart(il)) &
+                        IF ((Eqi_prime_cas(il)-Eqi_stewart(il)) &
                        *fac_ftmr_cas(il).gt.ridicule) THEN
                         ! il va manquer quelque chose: il faut augmenter
@@ -11802,5 +11802,5 @@
                         ! pour l'instant, on bidouille:
 
-                        if (qp_avantevap_cas(il)+Eqi_stewart(il) &
+                        IF (qp_avantevap_cas(il)+Eqi_stewart(il) &
                          *fac_ftmr_cas(il).gt.ridicule) THEN
                         !WRITE(*,*) 'appel_stewart_np 2500: il=',il
@@ -11827,5 +11827,5 @@
                     enddo !do ixt=1,niso
 #ifdef ISOVERIF
-                    if (iso_eau.gt.0) THEN
+                    IF (iso_eau.gt.0) THEN
                       CALL iso_verif_egalite_choix( &
                     xtp_cas(iso_eau,il),qp_cas(il), &
@@ -11846,10 +11846,10 @@
 #endif
 #ifdef ISOVERIF
-             if (oktrac.eq.0) THEN
-                if (iso_eau.gt.0) THEN
-                  if (iso_verif_egalite_choix_nostop( &
+             IF (oktrac.EQ.0) THEN
+                IF (iso_eau.gt.0) THEN
+                  IF (iso_verif_egalite_choix_nostop( &
                     xtp_cas(iso_eau,il),qp_cas(il), &
                     'appel stewart 688b',errmax,errmaxrel*30) &
-                    .eq.1) THEN
+                    .EQ.1) THEN
                     WRITE(*,*) 'il=',il
                     WRITE(*,*) 'xtp_avantevaptrac_cas(iso_eau,il)=', &
@@ -11864,5 +11864,5 @@
                   endif
                endif !if (iso_eau.gt.0) THEN
-              if ((iso_HDO.gt.0).and. &
+              IF ((iso_HDO.gt.0).AND. &
                 (qp_cas(il).gt.ridicule)) THEN
                 CALL iso_verif_aberrant( &
@@ -11870,5 +11870,5 @@
                 'appel_stewart_np 1384')
               endif  ! if (iso_HDO.gt.0) THEN
-            endif ! if (oktrac.eq.0) THEN
+            endif ! if (oktrac.EQ.0) THEN
 #endif 
 
@@ -11901,12 +11901,12 @@
 #endif
 #ifdef ISOVERIF
-        if (oktrac.eq.0) THEN
-        if (iso_eau.gt.0) THEN
+        IF (oktrac.EQ.0) THEN
+        IF (iso_eau.gt.0) THEN
         do il=1,ncas
-        if (iso_verif_egalite_choix_nostop( &
+        IF (iso_verif_egalite_choix_nostop( &
                  xtp_cas(iso_eau,il), &
                  qp_cas(il), &
                 'appel stewart 197b: cas_evap_glace', &
-                errmax,errmaxrel*50).eq.1) THEN
+                errmax,errmaxrel*50).EQ.1) THEN
           WRITE(*,*) 'i,il=',i,il,' INB(il)=',INB_cas(il)
 !     &          ,' cas(il)=',cas_evap_glace(il)
@@ -11932,7 +11932,7 @@
          enddo !do il=1,ncas
         endif
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
           do il=1,ncas
-            if (qp_cas(il).gt.ridicule) THEN
+            IF (qp_cas(il).gt.ridicule) THEN
                 CALL iso_verif_aberrant( &
                 xtp_cas(iso_HDO,il)/qp_cas(il), &
@@ -11941,5 +11941,5 @@
           enddo !do il=1,ncas
         endif  ! if (iso_HDO.gt.0) THEN
-       endif ! if (oktrac.eq.0) THEN
+       endif ! if (oktrac.EQ.0) THEN
 !       WRITE(*,*) 'appel_stewart_np 2331: sortie de make_cas_evap_glace'
 #endif
@@ -11965,16 +11965,16 @@
         ! déclarations
         ! **inputs
-        real xt(ntraciso),qt,cond,tcond,zfice ! tcond en K        
+        REAL xt(ntraciso),qt,cond,tcond,zfice ! tcond en K
         ! **outputs
-        real zxtice(ntraciso),zxtliq(ntraciso)
+        REAL zxtice(ntraciso),zxtliq(ntraciso)
         ! Rq: on met ntraciso au cas où on passe direct en argument les
         ! tableaux comportant les traceurs. Mais on ne fait que des
         ! isotopes normaux ici.
         ! **locals
-        real zxtalphal(niso),zxtalphai(niso)
-        real t_coup
+        REAL zxtalphal(niso),zxtalphai(niso)
+        REAL t_coup
         parameter (t_coup=273.15)
-        integer ixt
-        real zcond
+        INTEGER ixt
+        REAL zcond
 !#ifdef ISOVERIF    
 !        integer iso_verif_aberrant_nostop ! debugage
@@ -11986,5 +11986,5 @@
 
         ! traitement rapide du cas où cond=0
-        if (cond.eq.0) THEN
+        IF (cond.EQ.0) THEN
           do ixt=1,niso
             zxtliq(ixt)=0
@@ -11995,6 +11995,6 @@
 
         ! verif que qt n'est pas nul
-        if (qt.eq.0) THEN
-            if (cond.lt.ridicule) THEN
+        IF (qt.EQ.0) THEN
+            IF (cond.lt.ridicule) THEN
               do ixt=1,niso  
                 zxtliq(ixt)=0
@@ -12012,8 +12012,8 @@
         ! verif xt et qt
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(qt,xt(iso_eau), &
                'condiso_liq_ice_vectiso 62',errmax,errmaxrel)
-          endif  !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+          endif  !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
           CALL iso_verif_positif(qt-cond, &
                 'condiso_liq_ice_vectiso 56: cond>qt')
@@ -12024,5 +12024,5 @@
 #endif
           zcond=max(0.0,min(cond,qt))
-          if (essai_convergence) THEN
+          IF (essai_convergence) THEN
           else  
                 cond=min(cond,qt)
@@ -12041,15 +12041,15 @@
                 'condiso_liq_ice_vectiso 66')
         enddo
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(zxtalphal(iso_eau),1.0, &
                 'condiso 21',errmax,errmaxrel)
             CALL iso_verif_egalite_choix(zxtalphai(iso_eau),1.0, &
                 'condiso 21',errmax,errmaxrel)
-        endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-        if (iso_HDO.gt.0) THEN
-            if (qt.gt.ridicule) THEN
-               if (iso_verif_aberrant_nostop(xt(iso_HDO) &
+        endif !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+        IF (iso_HDO.gt.0) THEN
+            IF (qt.gt.ridicule) THEN
+               IF (iso_verif_aberrant_nostop(xt(iso_HDO) &
                  /qt*zxtalphai(iso_HDO)/faccond, &
-                 'condiso_liq_ice_vectiso 64').eq.1) THEN
+                 'condiso_liq_ice_vectiso 64').EQ.1) THEN
 !                WRITE(*,*) 'deltaDt=',(xt/qt/tnat(iso_HDO)-1)*1000
 !                WRITE(*,*) 'tcond,fcond,zxtalphai=',
@@ -12065,5 +12065,5 @@
                /(qt+zcond*(zxtalphal(ixt)-1))
         enddo
-        if (zcond/qt.lt.1e-5) THEN
+        IF (zcond/qt.lt.1e-5) THEN
            ! cas particulier pour éviter FI quand cond/qt->0  
            do ixt=1,niso
@@ -12071,5 +12071,5 @@
            enddo
 
-        else if (1.0-zcond/qt.lt.ridicule) THEN
+        ELSE IF (1.0-zcond/qt.lt.ridicule) THEN
            ! condensation totale
            ! on ajoute ce cas particulier le 9 avril 2012 car sur vargas
@@ -12087,32 +12087,32 @@
         ! verif egalité pour ixt=4 et eau normale:
 #ifdef ISOVERIF
-          if (zfice.lt.1) THEN
+          IF (zfice.lt.1) THEN
             do ixt=1,niso  
               CALL iso_verif_noNAN(zxtliq(ixt), &
                 'condiso_liq_ice_vectiso 91')
             enddo
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(zxtliq(iso_eau),cond, &
                 'condiso_liq_ice_vectiso 30',errmax,errmaxrel)
-            endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-            if (iso_HDO.gt.0) THEN
-                if (cond.gt.ridicule) THEN
+            endif ! if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+            IF (iso_HDO.gt.0) THEN
+                IF (cond.gt.ridicule) THEN
                     CALL iso_verif_aberrant(zxtliq(iso_HDO)/cond, &
                          'condiso_liq_ice_vectiso 32')
                 endif !if (cond.gt.ridicule) THEN
-            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) THEN
+            endif !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO)) THEN
           endif !if (zfice.lt.1) THEN
-          if (zfice.gt.0) THEN
+          IF (zfice.gt.0) THEN
             do ixt=1,niso    
             CALL iso_verif_noNAN(zxtice(ixt),'condiso_liq_ice_vectiso 149')
             enddo
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(zxtice(iso_eau),cond, &
                         'condiso_liq_ice_vectiso 31',errmax,errmaxrel)
-            endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-            if (iso_HDO.gt.0) THEN
-              if (cond.gt.ridicule) THEN
-                if (iso_verif_aberrant_nostop(zxtice(iso_HDO)/cond &
-                  /faccond,'condiso_liq_ice_vectiso 33').eq.1) THEN
+            endif ! if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+            IF (iso_HDO.gt.0) THEN
+              IF (cond.gt.ridicule) THEN
+                IF (iso_verif_aberrant_nostop(zxtice(iso_HDO)/cond &
+                  /faccond,'condiso_liq_ice_vectiso 33').EQ.1) THEN
                   WRITE(*,*) 'debug condiso 88: zfice=',zfice
                   WRITE(*,*) 'cond/qt=',cond/qt
@@ -12124,5 +12124,5 @@
                    (1-(1-cond/qt)**zxtalphai(iso_HDO))/(1-(1-cond/qt))
                   WRITE(*,*) 'tcond=',tcond-t_coup,'°C'
-                  if (tcond-t_coup.gt.-40.0) THEN
+                  IF (tcond-t_coup.gt.-40.0) THEN
                       ! au dessus de -40, il y a de quoi s'inquiéter
                       ! en dessous, on ne sait pas ce que valent les alphas
@@ -12151,17 +12151,17 @@
                 'condiso_liq_ice_vectiso 193')
         enddo
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix( &
                 zxtice(iso_eau)+zxtliq(iso_eau),cond, &
                 'condiso_liq_ice_vectiso 79',errmax,errmaxrel)
-          endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-#endif
-
-        if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+          endif ! if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+#endif
+
+        IF ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
             ! assurer convergence
-            if (zfice.eq.1.0) THEN
+            IF (zfice.EQ.1.0) THEN
                 zxtice(iso_eau)=cond
-            endif !if (zfice.eq.1.0) THEN
-       endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+            endif !if (zfice.EQ.1.0) THEN
+       endif !if ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
         do ixt=1,ntraciso
           zxtice(ixt)=max(0.0,zxtice(ixt))
@@ -12198,17 +12198,17 @@
         ! déclarations
         ! **inputs
-        integer n
-        real xt(ntraciso,n),qt(n),cond(n),tcond(n),zfice(n) ! tcond en K        
+        INTEGER n
+        REAL xt(ntraciso,n),qt(n),cond(n),tcond(n),zfice(n) ! tcond en K
         ! **outputs
-        real zxtice(ntraciso,n),zxtliq(ntraciso,n)
+        REAL zxtice(ntraciso,n),zxtliq(ntraciso,n)
         ! Rq: on met ntraciso au cas où on passe direct en argument les
         ! tableaux comportant les traceurs. Mais on ne fait que des
         ! isotopes normaux ici.
         ! **locals
-        real zxtalphal(niso,n),zxtalphai(niso,n)
-        real t_coup        
+        REAL zxtalphal(niso,n),zxtalphai(niso,n)
+        REAL t_coup
         parameter (t_coup=273.15)
-        real zcond(n)
-        integer ixt, i ! compteurs
+        REAL zcond(n)
+        INTEGER ixt, i ! compteurs
 #ifdef ISOVERIF
 !        integer iso_verif_aberrant_nostop ! debugage
@@ -12217,5 +12217,5 @@
 !        integer iso_verif_positif_nostop
 !        real deltaD
-        real xtv(niso,n),qv(n)
+        REAL xtv(niso,n),qv(n)
 #endif 
 
@@ -12231,5 +12231,5 @@
 #ifdef ISOVERIF   
 !          WRITE(*,*) 'condiso 253: entrée dans condiso'
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             do i=1,n
               CALL iso_verif_egalite_choix &
@@ -12237,6 +12237,6 @@
                'condiso_liq_ice_vectall 251',errmax,errmaxrel)
               enddo !do i=1,no
-          endif  !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-          if (iso_HDO.gt.0) THEN
+          endif  !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+          IF (iso_HDO.gt.0) THEN
             do i=1,n
 !             if (qt(i).gt.ridicule) THEN
@@ -12260,11 +12260,11 @@
                 'condiso_liq_ice_vectall 268: qt<0')
 #endif
-            if ((iso_verif_positif_nostop(qt(i)-cond(i), &
-             'condiso_liq_ice_vectall 269: cond>qt').eq.1).or. &
+            IF ((iso_verif_positif_nostop(qt(i)-cond(i), &
+             'condiso_liq_ice_vectall 269: cond>qt').EQ.1).OR. &
              (iso_verif_positif_nostop(tcond(i)-Tmin_verif, &
-             'condiso_liq_ice_vectall 284').eq.1).or.      &
+             'condiso_liq_ice_vectall 284').EQ.1).OR.      &
              (iso_verif_positif_nostop(370.0-tcond(i), &
-             'condiso_liq_ice_vectall 286').eq.1).or.  &
-             ((qt(i).eq.0).and.(cond(i).gt.ridicule))) THEN
+             'condiso_liq_ice_vectall 286').EQ.1).OR.  &
+             ((qt(i).EQ.0).AND.(cond(i).gt.ridicule))) THEN
               ! c'est impossible de condenser qi pas d'eau au départ
                 WRITE(*,*) 'condiso_liq_ice_vectall 315'
@@ -12300,15 +12300,15 @@
                 'condiso_liq_ice_vectall 66')
         enddo
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(zxtalphal(iso_eau,i),1.0, &
                 'condiso 21',errmax,errmaxrel)
             CALL iso_verif_egalite_choix(zxtalphai(iso_eau,i),1.0, &
                 'condiso 21',errmax,errmaxrel)
-        endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-        if (iso_HDO.gt.0) THEN
-            if (qt(i).gt.ridicule) THEN
-               if (iso_verif_aberrant_nostop(xt(iso_HDO,i) &
+        endif !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+        IF (iso_HDO.gt.0) THEN
+            IF (qt(i).gt.ridicule) THEN
+               IF (iso_verif_aberrant_nostop(xt(iso_HDO,i) &
                  /qt(i)*zxtalphai(iso_HDO,i)/faccond, &
-                 'condiso_liq_ice_vectall 64').eq.1) THEN
+                 'condiso_liq_ice_vectall 64').EQ.1) THEN
 !                WRITE(*,*) 'deltaDt=',(xt/qt/tnat(iso_HDO)-1)*1000
 !                WRITE(*,*) 'tcond,fcond,zxtalphai=',
@@ -12326,11 +12326,11 @@
        do i=1,n
        ! on change les seuils
-        if ((zcond(i).le.1e-15).or. &
-                ((qt(i).le.1e-15).and.(zcond(i).lt.ridicule))) THEN
+        IF ((zcond(i).le.1e-15).OR. &
+                ((qt(i).le.1e-15).AND.(zcond(i).lt.ridicule))) THEN
           do ixt=1,niso
             zxtliq(ixt,i)=0.0
             zxtice(ixt,i)=0.0
           enddo
-        else !if ((cond(i).le.0.0).or.
+        else !if ((cond(i).le.0.0).OR.
                         
          do ixt=1,niso
@@ -12340,5 +12340,5 @@
          enddo
 
-         if (zcond(i)/qt(i).lt.1e-5) THEN
+         IF (zcond(i)/qt(i).lt.1e-5) THEN
            ! cas particulier pour éviter FI quand cond/qt->0  
            do ixt=1,niso
@@ -12347,5 +12347,5 @@
            enddo !do ixt=1,niso
 
-        else if (1.0-zcond(i)/qt(i).lt.ridicule) THEN
+        ELSE IF (1.0-zcond(i)/qt(i).lt.ridicule) THEN
            ! condensation totale
            ! on ajoute ce cas particulier le 9 avril 2012 car sur vargas
@@ -12362,5 +12362,5 @@
            enddo !do ixt=1,niso
         endif !if (cond(i)/qt(i).lt.1e-5) THEN
-        endif  !if ((cond(i).le.0.0).or.
+        endif  !if ((cond(i).le.0.0).OR.
        enddo !do i=1,n
         
@@ -12371,8 +12371,8 @@
         do i=1,n
             do ixt=1,niso  
-              if ((iso_verif_noNaN_nostop(zxtliq(ixt,i), &
-                'condiso_liq_ice_vectall 91').eq.1).or. &
+              IF ((iso_verif_noNaN_nostop(zxtliq(ixt,i), &
+                'condiso_liq_ice_vectall 91').EQ.1).OR. &
                 (iso_verif_noNaN_nostop(zxtice(ixt,i), &
-                'condiso_liq_ice_vectall 92').eq.1)) THEN
+                'condiso_liq_ice_vectall 92').EQ.1)) THEN
                  WRITE(*,*) 'zxtalphal(ixt,i)=',zxtalphal(ixt,i)
                  WRITE(*,*) 'xt(ixt,i)=',xt(ixt,i)
@@ -12383,15 +12383,15 @@
             enddo !do ixt=1,niso 
  
-          if (zfice(i).lt.1.0) THEN
+          IF (zfice(i).lt.1.0) THEN
             do ixt=1,niso  
               CALL iso_verif_noNaN(zxtliq(ixt,i), &
                 'condiso_liq_ice_vectall 91')
             enddo
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(zxtliq(iso_eau,i),cond(i), &
                 'condiso_liq_ice_vectall 30',errmax,errmaxrel)
-            endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-            if (iso_HDO.gt.0) THEN
-              if (cond(i).gt.ridicule) THEN
+            endif ! if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+            IF (iso_HDO.gt.0) THEN
+              IF (cond(i).gt.ridicule) THEN
 #ifdef ISOTRAC
                   CALL iso_verif_aberrant_choix( &
@@ -12400,8 +12400,8 @@
                      'condiso_liq_ice_vectall 32')
 #else
-                  if (iso_verif_aberrant_choix_nostop( &
+                  IF (iso_verif_aberrant_choix_nostop( &
                      zxtliq(iso_HDO,i),cond(i), &
                      ridicule,deltalim_snow, &
-                     'condiso_liq_ice_vectall 32b').eq.1) THEN
+                     'condiso_liq_ice_vectall 32b').EQ.1) THEN
                     WRITE(*,*) 'deltaDvap=',deltaD(xt(iso_hdo,i)/qt(i))
                     WRITE(*,*) 'T,alphal=', &
@@ -12411,9 +12411,9 @@
                   endif !if (iso_verif_aberrant_nostop(
                   
-                    if (iso_O18.gt.0) THEN
-                    if (iso_verif_O18_aberrant_nostop( &
+                    IF (iso_O18.gt.0) THEN
+                    IF (iso_verif_O18_aberrant_nostop( &
                     zxtliq(iso_HDO,i)/cond(i), &
                     zxtliq(iso_O18,i)/cond(i), &
-                    'condiso_liq_ice_vectall 12546').eq.1) THEN
+                    'condiso_liq_ice_vectall 12546').EQ.1) THEN
                         WRITE(*,*) 'debug condiso_liq_ice_vect 12364: i,zfice=',i,zfice (i)
                         WRITE(*,*) 'cond,qt,cond/qt=',cond(i),qt(i),cond(i)/qt(i)
@@ -12429,10 +12429,10 @@
 
                 endif !if (cond(i).gt.ridicule) THEN
-            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) THEN
+            endif !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO)) THEN
         endif !if (zfice.lt.1) THEN
-          if (zfice(i).gt.0) THEN
+          IF (zfice(i).gt.0) THEN
             do ixt=1,niso    
-              if (iso_verif_noNAN_nostop(zxtice(ixt,i), &
-                'condiso_liq_ice_vectall 417').eq.1) THEN
+              IF (iso_verif_noNAN_nostop(zxtice(ixt,i), &
+                'condiso_liq_ice_vectall 417').EQ.1) THEN
                 WRITE(*,*) 'ixt,i=',ixt,i
                 WRITE(*,*) 'xt(ixt,i)=',xt(ixt,i)
@@ -12443,13 +12443,13 @@
               endif
             enddo !do ixt=1,niso    
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(zxtice(iso_eau,i),cond(i), &
                         'condiso_liq_ice_vectall 31',errmax,errmaxrel)
-            endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-            if (iso_HDO.gt.0) THEN
-              if (cond(i).gt.ridicule) THEN
-                if (iso_verif_aberrant_nostop( &
+            endif ! if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+            IF (iso_HDO.gt.0) THEN
+              IF (cond(i).gt.ridicule) THEN
+                IF (iso_verif_aberrant_nostop( &
                     zxtice(iso_HDO,i)/cond(i)/faccond, &
-                    'condiso_liq_ice_vectall 414').eq.1) THEN
+                    'condiso_liq_ice_vectall 414').EQ.1) THEN
                   WRITE(*,*) 'debug condiso_liq_ice_vect 13364: i,zfice=', &
                         i,zfice (i)
@@ -12468,5 +12468,5 @@
                   WRITE(*,*) 'tcond(i)=',tcond(i)-t_coup,'°C'
 
-                  if (tcond(i)-t_coup.gt.-40.0) THEN
+                  IF (tcond(i)-t_coup.gt.-40.0) THEN
                      ! sinon, c'est pas grave, il y aura juste une
                      ! abérrance dans les zones très froides. 
@@ -12483,9 +12483,9 @@
                   endif !if (iso_verif_aberrant_nostop
 
-                    if (iso_O18.gt.0) THEN
-                    if (iso_verif_O18_aberrant_nostop( &
+                    IF (iso_O18.gt.0) THEN
+                    IF (iso_verif_O18_aberrant_nostop( &
                     zxtice(iso_HDO,i)/cond(i), &
                     zxtice(iso_O18,i)/cond(i), &
-                    'condiso_liq_ice_vectall 12601').eq.1) THEN
+                    'condiso_liq_ice_vectall 12601').EQ.1) THEN
                         WRITE(*,*) 'debug condiso_liq_ice_vect 364: i,zfice=',i,zfice (i)
                         WRITE(*,*) 'cond,qt,cond/qt=',cond(i),qt(i),cond(i)/qt(i)
@@ -12503,6 +12503,6 @@
                     endif ! if (iso_O18.gt.0) THEN
                 endif !if (cond.gt.ridicule) THEN
-                if ((zcond(i)/max(qt(i),1e-15).gt.0.95).and. &
-                     (zfice(i).eq.1).and.(qt(i).gt.5e-4)) THEN
+                IF ((zcond(i)/max(qt(i),1e-15).gt.0.95).AND. &
+                     (zfice(i).EQ.1).AND.(qt(i).gt.5e-4)) THEN
                    ! verif que la vapeur est très pauvre
                    do ixt=1,niso
@@ -12524,6 +12524,6 @@
 #endif                   
                    qv(i)=qt(i)-zcond(i)
-                   if (qv(i).gt.ridicule) THEN
-                   if (deltaD(xtv(iso_HDO,i)/qv(i)).gt.-200.0) THEN
+                   IF (qv(i).gt.ridicule) THEN
+                   IF (deltaD(xtv(iso_HDO,i)/qv(i)).gt.-200.0) THEN
                         WRITE(*,*) 'condiso 454: deltaDv trop fort'
                         WRITE(*,*) 'tcond(i)-t_coup=',tcond(i)-t_coup
@@ -12545,12 +12545,12 @@
 #ifdef ISOVERIF       
         ! ajout temporaire le 28 oct:
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
          do i=1,n
-          if (zfice(i).gt.0.9) THEN
-              if (iso_verif_aberrant_choix_nostop( &
+          IF (zfice(i).gt.0.9) THEN
+              IF (iso_verif_aberrant_choix_nostop( &
                 zxtice(iso_HDO,i),cond(i),ridicule,deltalim_snow, &
                 ! Camille 9 mars 2023: pour le condensat, on laisse plus de
                 ! marge
-                'condiso_liq_ice_vect 412').eq.1) THEN
+                'condiso_liq_ice_vect 412').EQ.1) THEN
                 WRITE(*,*) 'debug condiso_liq_ice_vect 449: i,zfice=', &
                         i,zfice (i)
@@ -12565,5 +12565,5 @@
                         deltaD(zxtice(iso_HDO,i)/cond(i))
                   WRITE(*,*) 'tcond(i)=',tcond(i)-t_coup,'°C'
-                  if (tcond(i)-t_coup.gt.-40.0) THEN
+                  IF (tcond(i)-t_coup.gt.-40.0) THEN
                      ! sinon, c'est pas grave, il y aura juste une
                      ! abérrance dans les zones très froides. 
@@ -12601,5 +12601,5 @@
         enddo !do ixt=1,niso
       enddo !do i=1,n  
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             do i=1,n    
             CALL iso_verif_egalite_choix(zxtice(iso_eau,i) &
@@ -12607,16 +12607,16 @@
                 'condiso_liq_ice_vectall 79',errmax,errmaxrel)
             enddo !do i=1,n  
-          endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+          endif ! if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
 !          WRITE(*,*) 'condiso 477: fin de condiso'
 #endif
 
-      if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+      IF ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
             ! assurer convergence
            do i=1,n
-            if (zfice(i).eq.1.0) THEN
+            IF (zfice(i).EQ.1.0) THEN
                 zxtice(iso_eau,i)=cond(i)
-            endif !if (zfice.eq.1.0) THEN
+            endif !if (zfice.EQ.1.0) THEN
            enddo
-       endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+       endif !if ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
         do i=1,n
          do ixt=1,niso        
@@ -12650,10 +12650,10 @@
         ! déclarations
         ! **inputs
-        real xt,qt,cond,tcond,zfice ! tcond en K
-        integer ixt
+        REAL xt,qt,cond,tcond,zfice ! tcond en K
+        INTEGER ixt
         ! **outputs
-        real zxtice,zxtliq
+        REAL zxtice,zxtliq
         ! **locals
-        real zxtalphal,zxtalphai
+        REAL zxtalphal,zxtalphai
 !        integer iso_verif_aberrant_nostop ! debugage
         
@@ -12661,5 +12661,5 @@
 
         ! traitement rapide du cas où cond=0
-        if (cond.eq.0) THEN
+        IF (cond.EQ.0) THEN
             zxtliq=0
             zxtice=0
@@ -12668,6 +12668,6 @@
 
         ! verif que qt n'est pas nul
-        if (qt.eq.0) THEN
-            if (cond.lt.ridicule) THEN
+        IF (qt.EQ.0) THEN
+            IF (cond.lt.ridicule) THEN
                 zxtliq=0
                 zxtice=0
@@ -12684,8 +12684,8 @@
         ! verif xt et qt
 #ifdef ISOVERIF
-          if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+          IF ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
               CALL iso_verif_egalite_choix &
                (qt,xt,'condiso_liq_ice 51',errmax,errmaxrel)
-          endif  !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+          endif  !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
           CALL iso_verif_positif(qt-cond,'condiso_liq_ice 56: cond>qt')
 #endif
@@ -12698,15 +12698,15 @@
             CALL iso_verif_noNAN(zxtalphal,'condiso_liq_ice 65')
             CALL iso_verif_noNAN(zxtalphai,'condiso_liq_ice 66')
-            if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+            IF ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
                 CALL iso_verif_egalite(zxtalphal,1.0,'condiso 21')
                 CALL iso_verif_egalite(zxtalphai,1.0,'condiso 21')
-            endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-#endif
-
-#ifdef ISOVERIF
-          if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) THEN
-            if (qt.gt.ridicule) THEN
-               if (iso_verif_aberrant_nostop(xt/qt*zxtalphai/faccond, &
-                'condiso_liq_ice 64').eq.1) THEN
+            endif !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+#endif
+
+#ifdef ISOVERIF
+          IF ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO)) THEN
+            IF (qt.gt.ridicule) THEN
+               IF (iso_verif_aberrant_nostop(xt/qt*zxtalphai/faccond, &
+                'condiso_liq_ice 64').EQ.1) THEN
 !                WRITE(*,*) 'deltaDt=',(xt/qt/tnat(iso_HDO)-1)*1000
 !                WRITE(*,*) 'tcond,fcond,zxtalphai=',
@@ -12715,14 +12715,14 @@
               endif !if (iso_verif_aberrant_nostop(xt/qt*zxtalphai/faccond,
             endif !if (qt.gt.ridicule) THEN
-          endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) THEN
+          endif !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO)) THEN
 #endif
         
         
         zxtliq=zxtalphal*xt*cond/(qt+cond*(zxtalphal-1))
-        if (cond/qt.lt.1e-5) THEN
+        IF (cond/qt.lt.1e-5) THEN
            ! cas particulier pour éviter FI quand cond/qt->0  
            zxtice=xt/qt*cond*zxtalphai 
 
-        else if (1.0-cond/qt.lt.ridicule) THEN
+        ELSE IF (1.0-cond/qt.lt.ridicule) THEN
            ! condensation totale
            ! on ajoute ce cas particulier le 9 avril 2012 car sur vargas
@@ -12738,25 +12738,25 @@
         ! verif egalité pour ixt=4 et eau normale:
 #ifdef ISOVERIF
-          if (zfice.lt.1) THEN
+          IF (zfice.lt.1) THEN
             CALL iso_verif_noNAN(zxtliq,'condiso_liq_ice 91')
-            if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+            IF ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
               CALL iso_verif_egalite(zxtliq,cond,'condiso_liq_ice 30')
-            endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-            if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) THEN
-                if (cond.gt.ridicule) THEN
+            endif ! if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+            IF ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO)) THEN
+                IF (cond.gt.ridicule) THEN
                     CALL iso_verif_aberrant(zxtliq/cond, &
                          'condiso_liq_ice 32')
                 endif !if (cond.gt.ridicule) THEN
-            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) THEN
+            endif !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO)) THEN
           endif !if (zfice.lt.1) THEN
-          if (zfice.gt.0) THEN
+          IF (zfice.gt.0) THEN
             CALL iso_verif_noNAN(zxtice,'condiso_liq_ice 92')
-            if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+            IF ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
               CALL iso_verif_egalite(zxtice,cond,'condiso_liq_ice 31')
-            endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
-            if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) THEN
-              if (cond.gt.ridicule) THEN
-                if (iso_verif_aberrant_nostop(zxtice/cond, &
-                       'condiso_liq_ice 33').eq.1) THEN
+            endif ! if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
+            IF ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO)) THEN
+              IF (cond.gt.ridicule) THEN
+                IF (iso_verif_aberrant_nostop(zxtice/cond, &
+                       'condiso_liq_ice 33').EQ.1) THEN
                   WRITE(*,*) 'debug condiso 88: zfice=',zfice
                   WRITE(*,*) 'cond/qt=',cond/qt
@@ -12769,5 +12769,5 @@
                   endif
                 endif !if (cond.gt.ridicule) THEN
-            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) THEN
+            endif !if ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO)) THEN
           endif !if (zfice.gt.0) THEN
         ! verif que deltaD n'est pas abberant:
@@ -12783,19 +12783,19 @@
           CALL iso_verif_noNAN(zxtliq,'condiso_liq_ice 132')
           CALL iso_verif_noNAN(zxtice,'condiso_liq_ice 92')
-          if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+          IF ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
             CALL iso_verif_egalite(zxtice+zxtliq,cond, &
                 'condiso_liq_ice 79')
-          endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+          endif ! if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
           CALL iso_verif_noNAN(zxtice+zxtliq,'condiso_liq_ice 108')
 #endif
 
-        if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
-          if (ixt.eq.iso_eau) THEN
+        IF ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
+          IF (ixt.EQ.iso_eau) THEN
             ! assurer convergence
-            if (zfice.eq.1.0) THEN
+            IF (zfice.EQ.1.0) THEN
                 zxtice=cond
-            endif !if (zfice.eq.1.0) THEN
-        endif !if (ixt.eq.iso_eau) THEN
-       endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+            endif !if (zfice.EQ.1.0) THEN
+        endif !if (ixt.EQ.iso_eau) THEN
+       endif !if ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
         zxtice=max(0.0,zxtice)
         zxtliq=max(0.0,zxtliq)
@@ -12814,7 +12814,7 @@
 
         ! inputs
-        real T ! température en K
+        REAL T ! température en K
         ! output:
-        real zfice ! fraction de condensation en glace
+        REAL zfice ! fraction de condensation en glace
 
         zfice = 1.0-(T-pxtice)/(pxtmelt-pxtice)
@@ -12852,41 +12852,41 @@
 
          ! inputs
-        integer, intent(in) :: klon,knon
-        real, intent(in) :: dtime
-        real, intent(in) :: snow(klon),snow_prec(klon)
-        real, intent(in) :: xtsnow_prec(niso,klon)
-        real, intent(in) :: precip_snow(klon),xtprecip_snow(ntraciso,klon),xtprecip_rain(ntraciso,klon)
-        real, intent(in) :: snow_evap(klon)
-        real, intent(in) :: fq_fonte_neige(klon)
-        real, intent(in) :: fqfonte_neige(klon)
-        real, intent(in) :: fqcalving(klon)
-        real, intent(in) :: t_coup
-        real, intent(in) ::  q1lay(klon)
-        real, intent(in) :: xt1lay(ntraciso,klon)
-        real, intent(in) ::  tsurf(klon)
+        INTEGER, INTENT(IN) :: klon,knon
+        REAL, INTENT(IN) :: dtime
+        REAL, INTENT(IN) :: snow(klon),snow_prec(klon)
+        REAL, INTENT(IN) :: xtsnow_prec(niso,klon)
+        REAL, INTENT(IN) :: precip_snow(klon),xtprecip_snow(ntraciso,klon),xtprecip_rain(ntraciso,klon)
+        REAL, INTENT(IN) :: snow_evap(klon)
+        REAL, INTENT(IN) :: fq_fonte_neige(klon)
+        REAL, INTENT(IN) :: fqfonte_neige(klon)
+        REAL, INTENT(IN) :: fqcalving(klon)
+        REAL, INTENT(IN) :: t_coup
+        REAL, INTENT(IN) ::  q1lay(klon)
+        REAL, INTENT(IN) :: xt1lay(ntraciso,klon)
+        REAL, INTENT(IN) ::  tsurf(klon)
         INTEGER, INTENT(IN)                  :: nisurf
-        real, dimension(niso,klon), INTENT(IN) :: Rland_ice
+        REAL, DIMENSION(niso,klon), INTENT(IN) :: Rland_ice
         
         ! inouts
-        real, intent(inout) ::  xtsnow(niso,klon)
+        REAL, INTENT(INOUT) ::  xtsnow(niso,klon)
 
         ! outputs
-        real, DIMENSION(ntraciso,klon), INTENT(OUT) :: xtsnow_evap
-        real, DIMENSION(niso,klon), INTENT(OUT) ::  fxt_fonte_neige
-        real, DIMENSION(niso,klon), INTENT(OUT) ::  fxtfonte_neige
-        real, DIMENSION(niso,klon), INTENT(OUT) ::  fxtcalving
+        REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: xtsnow_evap
+        REAL, DIMENSION(niso,klon), INTENT(OUT) ::  fxt_fonte_neige
+        REAL, DIMENSION(niso,klon), INTENT(OUT) ::  fxtfonte_neige
+        REAL, DIMENSION(niso,klon), INTENT(OUT) ::  fxtcalving
 
         ! locals
-        real snow_apres_precip(klon),xtsnow_apres_precip(niso,klon)
-        real snow_avant_evap(klon),xtsnow_avant_evap(niso,klon)
-        real Rsnow_apres_precip(niso,klon), Rsnow_avant_evap(niso,klon)
-        real snow_avant_calving(klon)
-        real fqfonte_neige_add
-        integer i,ixt,j
+        REAL snow_apres_precip(klon),xtsnow_apres_precip(niso,klon)
+        REAL snow_avant_evap(klon),xtsnow_avant_evap(niso,klon)
+        REAL Rsnow_apres_precip(niso,klon), Rsnow_avant_evap(niso,klon)
+        REAL snow_avant_calving(klon)
+        REAL fqfonte_neige_add
+        INTEGER i,ixt,j
 #ifdef ISOVERIF
 !        integer iso_verif_aberrant_O17_nostop ! juste debug
 !        real o17excess        
-        real dqdiag        
-        real snow_max
+        REAL dqdiag
+        REAL snow_max
         parameter (snow_max=3000.)
 #endif        
@@ -12905,5 +12905,5 @@
 
 #ifdef ISOVERIF  
-       if (iso_eau.gt.0) THEN
+       IF (iso_eau.gt.0) THEN
         do i=1,knon
           CALL iso_verif_egalite_choix( &
@@ -12920,6 +12920,6 @@
                  +xtprecip_snow(ixt,i)*dtime
 #ifdef ISOVERIF
-         if (iso_verif_noNaN_nostop(xtsnow_apres_precip(ixt,i),  &
-               'calcul_iso_surf_vectall 2260').eq.1) THEN
+         IF (iso_verif_noNaN_nostop(xtsnow_apres_precip(ixt,i),  &
+               'calcul_iso_surf_vectall 2260').EQ.1) THEN
             WRITE(*,*) 'xtsnow_prec(ixt,i)=',xtsnow_prec(ixt,i)
             WRITE(*,*) 'xtprecip_snow(ixt,i)=',xtprecip_snow(ixt,i)
@@ -12934,9 +12934,9 @@
 #ifdef ISOVERIF  
       do i=1,knon         
-        if (iso_eau.gt.0) THEN
-            if (iso_verif_egalite_choix_nostop( &
+        IF (iso_eau.gt.0) THEN
+            IF (iso_verif_egalite_choix_nostop( &
                      xtsnow_apres_precip(iso_eau,i), &
                      snow_apres_precip(i),'calcul_iso_surf_ter 1028', &
-                     errmax,errmaxrel).eq.1) THEN
+                     errmax,errmaxrel).EQ.1) THEN
               WRITE(*,*) 'snow_prec(i),xtsnow_prec(iso_eau,i)=', &
                  snow_prec(i),xtsnow_prec(iso_eau,i)
@@ -12946,5 +12946,5 @@
             endif
         endif !if (iso_eau.gt.0) THEN
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
              CALL iso_verif_aberrant_choix( &
                    xtsnow_apres_precip(iso_hdo,i), &
@@ -12959,5 +12959,5 @@
         ! quoi fondre.
         do i=1,knon
-          if (snow_evap(i).lt.0.0) THEN
+          IF (snow_evap(i).lt.0.0) THEN
             snow_apres_precip(i)=snow_apres_precip(i)-snow_evap(i)*dtime
             CALL iso_rosee_givre(xt1lay,q1lay,tsurf,t_coup,snow_evap,i, &
@@ -12972,9 +12972,9 @@
 #ifdef ISOVERIF  
       do i=1,knon         
-        if (iso_eau.gt.0) THEN
-            if (iso_verif_egalite_choix_nostop( &
+        IF (iso_eau.gt.0) THEN
+            IF (iso_verif_egalite_choix_nostop( &
                      xtsnow_apres_precip(iso_eau,i), &
                      snow_apres_precip(i),'calcul_iso_surf_ter 1028', &
-                     errmax,errmaxrel).eq.1) THEN
+                     errmax,errmaxrel).EQ.1) THEN
               WRITE(*,*) 'snow_prec(i),xtsnow_prec(iso_eau,i)=', &
                  snow_prec(i),xtsnow_prec(iso_eau,i)
@@ -12984,5 +12984,5 @@
             endif
         endif !if (iso_eau.gt.0) THEN
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
              CALL iso_verif_aberrant_choix( &
                    xtsnow_apres_precip(iso_hdo,i), &
@@ -12995,6 +12995,6 @@
         ! on fond la neige
       do i=1,knon  
-        if (fq_fonte_neige(i).gt.ridicule) THEN
-          if (snow_apres_precip(i).gt.ridicule) THEN
+        IF (fq_fonte_neige(i).gt.ridicule) THEN
+          IF (snow_apres_precip(i).gt.ridicule) THEN
             do ixt=1,niso
               Rsnow_apres_precip(ixt,i)=xtsnow_apres_precip(ixt,i)/ &
@@ -13004,8 +13004,8 @@
                  *Rsnow_apres_precip(ixt,i)
 #ifdef ISOVERIF
-              if ((iso_verif_noNaN_nostop(Rsnow_apres_precip(ixt,i), &
-                 'calcul_iso_surf_ter 2294a').eq.1).or. &
+              IF ((iso_verif_noNaN_nostop(Rsnow_apres_precip(ixt,i), &
+                 'calcul_iso_surf_ter 2294a').EQ.1).OR. &
                  (iso_verif_noNaN_nostop(fxt_fonte_neige(ixt,i), &
-                 'calcul_iso_surf_ter 2294b').eq.1)) THEN
+                 'calcul_iso_surf_ter 2294b').EQ.1)) THEN
                 WRITE(*,*) 'ixt,i=',ixt,i
                 WRITE(*,*) 'xtsnow_apres_precip,snow_apres_precip=', &
@@ -13050,6 +13050,6 @@
                  -fxt_fonte_neige(ixt,i)
 #ifdef ISOVERIF
-          if (iso_verif_noNaN_nostop(xtsnow_avant_evap(ixt,i), &
-                'calcul_iso_surf_ter 2363').eq.1) THEN
+          IF (iso_verif_noNaN_nostop(xtsnow_avant_evap(ixt,i), &
+                'calcul_iso_surf_ter 2363').EQ.1) THEN
                   WRITE(*,*) 'xtsnow_apres_precip(ixt,i)=', &
                         xtsnow_apres_precip(ixt,i)
@@ -13068,8 +13068,8 @@
        do i=1,knon   
          ! on verifie que snow_avant_evap-snow_evap-fqcalving=snow
-         if (iso_verif_egalite_choix_nostop(snow_avant_evap(i) &
+         IF (iso_verif_egalite_choix_nostop(snow_avant_evap(i) &
                  -max(snow_evap(i),0.0)*dtime-fqcalving(i)*dtime,snow(i), &
                  'calcul_iso_surf_ter 224',errmax_sol*max(snow(i),1.0), &
-                  errmaxrel).eq.1) THEN
+                  errmaxrel).EQ.1) THEN
              WRITE(*,*) 'snow(i)=',snow(i)
              WRITE(*,*) 'snow_prec(i)=',snow_prec(i)
@@ -13082,5 +13082,5 @@
              stop
          endif
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
                  CALL iso_verif_egalite_choix( &
                      xtsnow_avant_evap(iso_eau,i), &
@@ -13088,5 +13088,5 @@
                      errmax,errmaxrel)
           endif !if (iso_eau.gt.0) THEN
-           if (iso_HDO.gt.0) THEN
+           IF (iso_HDO.gt.0) THEN
              CALL iso_verif_aberrant_choix(xtsnow_avant_evap(iso_hdo,i), &
                         snow_avant_evap(i),ridicule_snow,deltalim_snow, &
@@ -13101,8 +13101,8 @@
 
         do i=1,knon
-         if (snow_evap(i).gt.ridicule**2) THEN
+         IF (snow_evap(i).gt.ridicule**2) THEN
             ! CRisi 9 juin 2021: on met un seuil plus strict.
             ! sublimation positive, sans fractionnement            
-            if (snow_avant_evap(i).gt.ridicule**2) THEN
+            IF (snow_avant_evap(i).gt.ridicule**2) THEN
               ! on sublime sans fractionnement une partie de la neige.
               ! on en profite pour en effonfrer aussi éventuellement une
@@ -13119,6 +13119,6 @@
 !              CALL iso_verif_noNaN(xtsnow_evap(ixt,i),
 !     &          'calcul_iso_surf_ter 2543')
-               if (iso_verif_noNaN_nostop(xtsnow_evap(ixt,i), &
-                'calcul_iso_surf_ter 2543').eq.1) THEN
+               IF (iso_verif_noNaN_nostop(xtsnow_evap(ixt,i), &
+                'calcul_iso_surf_ter 2543').EQ.1) THEN
                   WRITE(*,*) 'xtsnow_avant_evap(ixt,i)=', &
                         xtsnow_avant_evap(ixt,i)
@@ -13144,5 +13144,5 @@
 !                stop                
 #endif               
-                if (snow_apres_precip(i).gt.ridicule) THEN
+                IF (snow_apres_precip(i).gt.ridicule) THEN
                    ! on évapore la snow apres precip
                   do ixt=1,niso
@@ -13179,5 +13179,5 @@
         ! C Risi juin 2020: on supprime la rosée ici car ça a déjà été traité
         ! plus haut
-        else if (snow_evap(i).lt.-ridicule**2) then ! if (snow_evap(i).gt.0.0) THEN
+        ELSE IF (snow_evap(i).lt.-ridicule**2) then ! if (snow_evap(i).gt.0.0) THEN
 !            ! on a de la rosée
 !            CALL iso_rosee_givre(xt1lay,q1lay,tsurf, &
@@ -13199,5 +13199,5 @@
 #ifdef ISOTRAC
               do ixt=niso+1,ntraciso
-                if (index_zone(ixt).eq.izone_cont) THEN
+                IF (index_zone(ixt).EQ.izone_cont) THEN
                   xtsnow_evap(ixt,i)=xtsnow_evap(index_iso(ixt),i)
                 else
@@ -13219,8 +13219,8 @@
         ! on verifie que snow_avant_evap-snow_evap-fqcalving=snow
        do i=1,knon   
-        if (iso_verif_egalite_choix_nostop(snow_avant_calving(i) &
+        IF (iso_verif_egalite_choix_nostop(snow_avant_calving(i) &
                  -fqcalving(i)*dtime,snow(i), &
                  'gestion_neige 1087',errmax_sol*max(snow(i),1.0), &
-                 errmaxrel).eq.1) THEN
+                 errmaxrel).EQ.1) THEN
              WRITE(*,*) 'snow(i)=',snow(i)
              WRITE(*,*) 'snow_prec(i)=',snow_prec(i)
@@ -13234,5 +13234,5 @@
              stop
          endif
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
                  CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), &
                      snow_avant_calving(i),'gestion_neige 1172', &
@@ -13242,5 +13242,5 @@
                      errmax,errmaxrel)
           endif !if (iso_eau.gt.0) THEN
-          if (iso_HDO.gt.0) THEN
+          IF (iso_HDO.gt.0) THEN
              CALL iso_verif_aberrant_choix(xtsnow(iso_hdo,i), &
                  snow_avant_calving(i),ridicule_snow,deltalim_snow, &
@@ -13257,5 +13257,5 @@
 #endif         
        do i=1,knon   
-        if (fqcalving(i).gt.0.0) THEN
+        IF (fqcalving(i).gt.0.0) THEN
 #ifdef ISOVERIF   
             CALL iso_verif_positif_strict(snow_avant_calving(i), &
@@ -13279,9 +13279,9 @@
       ! bidouille anti-divergence: utile pour éviter propagation des
       ! erreurs numériques
-      if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) THEN
+      IF ((iso_eau.gt.0).AND.(bidouille_anti_divergence)) THEN
           do i=1,knon
             xtsnow(iso_eau,i)=snow(i)
           enddo
-      endif !if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) THEN
+      endif !if ((iso_eau.gt.0).AND.(bidouille_anti_divergence)) THEN
       ! verif cons masse de la neige
 #ifdef ISOVERIF      
@@ -13290,7 +13290,7 @@
                   -snow_evap(i)*dtime-fqcalving(i)*dtime, &
                    snow_max-snow_prec(i))
-         if (iso_verif_egalite_choix_nostop(dqdiag, &
+         IF (iso_verif_egalite_choix_nostop(dqdiag, &
                  snow(i)-snow_prec(i),'ter 2128', &
-                 errmax_sol*max(snow(i),1.0),errmaxrel).eq.1) THEN
+                 errmax_sol*max(snow(i),1.0),errmaxrel).EQ.1) THEN
              WRITE(*,*) 'calcul_iso_surf_ter 2086: bilan qsnow'
              WRITE(*,*) 'snow(i)=',snow(i)
@@ -13302,11 +13302,11 @@
              stop
          endif
-         if (snow(i).lt.snow_max) THEN
+         IF (snow(i).lt.snow_max) THEN
          do ixt=1,niso
             dqdiag=xtprecip_snow(ixt,i)*dtime-fxt_fonte_neige(ixt,i) &
                   -xtsnow_evap(ixt,i)*dtime-fxtcalving(ixt,i)
-            if (iso_verif_egalite_choix_nostop(dqdiag, &
+            IF (iso_verif_egalite_choix_nostop(dqdiag, &
                  xtsnow(ixt,i)-xtsnow_prec(ixt,i),'ter 2144', &
-                 errmax_sol*max(snow(i),1.0),errmaxrel).eq.1) THEN
+                 errmax_sol*max(snow(i),1.0),errmaxrel).EQ.1) THEN
              WRITE(*,*) 'calcul_iso_surf_ter 2101: bilan xtsnow, ixt=', &
                  ixt
@@ -13338,13 +13338,13 @@
         ! cette partie est ajoutée le 31 juillet 2017
         do i=1,knon
-           if (fqfonte_neige(i).gt.fq_fonte_neige(i)/dtime) THEN
+           IF (fqfonte_neige(i).gt.fq_fonte_neige(i)/dtime) THEN
                 ! on font la banquise ou la land ice.
                 fqfonte_neige_add=fqfonte_neige(i)-fq_fonte_neige(i)/dtime
-                if (nisurf == is_sic) THEN
+                IF (nisurf == is_sic) THEN
                   do ixt=1,niso
                      fxtfonte_neige(ixt,i)=fxt_fonte_neige(ixt,i)/dtime &
                         +fqfonte_neige_add*tcorr(ixt)*toce(ixt)*alpha_liq_sol(ixt)
                   enddo
-                else if (nisurf == is_lic) THEN
+                ELSE IF (nisurf == is_lic) THEN
                    do ixt=1,niso
                      fxtfonte_neige(ixt,i)=fxt_fonte_neige(ixt,i)/dtime &
@@ -13373,5 +13373,5 @@
            endif !if (fqfonte_neige(i).gt.fq_fonte_neige(i)/dtime) THEN
 #ifdef ISOVERIF
-           if (iso_eau.gt.0) THEN
+           IF (iso_eau.gt.0) THEN
                 CALL iso_verif_egalite(fqfonte_neige(i),fxtfonte_neige(iso_eau,i), &
                         'iso_routines > gestion_neige 13479')
@@ -13412,43 +13412,43 @@
 
         ! inputs
-        integer, intent(in) :: klon,knon ! dimensions
-        real, intent(in) :: ps(klon) ! surface pressure
-        real, intent(in) :: tsurf(klon) ! SST
-        real, intent(in) :: q1lay(klon) ! near-surface specific humidity
-        real, intent(in) :: u1lay(klon), v1lay(klon) ! near surface wind
-        real, intent(in) :: xt1lay(ntraciso,klon) ! isotopes in near surface water vapor
-        real, intent(in) :: evap(klon) ! evaporation flux
-        !real, intent(in) ::  tsurf(klon)
-        real, intent(in) ::  Roce(niso,klon) ! isotopic ratio in surface ocean
-        !real, intent(in) ::  dtime
-        real, intent(in) ::  t_coup ! limit temperature between ice/liquid when calculating saturation humidity
+        INTEGER, INTENT(IN) :: klon,knon ! dimensions
+        REAL, INTENT(IN) :: ps(klon) ! surface pressure
+        REAL, INTENT(IN) :: tsurf(klon) ! SST
+        REAL, INTENT(IN) :: q1lay(klon) ! near-surface specific humidity
+        REAL, INTENT(IN) :: u1lay(klon), v1lay(klon) ! near surface wind
+        REAL, INTENT(IN) :: xt1lay(ntraciso,klon) ! isotopes in near surface water vapor
+        REAL, INTENT(IN) :: evap(klon) ! evaporation flux
+        !REAL, INTENT(IN) ::  tsurf(klon)
+        REAL, INTENT(IN) ::  Roce(niso,klon) ! isotopic ratio in surface ocean
+        !REAL, INTENT(IN) ::  dtime
+        REAL, INTENT(IN) ::  t_coup ! limit temperature between ice/liquid when calculating saturation humidity
 
         ! output
-        real, intent(out) ::  xtevap(ntraciso,klon) ! isotopic evaporation flux
-        real, intent(out) :: h1(klon) ! only diagnostic, not useful
+        REAL, INTENT(OUT) ::  xtevap(ntraciso,klon) ! isotopic evaporation flux
+        REAL, INTENT(OUT) :: h1(klon) ! only diagnostic, not useful
 
         ! locals
-        integer ixt
-        real VSURF
-        real kcin(niso,klon)
-        real zqs(klon)
-        real R1(niso)
-        real Revap(niso)
-        real zxtalphal(niso,klon), zxtalphai(niso)        
-        integer i
-        integer ncas_evap,ncas_noevap,ncas_rosee
-        integer cas_evap(klon),cas_noevap(klon),cas_rosee(klon)
-        integer icas
-        real zxtalphal_tmp
+        INTEGER ixt
+        REAL VSURF
+        REAL kcin(niso,klon)
+        REAL zqs(klon)
+        REAL R1(niso)
+        REAL Revap(niso)
+        REAL zxtalphal(niso,klon), zxtalphai(niso)
+        INTEGER i
+        INTEGER ncas_evap,ncas_noevap,ncas_rosee
+        INTEGER cas_evap(klon),cas_noevap(klon),cas_rosee(klon)
+        INTEGER icas
+        REAL zxtalphal_tmp
 #ifdef ISOVERIF
 !        real deltaD,O17excess,deltaO
-        integer trace_cas(klon)
+        INTEGER trace_cas(klon)
 !        integer iso_verif_aberrant_nostop ! juste debug
 !        integer iso_verif_aberrant_o17_nostop
 #endif
 #ifdef ISOTRAC
-        integer, DIMENSION(klon), INTENT(IN)     :: knindex
+        INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
         ! locals
-        integer izone_recoit  
+        INTEGER izone_recoit
 #endif
 
@@ -13457,5 +13457,5 @@
 #ifdef ISOVERIF
         do i=1,knon
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
                  CALL iso_verif_egalite_choix(Roce(iso_eau,i),1.0, &
                         'calcul_iso_surf_oce 47',errmax,errmaxrel)
@@ -13464,5 +13464,5 @@
                         errmax,errmaxrel)
            endif !if (iso_eau.gt.0) THEN
-           if (iso_HDO.gt.0) THEN
+           IF (iso_HDO.gt.0) THEN
               CALL iso_verif_positif(deltaD(Roce(iso_HDO,i))+100.0, &
                  'calcul_iso_surf_oce 54')
@@ -13477,5 +13477,5 @@
          ncas_rosee=0
          do i=1,knon
-          if (evap(i).gt.0.0) THEN
+          IF (evap(i).gt.0.0) THEN
            ncas_evap=ncas_evap+1
            cas_evap(ncas_evap)=i 
@@ -13483,5 +13483,5 @@
            trace_cas(i)=1
 #endif
-          else if (evap(i).eq.0.0) THEN
+          ELSE IF (evap(i).EQ.0.0) THEN
            ncas_noevap=ncas_noevap+1
            cas_noevap(ncas_noevap)=i
@@ -13503,5 +13503,5 @@
             i=cas_evap(icas)
             !WRITE(*,*) 'icas, i, ncas_evap=',icas, i, ncas_evap
-            if (tsurf(i).lt.t_coup) THEN
+            IF (tsurf(i).lt.t_coup) THEN
              zqs(i)=qsats(tsurf(i))/ps(i)
 #ifdef ISOVERIF             
@@ -13518,5 +13518,5 @@
            h1(i)=q1lay(i)/zqs(i)
            h1(i)=min(1.0,max(0.0,h1(i)))
-           if (cste_surf_cond.eq.2) THEN
+           IF (cste_surf_cond.EQ.2) THEN
                ! on suppose la température de surface constante dans le
                ! calcul des coefs de frac, pour faire un test de
@@ -13526,11 +13526,11 @@
                          zxtalphal(ixt,i))
             enddo
-           else !if (cste_surf_cond.eq.2) THEN
+           else !if (cste_surf_cond.EQ.2) THEN
             do ixt=1,niso
               CALL fractcalk_liq(ixt,tsurf(i), &
                          zxtalphal(ixt,i))
             enddo
-           endif !if (cste_surf_cond.eq.2) THEN
-            if (q1lay(i).gt.0.0) THEN
+           endif !if (cste_surf_cond.EQ.2) THEN
+            IF (q1lay(i).gt.0.0) THEN
               do ixt=1,niso  
                 R1(ixt)=xt1lay(ixt,i)/q1lay(i)
@@ -13547,6 +13547,6 @@
           VSURF=sqrt(u1lay(i)**2+v1lay(i)**2)
           CALL calcul_kcin(vsurf,kcin(1,i))
-          if (cste_surf_cond.eq.0) THEN
-            if (h1(i).lt.0.98) THEN
+          IF (cste_surf_cond.EQ.0) THEN
+            IF (h1(i).lt.0.98) THEN
               do ixt=1,niso
                 xtevap(ixt,i)=evap(i)* &
@@ -13559,5 +13559,5 @@
               enddo
             endif !if (h1(i).lt.0.98) THEN
-          else !if (cste_surf_cond.eq.0) THEN
+          else !if (cste_surf_cond.EQ.0) THEN
               do ixt=1,niso
                 xtevap(ixt,i)=evap(i)* &
@@ -13566,10 +13566,10 @@
                  /(1.0-rh_cste_surf_cond)*(1.0-kcin(ixt,i))
               enddo !do ixt=1,niso
-          endif !if (cste_surf_cond.eq.0) THEN
+          endif !if (cste_surf_cond.EQ.0) THEN
         !WRITE(*,*) 'calcul_iso_surf_oce 13772'
         !WRITE(*,*) 'knindex(i),klon=',knindex(i),klon
 #ifdef ISOTRAC
-          if ((option_traceurs.eq.3).or. &
-                 (option_traceurs.eq.20)) THEN
+          IF ((option_traceurs.EQ.3).OR. &
+                 (option_traceurs.EQ.20)) THEN
              izone_recoit=bassin_map(knindex(i))
          else
@@ -13579,5 +13579,5 @@
         !WRITE(*,*) 'calcul_iso_surf_oce 13781, izone_recoit=',izone_recoit
           do ixt=niso+1,ntraciso
-            if (index_zone(ixt).eq.izone_recoit) THEN
+            IF (index_zone(ixt).EQ.izone_recoit) THEN
                xtevap(ixt,i)=xtevap(index_iso(ixt),i)
             else
@@ -13595,13 +13595,13 @@
 #endif          
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), &
                  'calcul_iso_surf_oce 3309: sur ocean', &
                   errmax,errmaxrel)
           endif !if (iso_eau.gt.0) THEN
-          if (iso_HDO.gt.0) THEN
-           if (abs(evap(i)).gt.ridicule_evap) THEN
-             if (iso_verif_aberrant_nostop(xtevap(iso_HDO,i)/evap(i), &
-                 'calcul_iso_surf_oce 3308: sur ocean').eq.1) THEN
+          IF (iso_HDO.gt.0) THEN
+           IF (abs(evap(i)).gt.ridicule_evap) THEN
+             IF (iso_verif_aberrant_nostop(xtevap(iso_HDO,i)/evap(i), &
+                 'calcul_iso_surf_oce 3308: sur ocean').EQ.1) THEN
                WRITE(*,*) 'h1(i),kcin(iso_HDO,i)=',h1(i),kcin(iso_HDO,i)
                WRITE(*,*) 'deltaD(R1)=',deltaD(R1(iso_HDO))
@@ -13610,5 +13610,5 @@
                ! si deltaD vap très faible, c'est normale d'avoir deltaD
                ! très fort dans l'évap
-               if ((evap(i).gt.faible_evap).and. &
+               IF ((evap(i).gt.faible_evap).AND. &
                          (deltaD(R1(iso_HDO)).gt.deltaDfaible)) THEN
                  stop
@@ -13616,6 +13616,6 @@
              endif
            endif !if (abs(evap(i)).gt.ridicule_evap) THEN
-           if ((xtevap(iso_HDO,i)/evap(i).lt.R1(iso_HDO)-20.0) &
-                 .and.(evap(i).gt.ridicule_evap)) THEN
+           IF ((xtevap(iso_HDO,i)/evap(i).lt.R1(iso_HDO)-20.0) &
+                 .AND.(evap(i).gt.ridicule_evap)) THEN
                WRITE(*,*) 'calcul_iso_surf_oce 106, i=',i
                WRITE(*,*) 'deltaDevap=', &
@@ -13630,9 +13630,9 @@
            endif ! if (xtevap(iso_HDO,i)/evap(i).lt.R1(iso_HDO)) THEN
           endif  !if (iso_HDO.gt.0) THEN
-          if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-            if (abs(evap(i)).gt.ridicule_evap) THEN
-                if (iso_verif_aberrant_o17_nostop(xtevap(iso_O17,i) &
+          IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+            IF (abs(evap(i)).gt.ridicule_evap) THEN
+                IF (iso_verif_aberrant_o17_nostop(xtevap(iso_O17,i) &
                  /evap(i),xtevap(iso_O18,i) &
-                 /evap(i),'calcul_iso_surf > oce 232').eq.1) THEN
+                 /evap(i),'calcul_iso_surf > oce 232').EQ.1) THEN
                   WRITE(*,*) 'deltaO18,O17excess v1=',deltaO( &
                          R1(iso_O18)),O17excess( &
@@ -13645,10 +13645,10 @@
                                  Roce(iso_O18,i)/zxtalphal(iso_O18,i))
                   WRITE(*,*) 'h1(i),evap(i)=',h1(i),evap(i)
-                  if (xtevap(iso_O18,i)/evap(i).lt.tnat(iso_O18)) THEN
+                  IF (xtevap(iso_O18,i)/evap(i).lt.tnat(iso_O18)) THEN
                      stop
                   endif
                 endif !if (iso_verif_aberrant_o17_nostop(xtevap(iso_O17,i)
             endif !if (abs(evap(i)).gt.ridicule_evap) THEN
-          endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+          endif !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
 #ifdef ISOTRAC
           CALL iso_verif_traceur_justmass(xtevap(1,i), &
@@ -13682,11 +13682,11 @@
 #ifdef ISOVERIF
         do i=1,knon
-           if (iso_eau.gt.0) THEN
+           IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), &
                         'calcul_iso_surf_oce 115',errmax,errmaxrel)
            endif !if (iso_eau.gt.0) THEN
-           if (iso_HDO.gt.0) THEN
-              if (evap(i).gt.ridicule_evap) THEN
-                if (deltaD(R1(iso_HDO)).gt.200.0) THEN
+           IF (iso_HDO.gt.0) THEN
+              IF (evap(i).gt.ridicule_evap) THEN
+                IF (deltaD(R1(iso_HDO)).gt.200.0) THEN
                 CALL iso_verif_aberrant(xtevap(iso_HDO,i)/evap(i), &
                         'calcul_iso_surf_oce 119')
@@ -13730,47 +13730,47 @@
 
         ! inputs
-        integer, intent(in) :: klon,knon
-        real, intent(in) :: snow(klon),snow_prec(klon)
-        real, intent(inout) :: xtsnow(niso,klon)
-        real, intent(in) :: xtsnow_prec(niso,klon)
-        real, intent(in) :: precip_snow(klon),xtprecip_snow(ntraciso,klon),xtprecip_rain(ntraciso,klon)
-        real, intent(in) :: evap(klon), snow_evap(klon)
-        real, intent(in) ::  fq_fonte_neige(klon)
-        real, intent(in) ::  fqfonte_neige(klon)
-        real, intent(in) :: xt1lay(ntraciso,klon),ps(klon),q1lay(klon)
-        real, intent(in) :: tsurf(klon)
-        real, intent(in) :: Roce(niso,klon)
-        real, intent(in) :: dtime
-        real, intent(in) :: t_coup
-        real, intent(in) :: fqcalving(klon)
+        INTEGER, INTENT(IN) :: klon,knon
+        REAL, INTENT(IN) :: snow(klon),snow_prec(klon)
+        REAL, INTENT(INOUT) :: xtsnow(niso,klon)
+        REAL, INTENT(IN) :: xtsnow_prec(niso,klon)
+        REAL, INTENT(IN) :: precip_snow(klon),xtprecip_snow(ntraciso,klon),xtprecip_rain(ntraciso,klon)
+        REAL, INTENT(IN) :: evap(klon), snow_evap(klon)
+        REAL, INTENT(IN) ::  fq_fonte_neige(klon)
+        REAL, INTENT(IN) ::  fqfonte_neige(klon)
+        REAL, INTENT(IN) :: xt1lay(ntraciso,klon),ps(klon),q1lay(klon)
+        REAL, INTENT(IN) :: tsurf(klon)
+        REAL, INTENT(IN) :: Roce(niso,klon)
+        REAL, INTENT(IN) :: dtime
+        REAL, INTENT(IN) :: t_coup
+        REAL, INTENT(IN) :: fqcalving(klon)
     INTEGER, INTENT(IN)                  :: nisurf
     INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
-    real, DIMENSION(klon), INTENT(IN) :: run_off_lic_diag
-    real, INTENT(IN) :: coeff_rel_diag
+    REAL, DIMENSION(klon), INTENT(IN) :: run_off_lic_diag
+    REAL, INTENT(IN) :: coeff_rel_diag
     REAL, DIMENSION(niso,klon), INTENT(IN)        :: Rland_ice
 
         ! output
-        real, intent(out) :: xtevap(ntraciso,klon)
+        REAL, INTENT(OUT) :: xtevap(ntraciso,klon)
 
         ! locals
-        real fxtfonte_neige(niso,klon)
-        real fxt_fonte_neige(niso,klon)
-        real fxtcalving(niso,klon)
+        REAL fxtfonte_neige(niso,klon)
+        REAL fxt_fonte_neige(niso,klon)
+        REAL fxtcalving(niso,klon)
 !        real zxtalphals
-        real sol_evap(klon)
-        real xtsol_evap(ntraciso,klon)
-        real xtsnow_evap(ntraciso,klon)
-        integer i,ixt
-        integer ncas_evap,ncas_noevap,ncas_rosee
-        integer cas_evap(klon),cas_noevap(klon),cas_rosee(klon)
-        integer icas        
+        REAL sol_evap(klon)
+        REAL xtsol_evap(ntraciso,klon)
+        REAL xtsnow_evap(ntraciso,klon)
+        INTEGER i,ixt
+        INTEGER ncas_evap,ncas_noevap,ncas_rosee
+        INTEGER cas_evap(klon),cas_noevap(klon),cas_rosee(klon)
+        INTEGER icas
 #ifdef ISOVERIF
 !        real deltaD
-        integer trace_cas(klon)
+        INTEGER trace_cas(klon)
 !        integer iso_verif_egalite_nostop
 #endif        
 #ifdef ISOTRAC
         ! locals
-        integer izone_recoit
+        INTEGER izone_recoit
 #endif   
 
@@ -13795,5 +13795,5 @@
 
 #ifdef ISOVERIF
-       if (iso_eau.gt.0) THEN
+       IF (iso_eau.gt.0) THEN
         do i=1,knon
           CALL iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i),  &
@@ -13819,5 +13819,5 @@
          ! c'est sol_evap plutot que evap
 !          if (evap(i).gt.0.0) THEN
-         if (sol_evap(i).gt.0.0) THEN
+         IF (sol_evap(i).gt.0.0) THEN
            ncas_evap=ncas_evap+1
            cas_evap(ncas_evap)=i 
@@ -13825,5 +13825,5 @@
            trace_cas(i)=1
 #endif
-          else if (sol_evap(i).eq.0.0) THEN
+          ELSE IF (sol_evap(i).EQ.0.0) THEN
            ncas_noevap=ncas_noevap+1
            cas_noevap(ncas_noevap)=i
@@ -13855,7 +13855,7 @@
 
 #ifdef ISOTRAC
-          if (option_traceurs.eq.3) THEN
+          IF (option_traceurs.EQ.3) THEN
             izone_recoit=izone_poubelle
-          else if (option_traceurs.eq.3) THEN
+          ELSE IF (option_traceurs.EQ.3) THEN
               izone_recoit=bassin_map(knindex(i))
           else
@@ -13864,5 +13864,5 @@
 
           do ixt=niso+1,ntraciso
-            if (index_zone(ixt).eq.izone_recoit) THEN
+            IF (index_zone(ixt).EQ.izone_recoit) THEN
              xtsol_evap(ixt,i)=xtsol_evap(index_iso(ixt),i)
             else
@@ -13873,6 +13873,6 @@
 #endif            
 #ifdef ISOVERIF
-          if (iso_HDO.gt.0) THEN
-              if (deltaD(xtsol_evap(iso_HDO,i)/sol_evap(i)).lt.0.0) THEN
+          IF (iso_HDO.gt.0) THEN
+              IF (deltaD(xtsol_evap(iso_HDO,i)/sol_evap(i)).lt.0.0) THEN
                 WRITE(*,*) 'calcul_iso_surf_lic 255'
                 WRITE(*,*) 'sol_evap(i),xtsol_evap(iso_HDO,i)=', &
@@ -13916,5 +13916,5 @@
                   t_coup,sol_evap,i,xtsol_evap,klon)
 #ifdef ISOVERIF  
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
             CALL iso_verif_aberrant_choix(-xtsol_evap(iso_HDO,i), &
                  sol_evap(i),ridicule_evap,deltalim_snow, &
@@ -13934,9 +13934,9 @@
 #ifdef ISOVERIF
         do i=1,knon
-              if (iso_eau.gt.0) THEN
+              IF (iso_eau.gt.0) THEN
                  CALL iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), &
                         'calcul_iso_surf_sic 248',errmax,errmaxrel)
               endif !if (iso_eau.gt.0) THEN
-              if (iso_HDO.gt.0) THEN
+              IF (iso_HDO.gt.0) THEN
                    CALL iso_verif_aberrant_choix(xtevap(iso_HDO,i),evap(i), &
                         ridicule_evap,deltalim_snow,'calcul_iso_surf_sic 257_evap')
@@ -13982,49 +13982,49 @@
 
         ! inputs
-        integer klon,knon
-        real snow(klon),snow_prec(klon)
-        real xtsnow(niso,klon),xtsnow_prec(niso,klon)
-        real precip_snow(klon),xtprecip_snow(ntraciso,klon)
-        real xtprecip_rain(ntraciso,klon),precip_rain(klon)
-        real evap(klon), snow_evap(klon)
-        real fq_fonte_neige(klon)
-        real fqfonte_neige(klon)
-        real xt1lay(ntraciso,klon),ps(klon),q1lay(klon)
-        real, intent(in) :: tsurf(klon)
-        real Rland_ice(niso,klon)
+        INTEGER klon,knon
+        REAL snow(klon),snow_prec(klon)
+        REAL xtsnow(niso,klon),xtsnow_prec(niso,klon)
+        REAL precip_snow(klon),xtprecip_snow(ntraciso,klon)
+        REAL xtprecip_rain(ntraciso,klon),precip_rain(klon)
+        REAL evap(klon), snow_evap(klon)
+        REAL fq_fonte_neige(klon)
+        REAL fqfonte_neige(klon)
+        REAL xt1lay(ntraciso,klon),ps(klon),q1lay(klon)
+        REAL, INTENT(IN) :: tsurf(klon)
+        REAL Rland_ice(niso,klon)
 !        real run_off_lic_0(klon)
-        real dtime
-        real t_coup
-        real fqcalving(klon)
+        REAL dtime
+        REAL t_coup
+        REAL fqcalving(klon)
     INTEGER, INTENT(IN)                  :: nisurf
     INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
-    real, DIMENSION(klon), INTENT(IN) :: run_off_lic_diag
-    real, INTENT(IN) :: coeff_rel_diag
+    REAL, DIMENSION(klon), INTENT(IN) :: run_off_lic_diag
+    REAL, INTENT(IN) :: coeff_rel_diag
 
         ! output
-        real xtevap(ntraciso,klon)
+        REAL xtevap(ntraciso,klon)
 !        real xtrun_off_lic_0(niso,klon)
 
         ! locals
-        real fxt_fonte_neige(niso,klon)
-        real fxtfonte_neige(niso,klon)
-        real fxtcalving(niso,klon)
-        real sol_evap(klon)
-        real xtsol_evap(ntraciso,klon)
-        real xtsnow_evap(ntraciso,klon)
-        integer i,ixt,j
-        integer ncas_evap,ncas_noevap,ncas_rosee
-        integer cas_evap(klon),cas_noevap(klon),cas_rosee(klon)
-        integer icas
+        REAL fxt_fonte_neige(niso,klon)
+        REAL fxtfonte_neige(niso,klon)
+        REAL fxtcalving(niso,klon)
+        REAL sol_evap(klon)
+        REAL xtsol_evap(ntraciso,klon)
+        REAL xtsnow_evap(ntraciso,klon)
+        INTEGER i,ixt,j
+        INTEGER ncas_evap,ncas_noevap,ncas_rosee
+        INTEGER cas_evap(klon),cas_noevap(klon),cas_rosee(klon)
+        INTEGER icas
 #ifdef ISOVERIF        
-        integer trace_cas(klon)
+        INTEGER trace_cas(klon)
 !        real deltaD 
 !        integer iso_verif_positif_strict_nostop
-        real Rland_ice_prec(niso,klon)
+        REAL Rland_ice_prec(niso,klon)
 !        integer iso_verif_egalite_choix_nostop
 #endif
 #ifdef ISOTRAC
         ! locals
-        integer izone_recoit
+        INTEGER izone_recoit
 #endif        
 !        real mair ! masse d'air en kg concernée par rosée
@@ -14064,5 +14064,5 @@
         enddo !do ixt=1,niso
 #endif        
-        if (precip_snow(i).gt.ridicule) THEN
+        IF (precip_snow(i).gt.ridicule) THEN
            do ixt=1,niso
               Rland_ice(ixt,i)=(h_land_ice*Rland_ice(ixt,i) &
@@ -14076,12 +14076,12 @@
         ! vérifier que Rland_ice a bien été modifié. A l'état initiale,
             ! Rland_ice vaut -150 permil pour le deltaD
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
         do i=1,knon        
-        if (precip_snow(i).gt.1e-5) THEN
-           if (abs(deltaD(xtprecip_snow(iso_hdo,i)/precip_snow(i)) &
+        IF (precip_snow(i).gt.1e-5) THEN
+           IF (abs(deltaD(xtprecip_snow(iso_hdo,i)/precip_snow(i)) &
                          +150).gt.5.0) THEN
-           if (iso_verif_positif_strict_nostop &
+           IF (iso_verif_positif_strict_nostop &
                  (abs(deltaD(Rland_ice(iso_hdo,i))+150.0)  &
-               -1e-6,'calcul_iso_surf_lic 565').eq.1) THEN
+               -1e-6,'calcul_iso_surf_lic 565').EQ.1) THEN
               WRITE(*,*) 'calcul_iso_surf_lic 575 tmp: i=',i
               WRITE(*,*) 'h_land_ice,precip_snow(i)*dtime=' , &
@@ -14099,9 +14099,9 @@
         endif !if (iso_HDO.gt.0) THEN
         do i=1,knon
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
           CALL iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i),  &
                'calcul_iso_surf_lic_vectall 587a',errmax,errmaxrel)
         endif
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
           CALL iso_verif_aberrant_choix(xtsnow(iso_HDO,i), &
                      snow(i),ridicule_snow,deltalim_snow, &
@@ -14123,5 +14123,5 @@
          do i=1,knon
 !          if (evap(i).gt.0.0) THEN
-           if (sol_evap(i).gt.0.0) THEN
+           IF (sol_evap(i).gt.0.0) THEN
                ! modif le 2 octobre 2008: c'est le signe de sol_evap qui
                ! doit être important ici
@@ -14131,6 +14131,6 @@
            trace_cas(i)=1
 #endif
-!          else if (evap(i).eq.0.0) THEN
-           else if (sol_evap(i).eq.0.0) THEN
+!          ELSE IF (evap(i).EQ.0.0) THEN
+           ELSE IF (sol_evap(i).EQ.0.0) THEN
            ncas_noevap=ncas_noevap+1
            cas_noevap(ncas_noevap)=i
@@ -14153,5 +14153,5 @@
               
 #ifdef ISOVERIF
-              if (iso_eau.gt.0) THEN
+              IF (iso_eau.gt.0) THEN
                CALL iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, &
                         'calcul_iso_surf_lic 740',errmax,errmaxrel)
@@ -14163,5 +14163,5 @@
 
 #ifdef ISOTRAC
-        if (option_traceurs.eq.20) THEN
+        IF (option_traceurs.EQ.20) THEN
             izone_recoit=bassin_map(knindex(i))
         else
@@ -14170,5 +14170,5 @@
 
         do ixt=niso+1,ntraciso
-            if (index_zone(ixt).eq.izone_recoit) THEN
+            IF (index_zone(ixt).EQ.izone_recoit) THEN
                xtsol_evap(ixt,i)=xtsol_evap(index_iso(ixt),i)
             else
@@ -14179,5 +14179,5 @@
 
 #ifdef ISOVERIF
-              if (iso_eau.gt.0) THEN
+              IF (iso_eau.gt.0) THEN
                CALL iso_verif_egalite_choix(sol_evap(i), &
                  xtsol_evap(iso_eau,i), &
@@ -14209,10 +14209,10 @@
 
 #ifdef ISOVERIF
-              if (iso_eau.gt.0) THEN
+              IF (iso_eau.gt.0) THEN
                CALL iso_verif_egalite_choix(sol_evap(i), &
                  xtsol_evap(iso_eau,i), &
                  'calcul_iso_surf_lic 365',errmax,errmaxrel)
               endif !if (iso_eau.gt.0) THEN
-              if (iso_HDO.gt.0) THEN
+              IF (iso_HDO.gt.0) THEN
                   CALL iso_verif_aberrant_choix(-xtsol_evap(iso_hdo,i), &
                    -sol_evap(i),ridicule_evap,deltalim, &
@@ -14236,6 +14236,6 @@
 !#ifdef ISOVERIF
 !        if (iso_eau.gt.0) THEN
-!         if ((j.eq.291).or.(j.eq.231).or.(j.eq.418).or. &
-!     &                 (j.eq.38).or.(j.eq.60)) THEN
+!         if ((j.EQ.291).OR.(j.EQ.231).OR.(j.EQ.418).OR. &
+!     &                 (j.EQ.38).OR.(j.EQ.60)) THEN
 !           WRITE(*,*) 'calcul_iso_surf 776 tmp& i,j,klon,knon,', &
 !     &           'run_off_lic_0,xt=',i,j,klon,knon,       &
@@ -14249,5 +14249,5 @@
 #ifdef ISOVERIF
         do i=1,knon
-              if (iso_eau.gt.0) THEN
+              IF (iso_eau.gt.0) THEN
                  CALL iso_verif_egalite_choix(evap(i),xtevap(iso_eau,i), &
                         'calcul_iso_surf_lic 361',errmax,errmaxrel)
@@ -14255,5 +14255,5 @@
                         'calcul_iso_surf_lic 363',errmax,errmaxrel)
               endif !if (iso_eau.gt.0) THEN
-              if (iso_HDO.gt.0) THEN
+              IF (iso_HDO.gt.0) THEN
                 CALL iso_verif_aberrant_choix(xtsnow(iso_HDO,i), &
                      snow(i),ridicule_snow,deltalim_snow, &
@@ -14271,5 +14271,5 @@
 !             if (iso_verif_egalite_choix_nostop(run_off_lic_0(i), &
 !     &         xtrun_off_lic_0(iso_eau,i),'calcul_iso_surf_lic 783', &
-!     &         errmax,errmaxrel).eq.1) THEN
+!     &         errmax,errmaxrel).EQ.1) THEN
 !               WRITE(*,*) 'i,knon,klon=',i,knon,klon
 !               stop
@@ -14324,49 +14324,49 @@
         
         ! inputs
-        integer klon,knon
-        real snow(klon),snow_prec(klon)
-        real xtsnow(niso,klon),xtsnow_prec(niso,klon)
-        real precip_snow(klon),xtprecip_snow(ntraciso,klon)
-        real precip_rain(klon),xtprecip_rain(ntraciso,klon)
-        real qsol(klon),qsol_prec(klon) ! hauteur d'eau, en mm.
-        real xtsol(niso,klon),xtsol_prec(niso,klon)
-        real evap(klon), snow_evap(klon)
-        real fq_fonte_neige(klon)
-        real fqfonte_neige(klon)
-        real xt1lay(ntraciso,klon),q1lay(klon)
-        real u1lay(klon),v1lay(klon)
-        real p1lay(klon)
-        real ps(klon)
-        real, intent(in) :: tsurf(klon)
-        real dtime
-        real t_coup
-        real max_eau_sol
-        real run_off(klon)
-        real fqcalving(klon)
+        INTEGER klon,knon
+        REAL snow(klon),snow_prec(klon)
+        REAL xtsnow(niso,klon),xtsnow_prec(niso,klon)
+        REAL precip_snow(klon),xtprecip_snow(ntraciso,klon)
+        REAL precip_rain(klon),xtprecip_rain(ntraciso,klon)
+        REAL qsol(klon),qsol_prec(klon) ! hauteur d'eau, en mm.
+        REAL xtsol(niso,klon),xtsol_prec(niso,klon)
+        REAL evap(klon), snow_evap(klon)
+        REAL fq_fonte_neige(klon)
+        REAL fqfonte_neige(klon)
+        REAL xt1lay(ntraciso,klon),q1lay(klon)
+        REAL u1lay(klon),v1lay(klon)
+        REAL p1lay(klon)
+        REAL ps(klon)
+        REAL, INTENT(IN) :: tsurf(klon)
+        REAL dtime
+        REAL t_coup
+        REAL max_eau_sol
+        REAL run_off(klon)
+        REAL fqcalving(klon)
     INTEGER, INTENT(IN)                  :: nisurf
     INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
-    real, DIMENSION(klon), INTENT(IN) :: run_off_lic_diag
-    real, INTENT(IN) :: coeff_rel_diag
+    REAL, DIMENSION(klon), INTENT(IN) :: run_off_lic_diag
+    REAL, INTENT(IN) :: coeff_rel_diag
     REAL, DIMENSION(niso,klon), INTENT(IN)        :: Rland_ice
         
 
         ! output
-        real xtevap(ntraciso,klon)
-        real xtrun_off(niso,klon)     
+        REAL xtevap(ntraciso,klon)
+        REAL xtrun_off(niso,klon)
 
         ! locals
-        real sol_evap(klon)
-        real xtsol_evap(ntraciso,klon)
-        real xtnu(niso,klon)
-        real L
-        real xtsnow_evap(ntraciso,klon)
-        real qsol_avant_evap(klon), &
+        REAL sol_evap(klon)
+        REAL xtsol_evap(ntraciso,klon)
+        REAL xtnu(niso,klon)
+        REAL L
+        REAL xtsnow_evap(ntraciso,klon)
+        REAL qsol_avant_evap(klon), &
                 xtsol_avant_evap(niso,klon)
-        real fxt_fonte_neige(niso,klon)
-        real fxtfonte_neige(niso,klon)
-        real fxtcalving(niso,klon)
-        real VSURF
-        real kcin(niso)
-        real alphak(niso)
+        REAL fxt_fonte_neige(niso,klon)
+        REAL fxtfonte_neige(niso,klon)
+        REAL fxtcalving(niso,klon)
+        REAL VSURF
+        REAL kcin(niso)
+        REAL alphak(niso)
 !        integer alphak_stewart
 !        parameter (alphak_stewart=1)
@@ -14381,17 +14381,17 @@
                 ! les sols secs et 1 pour les sols saturés.
                ! 31 aout: ce param est maintenant dans wateriso 
-        real h1(klon)
-        real zqs(klon)
-        real R1(niso)
-        real Revap(niso)
-        real zxtalphal(niso), zxtalphai(niso)        
-        real qevap(klon)
-        real q10 ! humidité 1ère couche en mm
-        real rowl ! densité eau en kg/m3
+        REAL h1(klon)
+        REAL zqs(klon)
+        REAL R1(niso)
+        REAL Revap(niso)
+        REAL zxtalphal(niso), zxtalphai(niso)
+        REAL qevap(klon)
+        REAL q10 ! humidité 1ère couche en mm
+        REAL rowl ! densité eau en kg/m3
         parameter (rowl=1000.0)
-        real Pveg
-        integer i,ixt,j
-        real Rsol_new(niso), Rsol(niso)
-        real qsol_avant_deversement(klon)
+        REAL Pveg
+        INTEGER i,ixt,j
+        REAL Rsol_new(niso), Rsol(niso)
+        REAL qsol_avant_deversement(klon)
 
         ! qu'est-ce qui ruisselle?
@@ -14403,15 +14403,15 @@
                 ! donc dans le sol saturé.
            ! 31 aout: ce param est maintenant dans wateriso    
-        real precip_rain_eff(klon),fq_fonte_neige_eff(klon)
-        real sol_evap_eff(klon)
-        real xtsol_evap_eff(niso,klon)
-        real xtprecip_rain_eff(niso,klon), &
+        REAL precip_rain_eff(klon),fq_fonte_neige_eff(klon)
+        REAL sol_evap_eff(klon)
+        REAL xtsol_evap_eff(niso,klon)
+        REAL xtprecip_rain_eff(niso,klon), &
                 fxt_fonte_neige_eff(niso,klon)
-        integer ncas_evap,ncas_noevap,ncas_rosee
-        integer cas_evap(klon),cas_noevap(klon),cas_rosee(klon)
-        integer icas
-        real runoff_tmp(knon)
-#ifdef ISOVERIF
-        integer trace_cas(klon)
+        INTEGER ncas_evap,ncas_noevap,ncas_rosee
+        INTEGER cas_evap(klon),cas_noevap(klon),cas_rosee(klon)
+        INTEGER icas
+        REAL runoff_tmp(knon)
+#ifdef ISOVERIF
+        INTEGER trace_cas(klon)
 !        integer iso_verif_aberrant_nostop ! juste debug
 !        integer iso_verif_aberrant_O17_nostop ! juste debug
@@ -14422,5 +14422,5 @@
 !        integer iso_verif_positif_choix_nostop
 !        real deltaD,o17excess
-        real dqdiag
+        REAL dqdiag
 #endif       
 !#ifdef ISOVERIF
@@ -14429,5 +14429,5 @@
 #ifdef ISOTRAC
         ! locals   
-        integer izone_recoit
+        INTEGER izone_recoit
 #endif
 
@@ -14435,5 +14435,5 @@
 !      WRITE(*,*) 'calcul_iso_surf_ter 494'
       do i=1,knon         
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
            CALL iso_verif_egalite_choix( &
                      xtsnow_prec(iso_eau,i), &
@@ -14483,5 +14483,5 @@
 !        WRITE(*,*) 'calcul_iso_surf_ter 910'
         do i=1,knon
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(qsol_prec(i), &
                 xtsol_prec(iso_eau,i),'calcul_iso_surf_ter 504', &
@@ -14492,17 +14492,17 @@
                      errmax,errmaxrel)
           endif          
-          if (iso_HDO.gt.0) THEN
-           if (qsol_prec(i).gt.ridicule_qsol*1e2) THEN
+          IF (iso_HDO.gt.0) THEN
+           IF (qsol_prec(i).gt.ridicule_qsol*1e2) THEN
             CALL iso_verif_aberrant(xtsol_prec(iso_HDO,i)/ &
                   qsol_prec(i)/faccond,'calcul_iso_surf_ter 506')
            endif  !if (qsol_prec(i).gt.ridicule_qsol) 
           endif !if (iso_eau.gt.0) THEN
-          if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-            if (qsol_prec(i).gt.ridicule_qsol) THEN
+          IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+            IF (qsol_prec(i).gt.ridicule_qsol) THEN
               CALL iso_verif_aberrant_o17(xtsol_prec(iso_O17,i) &
                  /qsol_prec(i),xtsol_prec(iso_O18,i) &
                  /qsol_prec(i),'iso_surf_ter 1035')
-            endif !if ((qsol_prec(i).gt.ridicule).and.(xtsol_prec(iso_O18,i)
-          endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+            endif !if ((qsol_prec(i).gt.ridicule).AND.(xtsol_prec(iso_O18,i)
+          endif !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
        enddo !do i=1,knon
 #endif
@@ -14534,5 +14534,5 @@
         CALL iso_verif_positif(max_eau_sol-qsol_prec(i), &
                  'calcul_iso_surf_ter 882')
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
           CALL iso_verif_positif(xtprecip_rain(iso_eau,i), &
                  'calcul_iso_surf_ter 655b')
@@ -14542,5 +14542,5 @@
               
         !WRITE(*,*) 'surf_ter 14041'
-        if (ruissellement_pluie.eq.1) THEN
+        IF (ruissellement_pluie.EQ.1) THEN
           do i=1,knon
              ! c'est la pluie que l'on fait ruisseller
@@ -14556,5 +14556,5 @@
              enddo
              runoff_tmp(i)=0.0
-             if (qsol_prec(i) &
+             IF (qsol_prec(i) &
                  +(precip_rain(i)-sol_evap(i))*dtime &
                  +fq_fonte_neige(i).gt.max_eau_sol) THEN
@@ -14564,5 +14564,5 @@
                   +(max_eau_sol-qsol_prec(i)-fq_fonte_neige(i))/dtime, &
                    precip_rain(i))
-                if (precip_rain_eff(i).lt.0.0) THEN
+                IF (precip_rain_eff(i).lt.0.0) THEN
                        ! ça déborderait même sans pluie
                     ! on réduit donc la fonte
@@ -14570,5 +14570,5 @@
                     fq_fonte_neige_eff(i)=min(sol_evap(i)*dtime &
                          +max_eau_sol-qsol_prec(i),fq_fonte_neige(i))
-                    if (fq_fonte_neige_eff(i).lt.0.0) THEN
+                    IF (fq_fonte_neige_eff(i).lt.0.0) THEN
                       ! ca déborderait même sans precip ni fonte car il
                       ! y a de la rosée
@@ -14605,5 +14605,5 @@
             CALL iso_verif_positif((precip_rain_eff(i)), &
                  'calcul iso_surf_ter 703')
-            if (sol_evap(i).ge.0.0) THEN
+            IF (sol_evap(i).ge.0.0) THEN
                 CALL iso_verif_egalite_choix( &
                    sol_evap(i), &
@@ -14613,9 +14613,9 @@
 #endif  
             ! pour les isostopes:
-            if (abs(precip_rain(i)-precip_rain_eff(i)) &
+            IF (abs(precip_rain(i)-precip_rain_eff(i)) &
                  .gt.ridicule*1e-2) THEN
              ! *  pour precip_rain_eff:            
-             if (precip_rain_eff(i).gt.ridicule_rain) THEN
-               if (precip_rain(i).gt.ridicule_rain) THEN
+             IF (precip_rain_eff(i).gt.ridicule_rain) THEN
+               IF (precip_rain(i).gt.ridicule_rain) THEN
                 do ixt=1,niso
                   xtprecip_rain_eff(ixt,i)=xtprecip_rain(ixt,i) &
@@ -14630,5 +14630,5 @@
                   xtprecip_rain_eff(ixt,i)=0.0
                 enddo
-                if ((bidouille_anti_divergence).and. &
+                IF ((bidouille_anti_divergence).AND. &
                  (iso_eau.gt.0))  THEN
                   xtprecip_rain_eff(iso_eau,i)=precip_rain_eff(i)
@@ -14643,5 +14643,5 @@
             endif !if (abs(precip_rain(i)-precip_rain_eff(i)).gt.ridicule) THEN
 #ifdef ISOVERIF            
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix( &
                  runoff_tmp(i),xtrun_off(iso_eau,i), &
@@ -14651,9 +14651,9 @@
 #endif   
 
-            if (abs(fq_fonte_neige_eff(i)-fq_fonte_neige(i)) &
+            IF (abs(fq_fonte_neige_eff(i)-fq_fonte_neige(i)) &
                  .gt.ridicule) THEN
              ! *  pour fq_fonte_neige_eff:
-             if (fq_fonte_neige_eff(i).gt.ridicule_rain) THEN
-               if (fq_fonte_neige(i).gt.ridicule_rain) THEN
+             IF (fq_fonte_neige_eff(i).gt.ridicule_rain) THEN
+               IF (fq_fonte_neige(i).gt.ridicule_rain) THEN
                 do ixt=1,niso
                   fxt_fonte_neige_eff(ixt,i)=fxt_fonte_neige(ixt,i) &
@@ -14678,5 +14678,5 @@
 
 #ifdef ISOVERIF            
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(( &
                  fq_fonte_neige_eff(i)), &
@@ -14708,5 +14708,5 @@
        enddo !do i=1,knon 
        do i=1,knon
-        if (qsol_prec(i).ge.0.0) THEN
+        IF (qsol_prec(i).ge.0.0) THEN
           do ixt=1,niso
            xtsol_avant_evap(ixt,i)=xtsol_prec(ixt,i) &
@@ -14714,5 +14714,5 @@
           enddo !do ixt=1,niso
         else !if (qsol_prec(i).ge.0.0) THEN
-            if (precip_rain_eff(i)*dtime+fq_fonte_neige_eff(i) &
+            IF (precip_rain_eff(i)*dtime+fq_fonte_neige_eff(i) &
                  .gt.ridicule_qsol) THEN
               do ixt=1,niso
@@ -14735,6 +14735,6 @@
       do i=1,knon         
       do ixt=1,niso
-        if (iso_verif_noNaN_nostop(( &
-          xtsol_avant_evap(ixt,i)),'surf_ter 1239').eq.1) THEN
+        IF (iso_verif_noNaN_nostop(( &
+          xtsol_avant_evap(ixt,i)),'surf_ter 1239').EQ.1) THEN
           WRITE(*,*) 'qsol_prec(i)=',qsol_prec(i)
           WRITE(*,*) 'xtsol_prec(ixt,i)=',xtsol_prec(ixt,i)
@@ -14755,5 +14755,5 @@
 #ifdef ISOVERIF
         do i=1,knon
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
 !            WRITE(*,*) 'qsol_prec=',qsol_prec(i)
 !            WRITE(*,*) 'xtsol_prec=',xtsol_prec(iso_eau,i)
@@ -14770,9 +14770,9 @@
                  'calcul_iso_surf_ter 527',errmax,errmaxrel)
           endif          
-          if (iso_HDO.gt.0) THEN
-           if (qsol_avant_evap(i).gt.ridicule_qsol*1e2) THEN
-             if (iso_verif_aberrant_nostop(( &
+          IF (iso_HDO.gt.0) THEN
+           IF (qsol_avant_evap(i).gt.ridicule_qsol*1e2) THEN
+             IF (iso_verif_aberrant_nostop(( &
                  xtsol_avant_evap(iso_HDO,i)/qsol_avant_evap(i)) &
-                 /faccond,'calcul_iso_surf_ter 5032').eq.1) THEN
+                 /faccond,'calcul_iso_surf_ter 5032').EQ.1) THEN
                WRITE(*,*) 'qsol_avant_evap(i)=',qsol_avant_evap(i)
                WRITE(*,*) 'ridicule_qsol=',ridicule_qsol
@@ -14796,12 +14796,12 @@
            endif ! if ( qsol_avant_evap(i).gt.ridicule_qsol)  
           endif !if (iso_eau.gt.0) THEN
-          if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-            if (qsol_avant_evap(i).gt.ridicule_qsol) THEN
+          IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+            IF (qsol_avant_evap(i).gt.ridicule_qsol) THEN
               CALL iso_verif_aberrant_o17(( &
                  xtsol_avant_evap(iso_O17,i)/qsol_avant_evap(i)), &
                  (xtsol_avant_evap(iso_O18,i) &
                  /qsol_avant_evap(i)),'iso_surf_ter 1263')
-            endif !if ((qsol_prec(i).gt.ridicule).and.(xtsol_prec(iso_O18,i)
-          endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+            endif !if ((qsol_prec(i).gt.ridicule).AND.(xtsol_prec(iso_O18,i)
+          endif !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
         enddo !do i=1,knon   
 #endif
@@ -14821,8 +14821,8 @@
                 qsol(i), &
                'calcul_iso_surf_ter 587',errmax,errmaxrel)
-           if (ruissellement_pluie.eq.1) THEN
-             if (iso_verif_positif_choix_nostop( &
+           IF (ruissellement_pluie.EQ.1) THEN
+             IF (iso_verif_positif_choix_nostop( &
                  max_eau_sol-(qsol_avant_deversement(i)), &
-                 ridicule_qsol,'calcul_iso_surf_ter 843').eq.1) THEN
+                 ridicule_qsol,'calcul_iso_surf_ter 843').EQ.1) THEN
                WRITE(*,*) 'qsol_avant_evap(i)=',qsol_avant_evap(i)
                WRITE(*,*) 'qsol_avant_deversement(i)=', &
@@ -14842,5 +14842,5 @@
          ! modif 2 octobre! sol_evap au lie de evap
          ! modif 5 oct: gt au lieu de ge.
-          if (sol_evap(i).gt.0.0) THEN
+          IF (sol_evap(i).gt.0.0) THEN
            ncas_evap=ncas_evap+1
            cas_evap(ncas_evap)=i 
@@ -14848,5 +14848,5 @@
            trace_cas(i)=1
 #endif
-          else if (sol_evap(i).lt.0.0) THEN
+          ELSE IF (sol_evap(i).lt.0.0) THEN
            ncas_rosee=ncas_rosee+1
            cas_rosee(ncas_rosee)=i
@@ -14882,7 +14882,7 @@
 !              WRITE(*,*) 'xtsol_avant_evap,qsol_avant_evap=',
 !     :           xtsol_avant_evap(iso_eau,i),qsol_avant_evap(i) 
-          if  (iso_verif_egalite_nostop(sol_evap(i), &
+          IF  (iso_verif_egalite_nostop(sol_evap(i), &
                (sol_evap_eff(i)), &
-                'calcul_iso_surf_ter 1100').eq.1) THEN
+                'calcul_iso_surf_ter 1100').EQ.1) THEN
             WRITE(*,*) 'calcul_iso_surf_ter 543: qsol(',i,')=',qsol(i)
             WRITE(*,*) 'qsol_avant_evap(',i,')=',qsol_avant_evap(i)
@@ -14893,5 +14893,5 @@
             stop
             endif 
-              if (iso_eau.gt.0) THEN
+              IF (iso_eau.gt.0) THEN
                 CALL iso_verif_egalite_choix(( &
                  xtsol_avant_evap(iso_eau,i)) &
@@ -14899,9 +14899,9 @@
                  'calcul_iso_surf_ter 2952', &
                          errmax,errmaxrel)
-                if (qsol_avant_evap(i).gt.ridicule_qsol) THEN
-                  if (iso_verif_egalite_choix_nostop(( &
+                IF (qsol_avant_evap(i).gt.ridicule_qsol) THEN
+                  IF (iso_verif_egalite_choix_nostop(( &
                     xtsol_avant_evap(iso_eau,i)/qsol_avant_evap(i)), &
                     1.0,'calcul_iso_surf_ter 2952', &
-                    errmax,errmaxrel*10).eq.1) THEN
+                    errmax,errmaxrel*10).EQ.1) THEN
                       WRITE(*,*) 'xtsol_avant_evap(iso_eau,i)=', &
                          xtsol_avant_evap(iso_eau,i)
@@ -14924,6 +14924,6 @@
                 endif !if (qsol(i).gt.ridicule_qsol) THEN
               endif !if (iso_eau.gt.0) THEN
-              if (iso_HDO.gt.0) THEN
-                if (qsol_avant_evap(i).gt.ridicule_qsol*1e2) THEN
+              IF (iso_HDO.gt.0) THEN
+                IF (qsol_avant_evap(i).gt.ridicule_qsol*1e2) THEN
                   CALL iso_verif_aberrant(( &
                  xtsol_avant_evap(iso_HDO,i)/qsol_avant_evap(i)) &
@@ -14931,17 +14931,17 @@
                 endif !if (qsol(i).gt.ridicule_qsol) THEN
               endif  !if (iso_HDO.gt.0) THEN
-              if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-               if (qsol_avant_evap(i).gt.ridicule_qsol) THEN
+              IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+               IF (qsol_avant_evap(i).gt.ridicule_qsol) THEN
                    CALL iso_verif_aberrant_o17(( &
                     xtsol_avant_evap(iso_O17,i)/qsol_avant_evap(i)), &
                     (xtsol_avant_evap(iso_O18,i) &
                     /qsol_avant_evap(i)),'iso_surf_ter 1390')
-                endif !if ((qsol_prec(i).gt.ridicule).and.(xtsol_prec(iso_O18,i)
-              endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+                endif !if ((qsol_prec(i).gt.ridicule).AND.(xtsol_prec(iso_O18,i)
+              endif !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
 #endif
            ! end verif du sol
        
        ! calcul de h1
-       if (tsurf(i).lt.t_coup) THEN
+       IF (tsurf(i).lt.t_coup) THEN
            zqs(i)=qsats(tsurf(i))/ps(i)
 #ifdef ISOVERIF            
@@ -14953,8 +14953,8 @@
 #ifdef ISOVERIF            
            CALL iso_verif_positif(zqs(i),'calcul_iso_surf 1187')
-           if (iso_verif_positif_nostop(0.15-zqs(i),& 
-                  'calcul_iso_surf 1188').eq.1) THEN
+           IF (iso_verif_positif_nostop(0.15-zqs(i),&
+                  'calcul_iso_surf 1188').EQ.1) THEN
                 WRITE(*,*) 'tsurf(i)=',tsurf(i)-t_coup,'°C'
-                if (tsurf(i)-t_coup.lt.50.0) THEN
+                IF (tsurf(i)-t_coup.lt.50.0) THEN
                    stop
                 endif
@@ -14977,21 +14977,21 @@
 #endif  
 #ifdef ISOVERIF       
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
           CALL iso_verif_egalite_choix(Rsol(iso_eau),1.0, &
                  'calcul_iso_surf_ter 700',errmax*10,errmaxrel*10)
          endif !if (iso_eau.gt.0) THEN
-         if ((iso_HDO.gt.0).and. &
+         IF ((iso_HDO.gt.0).AND. &
                  (qsol_avant_evap(i).gt.ridicule_qsol*1e2)) THEN
           CALL iso_verif_aberrant(Rsol(iso_HDO)/faccond, &
                  'calcul_iso_surf_ter 703')
          endif
-         if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-            if (qsol_avant_evap(i).gt.ridicule_qsol) THEN
+         IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+            IF (qsol_avant_evap(i).gt.ridicule_qsol) THEN
               CALL iso_verif_aberrant_o17(Rsol(iso_o17),Rsol(iso_o18), &
                  'iso_surf_ter 1447')
-            endif !if ((qsol_prec(i).gt.ridicule).and.(xtsol_prec(iso_O18,i)
-          endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-#endif
-        if ((bidouille_anti_divergence).and. &
+            endif !if ((qsol_prec(i).gt.ridicule).AND.(xtsol_prec(iso_O18,i)
+          endif !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+#endif
+        IF ((bidouille_anti_divergence).AND. &
                  (iso_eau.gt.0))  THEN
             Rsol(iso_eau)=1.0
@@ -15009,5 +15009,5 @@
           enddo   
 #endif
-          if (q1lay(i).gt.0.0) THEN
+          IF (q1lay(i).gt.0.0) THEN
               do ixt=1,niso  
                 R1(ixt)=xt1lay(ixt,i)/q1lay(i)
@@ -15040,5 +15040,5 @@
 
          ! calcul de l'évap
-         if (alphak_stewart.eq.1) THEN
+         IF (alphak_stewart.EQ.1) THEN
              ! calcul de alphak en accord avec stewart, mathieu et
              ! Bariac
@@ -15057,5 +15057,5 @@
          
          qevap(i)=sol_evap(i)*dtime ! quantité d'eau du sol perdue par evap
-         if (tsurf(i).gt.t_coup) THEN
+         IF (tsurf(i).gt.t_coup) THEN
              ! Pveg est la fraction d'eau évaporée sans fractionnement
              Pveg=P_veg
@@ -15067,9 +15067,9 @@
          
 #ifdef ISOVERIF         
-         if (P_veg.eq.1.0) THEN
+         IF (P_veg.EQ.1.0) THEN
          CALL iso_verif_egalite(Pveg,1.0,'calcul_iso_surf_ter 1314')
         endif
 #endif         
-        if (Pveg.gt.1.0-1e-3) THEN
+        IF (Pveg.gt.1.0-1e-3) THEN
             do ixt=1,niso
               xtnu(ixt,i)=0.0
@@ -15080,15 +15080,15 @@
             tsurf(i),alphak, L, xtnu(1,i),Pveg)
 #ifdef ISOVERIF
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
            CALL iso_verif_egalite_choix(xtnu(iso_eau,i),qevap(i),&
                  'calcul_iso_surf_ter 1253',errmax,errmaxrel)
          endif
-         if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-            if (qevap(i).gt.ridicule_evap) THEN
+         IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+            IF (qevap(i).gt.ridicule_evap) THEN
               CALL iso_verif_aberrant_o17(xtnu(iso_O17,i) &
                  /qevap(i),xtnu(iso_O18,i)/qevap(i), &
                  'iso_surf_ter 1623')
           endif !if (qevap(i).gt.ridicule_evap) THEN
-        endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+        endif !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
 #endif                  
         endif     
@@ -15107,22 +15107,22 @@
          enddo !do ixt=1,niso
 
-         if (evap_cont_cste.eq.1) THEN
+         IF (evap_cont_cste.EQ.1) THEN
              ! on fixe la compo de l'évap continentale
-             if (iso_eau.gt.0) THEN
+             IF (iso_eau.gt.0) THEN
                  xtsol_evap(iso_eau,i)=sol_evap(i)
              endif
-             if (iso_O18.gt.0) THEN
+             IF (iso_O18.gt.0) THEN
                  xtsol_evap(iso_O18,i)=sol_evap(i) &
                    *(deltaO18_evap_cont/1000.+1.)*tnat(iso_O18)
              endif
-             if (iso_HDO.gt.0) THEN
+             IF (iso_HDO.gt.0) THEN
                  xtsol_evap(iso_HDO,i)=sol_evap(i) &
                   *((d_evap_cont+8*deltaO18_evap_cont)/1000.+1.) &
                   *tnat(iso_HDO)
              endif
-             if (iso_O17.gt.0) THEN
+             IF (iso_O17.gt.0) THEN
                  xtsol_evap(iso_O17,i)=0.0
              endif
-             if (iso_HTO.gt.0) THEN
+             IF (iso_HTO.gt.0) THEN
                  xtsol_evap(iso_HTO,i)=0.0
              endif
@@ -15130,5 +15130,5 @@
 
 #ifdef ISOTRAC
-        if (option_traceurs.eq.20) THEN
+        IF (option_traceurs.EQ.20) THEN
            izone_recoit=bassin_map(knindex(i))
         else
@@ -15137,5 +15137,5 @@
 
         do ixt=niso+1,ntraciso
-           if (index_zone(ixt).eq.izone_recoit) THEN
+           IF (index_zone(ixt).EQ.izone_recoit) THEN
              xtsol_evap(ixt,i)=xtsol_evap(index_iso(ixt),i)
            else
@@ -15156,5 +15156,5 @@
 #endif           
 #ifdef ISOVERIF
-           if (iso_eau.gt.0) THEN
+           IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix( &
                  xtsol_evap(iso_eau,i), &
@@ -15165,9 +15165,9 @@
                  'calcul_iso_surf_ter 2976',errmax,errmaxrel)
            endif !if (iso_eau.gt.0) THEN
-           if (iso_HDO.gt.0) THEN
-             if (abs(sol_evap(i)).gt.ridicule_evap) THEN
-              if (iso_verif_aberrant_nostop( &
+           IF (iso_HDO.gt.0) THEN
+             IF (abs(sol_evap(i)).gt.ridicule_evap) THEN
+              IF (iso_verif_aberrant_nostop( &
                  xtsol_evap(iso_HDO,i)/sol_evap(i), &
-                 'calcul_iso_surf_ter 3273: sur terre').eq.1) THEN
+                 'calcul_iso_surf_ter 3273: sur terre').EQ.1) THEN
 !                   WRITE(*,*) 'deltaDsol=',deltaD(Rsol(ixt))
                    ! on ne plante que si ca donne lieu à des valeurs
@@ -15182,7 +15182,7 @@
               endif  !if (iso_verif_aberrant  
              endif !if (abs(evap(i)).gt.ridicule_rain*1e-2) THEN
-             if (iso_verif_aberrant_choix_nostop(xtsol_evap(iso_HDO,i), &
+             IF (iso_verif_aberrant_choix_nostop(xtsol_evap(iso_HDO,i), &
                  sol_evap(i),ridicule,1e5, &
-                 'calcul_iso_surf_ter 1403').eq.1) THEN
+                 'calcul_iso_surf_ter 1403').EQ.1) THEN
                 CALL iso_verif_aberrant( &
                          (xtsol_evap(iso_hdo,i)*dtime+q10*R1(iso_hdo)) &
@@ -15190,8 +15190,8 @@
                         'calcul_iso_surf_ter 1390')
               endif
-              if (qsol_avant_deversement(i).gt.ridicule_qsol*1e2) THEN
-                if (iso_verif_aberrant_nostop(xtsol(iso_HDO,i)& 
+              IF (qsol_avant_deversement(i).gt.ridicule_qsol*1e2) THEN
+                IF (iso_verif_aberrant_nostop(xtsol(iso_HDO,i)&
                          /(qsol_avant_deversement(i)) &
-                       /faccond, 'calcul_iso_surf_ter 1542').eq.1) THEN
+                       /faccond, 'calcul_iso_surf_ter 1542').EQ.1) THEN
                   WRITE(*,*) 'i, qsol(i)=',i, qsol(i)
                   WRITE(*,*) 'qsol_avant_evap,qevap,L=', &
@@ -15210,21 +15210,21 @@
               endif !if (qsol(i).gt.ridicule_qsol) THEN
            endif  !if (iso_HDO.gt.0) THEN
-           if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-             if (qevap(i).gt.ridicule_evap) THEN
+           IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+             IF (qevap(i).gt.ridicule_evap) THEN
                CALL iso_verif_aberrant_o17(xtnu(iso_O17,i) &
                  /qevap(i),xtnu(iso_O18,i)/qevap(i), &
                  'iso_surf_ter 1626')
             endif 
-            if (sol_evap(i).gt.ridicule_evap) THEN
+            IF (sol_evap(i).gt.ridicule_evap) THEN
                CALL iso_verif_aberrant_o17(xtsol_evap(iso_O17,i) &
                  /sol_evap(i),xtsol_evap(iso_O18,i)/sol_evap(i), &
                  'iso_surf_ter 1631')
             endif
-            if (qsol(i).gt.ridicule_qsol) THEN
-              if (iso_verif_aberrant_o17_nostop(xtsol(iso_O17,i) &
+            IF (qsol(i).gt.ridicule_qsol) THEN
+              IF (iso_verif_aberrant_o17_nostop(xtsol(iso_O17,i) &
                  /(qsol_avant_deversement(i)), &
                  xtsol(iso_O18,i) &
                  /(qsol_avant_deversement(i)), &
-                 'iso_surf_ter 1623').eq.1) THEN
+                 'iso_surf_ter 1623').EQ.1) THEN
                   WRITE(*,*) 'i, qsol(i)=',i,qsol_avant_deversement(i)
                   WRITE(*,*) 'qsol_avant_evap,qevap,L=', &
@@ -15251,6 +15251,6 @@
                 stop
               endif !if (iso_verif_aberrant_o17_nostop(xtsol(iso_O17,i)
-            endif !if ((qsol(i).gt.ridicule).and.(xtsol(iso_O18,i)
-          endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+            endif !if ((qsol(i).gt.ridicule).AND.(xtsol(iso_O18,i)
+          endif !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
 #ifdef ISOTRAC
           CALL iso_verif_traceur(xtsol_evap(1,i), &
@@ -15288,12 +15288,12 @@
           ! sol_evap est divisé sans fractionnement en une partie   
           ! dirigée vers le sol, et une partie partant en ruissellement
-          if (abs(sol_evap(i)).gt.0.0) THEN
+          IF (abs(sol_evap(i)).gt.0.0) THEN
             do ixt=1,niso
              xtsol_evap_eff(ixt,i)=xtsol_evap(ixt,i) &
                  /sol_evap(i)*sol_evap_eff(i)
 #ifdef ISOVERIF
-             if (iso_verif_noNaN_nostop(( &
+             IF (iso_verif_noNaN_nostop(( &
                  xtsol_evap_eff(ixt,i)),'iso_surf_ter 1790') &
-                 .eq.1) THEN
+                 .EQ.1) THEN
                WRITE(*,*) 'xtsol_evap,sol_evap,sol_evap_eff=', &
                  xtsol_evap(ixt,i),sol_evap(i),sol_evap_eff(i)
@@ -15311,5 +15311,5 @@
            enddo !do ixt=1,niso
           endif !if (sol_evap.gt.0.0) THEN
-          if (ruissellement_pluie.eq.1) THEN
+          IF (ruissellement_pluie.EQ.1) THEN
             do ixt=1,niso
               xtrun_off(ixt,i)=xtrun_off(ixt,i)+(xtsol_evap_eff(ixt,i) &
@@ -15318,5 +15318,5 @@
              runoff_tmp(i)=runoff_tmp(i) &
                  +(sol_evap_eff(i)-sol_evap(i))*dtime
-          endif !if (ruissellement_pluie.eq.1) THEN
+          endif !if (ruissellement_pluie.EQ.1) THEN
 #ifdef ISOVERIF
           do ixt=1,niso
@@ -15327,5 +15327,5 @@
 #endif
 #ifdef ISOVERIF   
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
                 CALL iso_verif_egalite_choix( &
                  (xtsol_evap_eff(iso_eau,i)), &
@@ -15334,5 +15334,5 @@
                  errmax,errmaxrel)
           endif
-          if (iso_HDO.gt.0) THEN
+          IF (iso_HDO.gt.0) THEN
               ! si il y a rosée, il faut que le flux d'isotopes soit
               ! aussi négatif
@@ -15361,5 +15361,5 @@
 #endif
 #ifdef ISOVERIF
-              if (iso_eau.gt.0) THEN
+              IF (iso_eau.gt.0) THEN
                 CALL iso_verif_egalite_choix(xtsol(iso_eau,i), &
                   (qsol_avant_deversement(i)), &
@@ -15371,11 +15371,11 @@
                     'calcul_iso_surf_ter 771',errmax,errmaxrel)
               endif !if (iso_eau.gt.0) THEN
-              if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-               if (abs(evap(i)).gt.ridicule_evap) THEN
+              IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+               IF (abs(evap(i)).gt.ridicule_evap) THEN
                 CALL iso_verif_aberrant_o17(xtsol_evap(iso_O17,i) &
                  /sol_evap(i),xtsol_evap(iso_O18,i) &
                  /sol_evap(i),'calcul_iso_surf 1754')
               endif !if (qsol(i).gt.ridicule) THEN
-             endif ! if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+             endif ! if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
 #endif
                     
@@ -15384,7 +15384,7 @@
         ! deversement du trop plein  
         ! seulement si c'est le sol qu'on fait ruisseller:
-        if (ruissellement_pluie.eq.0) THEN
+        IF (ruissellement_pluie.EQ.0) THEN
           do i=1,knon  
-          if (qsol_avant_deversement(i).gt.max_eau_sol) THEN
+          IF (qsol_avant_deversement(i).gt.max_eau_sol) THEN
               do ixt=1,niso
                 xtrun_off(ixt,i)=run_off(i)*xtsol(ixt,i) &
@@ -15393,5 +15393,5 @@
                          *max_eau_sol,max_eau_sol)
 #ifdef ISOVERIF 
-                if (iso_eau.gt.0) THEN
+                IF (iso_eau.gt.0) THEN
                   CALL iso_verif_egalite_choix(run_off(i), &
                        xtrun_off(iso_eau,i),'calcul_iso_surf_ter 1774', &
@@ -15410,5 +15410,5 @@
           endif !if (qsol(i).gt.max_eau_sol) THEN
           enddo ! do i=1,knon  
-      else if (ruissellement_pluie.eq.1) THEN
+      ELSE IF (ruissellement_pluie.EQ.1) THEN
             ! on vérifie que rien ne déborde
 #ifdef ISOVERIF  
@@ -15417,5 +15417,5 @@
                  max_eau_sol-(qsol_avant_deversement(i)), &
                  ridicule_qsol,'calcul_iso_surf_ter 935')
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
             call  iso_verif_egalite_choix(runoff_tmp(i), &
                        xtrun_off(iso_eau,i),'calcul_iso_surf_ter 1794', &
@@ -15424,7 +15424,7 @@
 !            WRITE(*,*) 'tmp ter 1929: i,runoff_tmp,run_off=',
 !     :           i,runoff_tmp(i),run_off(i)
-           if (iso_verif_egalite_choix_nostop(runoff_tmp(i), &
+           IF (iso_verif_egalite_choix_nostop(runoff_tmp(i), &
                 run_off(i),'calcul_iso_surf_ter 1772', &
-                errmax_sol*max(qsol_prec(i),1.0),errmaxrel).eq.1) THEN
+                errmax_sol*max(qsol_prec(i),1.0),errmaxrel).EQ.1) THEN
            ! il y a beaucoup d'inprecision associée à runoff, car dans
            ! LMDZ, runoff=qsol-max_eau_sol (cf fonte_neige).
@@ -15457,5 +15457,5 @@
          ! rectification éventuelle du runoff
         do i=1,knon
-         if (runoff_tmp(i).gt.0.0) THEN
+         IF (runoff_tmp(i).gt.0.0) THEN
           do ixt=1,niso   
            xtrun_off(ixt,i)=xtrun_off(ixt,i)/runoff_tmp(i)*run_off(i)
@@ -15465,5 +15465,5 @@
 #ifdef ISOVERIF
         do i=1,knon
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(run_off(i), &
               xtrun_off(iso_eau,i),'calcul_iso_surf_ter 1834', &
@@ -15476,5 +15476,5 @@
           WRITE(*,*) 'ruissellement_pluie=',ruissellement_pluie
           stop
-        endif !if (ruissellement_pluie.eq.0) THEN
+        endif !if (ruissellement_pluie.EQ.0) THEN
         ! on en déduit l'évap vers l'atm:
         do i=1,knon
@@ -15503,9 +15503,9 @@
 #ifdef ISOVERIF
         do i=1,knon
-              if (iso_eau.gt.0) THEN
-                 if (iso_verif_egalite_choix_nostop( &
+              IF (iso_eau.gt.0) THEN
+                 IF (iso_verif_egalite_choix_nostop( &
                      xtevap(iso_eau,i),evap(i), &
                      'calcul_iso_surf_ter 1059',errmax,errmaxrel) &
-                     .eq.1) THEN
+                     .EQ.1) THEN
                    WRITE(*,*) 'xtevap(iso_eau,i)=',xtevap(iso_eau,i)
                    WRITE(*,*) 'evap(i)=',evap(i)
@@ -15524,7 +15524,7 @@
                  CALL iso_verif_positif(max_eau_sol-qsol(i), &
                          'calcul_iso_surf_ter 746a')
-                 if (iso_verif_positif_nostop( &
+                 IF (iso_verif_positif_nostop( &
                          max_eau_sol-xtsol(iso_eau,i), &
-                         'calcul_iso_surf_ter 746b').eq.1) THEN
+                         'calcul_iso_surf_ter 746b').EQ.1) THEN
                    WRITE(*,*) 'i=',i
                    WRITE(*,*) 'max_eau_sol=',max_eau_sol
@@ -15549,5 +15549,5 @@
                    WRITE(*,*) 'xtsol_evap(iso_eau,i)=', &
                          xtsol_evap(iso_eau,i)
-                   if (xtsol(iso_eau,i)-max_eau_sol.gt.1e-9) THEN
+                   IF (xtsol(iso_eau,i)-max_eau_sol.gt.1e-9) THEN
                       stop
                    else
@@ -15557,5 +15557,5 @@
                  endif
               endif !if (iso_eau.gt.0) THEN
-              if (iso_HDO.gt.0) THEN
+              IF (iso_HDO.gt.0) THEN
                  CALL iso_verif_aberrant_choix(xtsnow(iso_HDO,i),snow(i), &
                         ridicule_snow,deltalim_snow, 'calcul_iso_surf_ter 749')
@@ -15563,14 +15563,14 @@
                      snow(i),ridicule,deltalim_snow, &
                      'calcul_iso_surf_lic 1955')
-                 if (evap(i).gt.ridicule_evap) THEN
-                   if (iso_verif_aberrant_nostop( &
+                 IF (evap(i).gt.ridicule_evap) THEN
+                   IF (iso_verif_aberrant_nostop( &
                          xtevap(iso_HDO,i)/evap(i), &
-                        'calcul_iso_surf_ter 751').eq.1) THEN
+                        'calcul_iso_surf_ter 751').EQ.1) THEN
                      WRITE(*,*) 'i=',i
                      WRITE(*,*) 'sol_evap,snow_evap=', &
                          sol_evap(i),snow_evap(i)
-                     if (sol_evap(i).gt.ridicule_evap)WRITE(*,*) 'deltaDsol_evap=', &
+                     IF (sol_evap(i).gt.ridicule_evap)WRITE(*,*) 'deltaDsol_evap=', &
                          deltaD(xtsol_evap(iso_hdo,i)/sol_evap(i))
-                     if (snow_evap(i).gt.ridicule_evap)WRITE(*,*) 'deltaDsnow_evap=', &
+                     IF (snow_evap(i).gt.ridicule_evap)WRITE(*,*) 'deltaDsnow_evap=', &
                          deltaD(xtsnow_evap(iso_hdo,i)/snow_evap(i))
                      WRITE(*,*) 'deltaD1new=',deltaD( &
@@ -15584,7 +15584,7 @@
                    endif
                  endif !if (evap(i).gt.ridicule_evap) THEN
-                 if (iso_verif_aberrant_choix_nostop(xtevap(iso_HDO,i), &
+                 IF (iso_verif_aberrant_choix_nostop(xtevap(iso_HDO,i), &
                    evap(i),ridicule,1e5,'calcul_iso_surf_ter 1578') &
-                         .eq.1) THEN
+                         .EQ.1) THEN
                      WRITE(*,*) 'i=',i
                      WRITE(*,*) 'sol_evap,snow_evap=', &
@@ -15599,16 +15599,16 @@
                         'calcul_iso_surf_ter 1590')
                 endif
-                 if (qsol(i).gt.ridicule_qsol*1e2) THEN
+                 IF (qsol(i).gt.ridicule_qsol*1e2) THEN
                    CALL iso_verif_aberrant(xtsol(iso_HDO,i)/qsol(i) &
                         /faccond,'calcul_iso_surf_ter 752')
                  endif !if (qsol(i).gt.ridicule_qsol) THEN
               endif !if (iso_eau.gt.0) THEN
-              if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-               if (abs(evap(i)).gt.ridicule_qsol) THEN
+              IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+               IF (abs(evap(i)).gt.ridicule_qsol) THEN
                  CALL iso_verif_aberrant_o17(xtevap(iso_O17,i) &
                  /evap(i),xtevap(iso_O18,i) &
                  /evap(i),'iso_surf_ter 1827')
-              endif !if ((evap(i).gt.ridicule).and.(xtevap(iso_O18,i)
-             endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+              endif !if ((evap(i).gt.ridicule).AND.(xtevap(iso_O18,i)
+             endif !if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
 #ifdef ISOTRAC
            CALL iso_verif_tracnps(xtevap(1,i), &
@@ -15618,5 +15618,5 @@
                   
 #endif
-        if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+        IF ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
          do i=1,knon     
           xtsol(iso_eau,i)=qsol(i) 
@@ -15630,7 +15630,7 @@
          dqdiag=precip_rain(i)*dtime+fq_fonte_neige(i) &
                   -(evap(i)-snow_evap(i))*dtime-run_off(i)
-         if (iso_verif_egalite_choix_nostop(dqdiag, &
+         IF (iso_verif_egalite_choix_nostop(dqdiag, &
                  qsol(i)-qsol_prec(i),'ter 2087', &
-                 errmax_sol*max(qsol(i),1.0),errmaxrel).eq.1) THEN
+                 errmax_sol*max(qsol(i),1.0),errmaxrel).EQ.1) THEN
              WRITE(*,*) 'calcul_iso_surf_ter 2050: bilan qsol,i=',i
              WRITE(*,*) 'qsol(i)=',qsol(i)
@@ -15644,5 +15644,5 @@
              stop
          endif !if (iso_verif_egalite_choix_nostop(dqdiag,
-         if (evap_cont_cste.ne.1) THEN
+         IF (evap_cont_cste.NE.1) THEN
              ! si evap_cont_cste=1, on prescrit compo de l'évap du sol
              ! -> normal de ne pas conserver la masse d'isotopes
@@ -15651,7 +15651,7 @@
                   -(xtevap(ixt,i)-xtsnow_evap(ixt,i))*dtime &
                   -xtrun_off(ixt,i)
-            if (iso_verif_egalite_choix_nostop(dqdiag, &
+            IF (iso_verif_egalite_choix_nostop(dqdiag, &
                  xtsol(ixt,i)-xtsol_prec(ixt,i),'ter 1887', &
-                 errmax_sol*max(qsol(i),1.0),errmaxrel).eq.1) THEN
+                 errmax_sol*max(qsol(i),1.0),errmaxrel).EQ.1) THEN
              WRITE(*,*) 'calcul_iso_surf_ter 2066: bilan xtsol, ixt=', &
                  ixt
@@ -15673,5 +15673,5 @@
              WRITE(*,*) 'run_off(i) (diag)=',run_off(i)
              WRITE(*,*) 'runoff_tmp(i)=',runoff_tmp(i)
-             if (qsol_prec(i).gt.-ridicule) THEN
+             IF (qsol_prec(i).gt.-ridicule) THEN
                  stop
                  ! sinon, si qsolprec<0, on fait compo du sol=compo des
@@ -15682,5 +15682,5 @@
            endif    
           enddo
-         endif !if (evap_cont_cste.ne.1) THEN
+         endif !if (evap_cont_cste.NE.1) THEN
       enddo !do i=1,knon
 
@@ -15734,8 +15734,8 @@
       ! arguments  
       !real xtsol(niso,klon) 
-      real xtsnow(niso,klon,nbsrf)  
+      REAL xtsnow(niso,klon,nbsrf)
       !real xtevap(ntraciso,klon,nbsrf)  
-      real xtrun_off_lic_0(niso,klon)
-      real Rland_ice(niso,klon)
+      REAL xtrun_off_lic_0(niso,klon)
+      REAL Rland_ice(niso,klon)
 
       !REAL qsol(klon)
@@ -15745,5 +15745,5 @@
 
       ! locals
-      integer ixt,i,k,nsrf
+      INTEGER ixt,i,k,nsrf
 
 !      character*50 text
@@ -15752,5 +15752,5 @@
       WRITE(*,*) 'initialisation_iso=',initialisation_iso
 
-      if (initialisation_iso.eq.0) THEN
+      IF (initialisation_iso.EQ.0) THEN
           CALL phyiso_etat0_fichier( &
                  snow,run_off_lic_0, &
@@ -15779,5 +15779,5 @@
       enddo !do i=1,klon
       do i=1,klon
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
          CALL iso_verif_egalite(xtsol(iso_eau,i),qsol(i), &
                  'phyisoetat0 759')
@@ -15798,5 +15798,5 @@
                  'phyisoetat0 771c')
            enddo !do ixt=1,niso
-           if (iso_eau.gt.0) THEN
+           IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite(xt_ancien(iso_eau,i,k), &
                  q_ancien(i,k),'phyisoetat0 775a')
@@ -15806,15 +15806,15 @@
                  qs_ancien(i,k),'phyisoetat0 775c')
            endif !if (iso_eau.gt.0) THEN
-           if (iso_HDO.gt.0) THEN
-             if (q_ancien(i,k).gt.2e-3) THEN
+           IF (iso_HDO.gt.0) THEN
+             IF (q_ancien(i,k).gt.2e-3) THEN
 !                WRITE(*,*) 'i,k=',i,k
                CALL iso_verif_aberrant(xt_ancien(iso_hdo,i,k) &
                  /q_ancien(i,k),'phyisoetat0 103a')
              endif !if (q_ancien(i,k).gt.2e-3) THEN
-             if (ql_ancien(i,k).gt.2e-3) THEN
+             IF (ql_ancien(i,k).gt.2e-3) THEN
                CALL iso_verif_positif(xtl_ancien(iso_hdo,i,k) &
                  /ql_ancien(i,k),'phyisoetat0 103b')
              endif !if (q_ancien(i,k).gt.2e-3) THEN
-             if (qs_ancien(i,k).gt.2e-3) THEN
+             IF (qs_ancien(i,k).gt.2e-3) THEN
                CALL iso_verif_positif(xts_ancien(iso_hdo,i,k) &
                  /qs_ancien(i,k),'phyisoetat0 103c')
@@ -15841,5 +15841,5 @@
                  'phyisoetat0 123')
 #endif 
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite(xtsnow(iso_eau,i,nsrf),snow(i,nsrf), &
                       'phyisoetat0 787')
@@ -15847,5 +15847,5 @@
                          'phyisoetat0 75')
           endif !if (iso_eau.gt.0) THEN
-          if (iso_HDO.gt.0) THEN
+          IF (iso_HDO.gt.0) THEN
             CALL iso_verif_aberrant_choix(xtsnow(iso_hdo,i,nsrf),snow(i,nsrf), &
                       ridicule_snow, deltalim_snow, 'phyisoetat0 117')
@@ -15854,6 +15854,6 @@
       enddo !do i=1,klon
       do i=1,klon
-        if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-             if ((qsol(i).gt.ridicule_qsol).and.(xtsol(iso_O18,i) &
+        IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+             IF ((qsol(i).gt.ridicule_qsol).AND.(xtsol(iso_O18,i) &
                  .gt.ridicule_qsol*tnat(iso_o18))) THEN
                 CALL iso_verif_aberrant_o17(xtsol(iso_O17,i) &
@@ -15867,5 +15867,5 @@
 
         ! pour le tritium: initialisation des tableaux d'essais nucléaires:
-        if (iso_HTO.gt.0) THEN
+        IF (iso_HTO.gt.0) THEN
           CALL table_tritium_nucl()
         endif
@@ -15907,8 +15907,8 @@
       !integer niso 
       !real xtsol(niso,klon) 
-      real xtsnow(niso,klon,nbsrf)  
+      REAL xtsnow(niso,klon,nbsrf)
       !real xtevap(ntraciso,klon,nbsrf) 
-      real xtrun_off_lic_0(niso,klon)
-      real Rland_ice(niso,klon)
+      REAL xtrun_off_lic_0(niso,klon)
+      REAL Rland_ice(niso,klon)
 
       !REAL qsol(klon)
@@ -15917,17 +15917,17 @@
       REAL run_off_lic_0(klon)
       !locals
-      integer ixt, k, i, nsrf   
-      real deltaD_rain_fall(niso)
-      real deltaD_snow_fall(niso)
-      real deltaD_snow(niso)
-      real deltaD_land_ice(niso)
-      real deltaD_sol(niso)
-      real deltaD_run_off_lic_0(niso)
-      real deltaD_evap(niso)
-      real RMerlivat(niso)
+      INTEGER ixt, k, i, nsrf
+      REAL deltaD_rain_fall(niso)
+      REAL deltaD_snow_fall(niso)
+      REAL deltaD_snow(niso)
+      REAL deltaD_land_ice(niso)
+      REAL deltaD_sol(niso)
+      REAL deltaD_run_off_lic_0(niso)
+      REAL deltaD_evap(niso)
+      REAL RMerlivat(niso)
 
       ! constes
-        real deltaD_snow_fall_O18,deltaD_rain_fall_O18
-        real alpha(niso),kcin(niso)
+        REAL deltaD_snow_fall_O18,deltaD_rain_fall_O18
+        REAL alpha(niso),kcin(niso)
 !      character*50 text
         
@@ -15938,13 +15938,13 @@
         deltaD_snow_fall_O18=-20.
         deltaD_rain_fall_O18=-5.
-        if (iso_HTO.gt.0) THEN
+        IF (iso_HTO.gt.0) THEN
         deltaD_snow_fall(iso_HTO)=-1000.  
         deltaD_rain_fall(iso_HTO)=-1000.   
         endif   
-        if (iso_O18.gt.0) THEN
+        IF (iso_O18.gt.0) THEN
         deltaD_snow_fall(iso_O18)=deltaD_snow_fall_O18
         deltaD_rain_fall(iso_O18)=deltaD_rain_fall_O18
         endif
-        if (iso_O17.gt.0) THEN
+        IF (iso_O17.gt.0) THEN
         deltaD_snow_fall(iso_O17)=(exp(25.0/1e6) &
                  *(deltaD_snow_fall_O18/1000.0+1.0)**0.528 &
@@ -15954,9 +15954,9 @@
                  -1.0)*1000.0
         endif
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
           deltaD_snow_fall(iso_HDO)=deltaD_snow_fall_O18*8.0+10.0
           deltaD_rain_fall(iso_HDO)=deltaD_rain_fall_O18*8.0+10.
         endif
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
           deltaD_snow_fall(iso_eau)=0.
           deltaD_rain_fall(iso_eau)=0.
@@ -15985,5 +15985,5 @@
        do i=1,klon
         do ixt=niso+1,ntraciso
-         if (index_zone(ixt).eq.izone_init) THEN
+         IF (index_zone(ixt).EQ.izone_init) THEN
            xtrain_fall(ixt,i)=rain_fall(i) &
                  *tnat(index_iso(ixt)) &
@@ -16021,5 +16021,5 @@
 #ifdef ISOVERIF
         do i=1,klon  
-             if (iso_eau.gt.0)  THEN
+             IF (iso_eau.gt.0)  THEN
                  CALL iso_verif_egalite(xtsol(iso_eau,i),qsol(i), &
                  'phyiso_etat0_dur 74')
@@ -16038,5 +16038,5 @@
 #ifdef ISOTRAC
           do ixt=niso+1,ntraciso
-           if (index_zone(ixt).eq.izone_init) THEN
+           IF (index_zone(ixt).EQ.izone_init) THEN
              fxtevap(ixt,i,nsrf)=fevap(i,nsrf) &
                  *tnat(index_iso(ixt)) &
@@ -16065,5 +16065,5 @@
                 alpha(ixt),kcin(ixt),toce(ixt))
 
-           if (q_ancien(i,k).gt.ridicule) THEN
+           IF (q_ancien(i,k).gt.ridicule) THEN
            xtl_ancien(ixt,i,k)=ql_ancien(i,k)*alpha(ixt) &
                  *xt_ancien(ixt,i,k)/q_ancien(i,k)
@@ -16087,15 +16087,15 @@
 
         ! Camille 7 mars 2023: ajout d'un check
-        if ((i.eq.1).and.(k.eq.1).and.(iso_HDO.gt.0)) THEN
+        IF ((i.EQ.1).AND.(k.EQ.1).AND.(iso_HDO.gt.0)) THEN
         WRITE(*,*) 'phyisoetat0 16362: q_ancien(1,1)=',q_ancien(1,1)
         WRITE(*,*) 'deltaD_ancien=',deltaD(xt_ancien(iso_HDO,i,k)/q_ancien(i,k))
         WRITE(*,*) 'xt_ancien(:,i,k)=',xt_ancien(:,i,k)
-        endif !if ((i.eq.1).and.(k.eq.1)) THEN
-        if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
-            if (q_ancien(i,k).gt.ridicule) THEN
-               if (iso_verif_o18_aberrant_nostop( &
+        endif !if ((i.EQ.1).AND.(k.EQ.1)) THEN
+        IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
+            IF (q_ancien(i,k).gt.ridicule) THEN
+               IF (iso_verif_o18_aberrant_nostop( &
                     xt_ancien(iso_HDO,i,k)/q_ancien(i,k), &
                     xt_ancien(iso_O18,i,k)/q_ancien(i,k), &
-                    'phyisoetat0 16366 q_ancien').eq.1) THEN
+                    'phyisoetat0 16366 q_ancien').EQ.1) THEN
                   WRITE(*,*) 'phyisoetat0 16367: i,k,q_ancien(i,k)=',i,k,q_ancien(i,k)
                   WRITE(*,*) 'xt_ancien(:,i,k)=',xt_ancien(:,i,k)
@@ -16103,5 +16103,5 @@
               endif !  if (iso_verif_o18_aberrant_nostop 
             endif !if (q_seri(i,k).gt.errmax) THEN
-        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+        endif !if ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
 #endif 
 
@@ -16109,5 +16109,5 @@
 #ifdef ISOTRAC
         do ixt=niso+1,ntraciso
-          if (index_zone(ixt).eq.izone_init) THEN
+          IF (index_zone(ixt).EQ.izone_init) THEN
             xt_ancien(ixt,i,k)=xt_ancien(index_iso(ixt),i,k) 
             xtl_ancien(ixt,i,k)=xtl_ancien(index_iso(ixt),i,k)
@@ -16126,5 +16126,5 @@
        do i=1,klon
         do k=1,klev
-         if (q_ancien(i,k).gt.ridicule) THEN
+         IF (q_ancien(i,k).gt.ridicule) THEN
           do ixt=1,niso
            wake_deltaxt(ixt,i,k)=xt_ancien(ixt,i,k)/q_ancien(i,k) &
@@ -16138,5 +16138,5 @@
 #ifdef ISOTRAC
         do ixt=niso+1,ntraciso
-          if (index_zone(ixt).eq.izone_init) THEN
+          IF (index_zone(ixt).EQ.izone_init) THEN
             wake_deltaxt(ixt,i,k)=wake_deltaxt(index_iso(ixt),i,k) 
           else
@@ -16173,5 +16173,5 @@
          CALL iso_verif_noNAN(Rland_ice(ixt,i),'phyiso_etat0_dur 757')
          enddo !do ixt=1,niso
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
          CALL iso_verif_egalite(xtsol(iso_eau,i),qsol(i), &
                  'phyiso_etat0_dur 759')
@@ -16193,10 +16193,10 @@
                  'phyiso_etat0_dur 240')
            enddo !do ixt=1,niso
-           if (iso_eau.gt.0) THEN
+           IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite(xt_ancien(iso_eau,i,k), &
                  q_ancien(i,k),'phyiso_etat0_dur 775a')
            endif !if (iso_eau.gt.0) THEN
-           if (iso_HDO.gt.0) THEN
-             if (q_ancien(i,k).gt.ridicule) THEN
+           IF (iso_HDO.gt.0) THEN
+             IF (q_ancien(i,k).gt.ridicule) THEN
               CALL iso_verif_aberrant_encadre( &
                  xt_ancien(iso_hdo,i,k)/q_ancien(i,k), &
@@ -16204,6 +16204,6 @@
              endif !if (q_ancien(i,k).gt.ridicule) THEN
            endif !if (iso_HDO.gt.0) THEN
-           if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
-              if (q_ancien(i,k).gt.ridicule) THEN
+           IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
+              IF (q_ancien(i,k).gt.ridicule) THEN
                 CALL iso_verif_O18_aberrant( &
                     xt_ancien(iso_hdo,i,k)/q_ancien(i,k), &
@@ -16211,5 +16211,5 @@
                     'phyiso_etat0_dur 775c')
               endif ! if (q_ancien(i,k).gt.ridicule) THEN
-           endif ! if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+           endif ! if ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
          enddo !do k=1,klev
          do nsrf=1,nbsrf
@@ -16220,5 +16220,5 @@
                  'phyiso_etat0_dur 783')
              enddo !do ixt=1,niso
-             if (iso_eau.gt.0) THEN
+             IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite(xtsnow(iso_eau,i,nsrf),snow(i,nsrf), &
                       'phyiso_etat0_dur 787')
@@ -16227,6 +16227,6 @@
              endif !if (iso_eau.gt.0) THEN
          enddo !do nsrf=1,nbsrf
-         if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-             if ((qsol(i).gt.ridicule_qsol).and.(xtsol(iso_O18,i) &
+         IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+             IF ((qsol(i).gt.ridicule_qsol).AND.(xtsol(iso_O18,i) &
                  .gt.ridicule_qsol*tnat(iso_o18))) THEN
                 CALL iso_verif_aberrant_o17(xtsol(iso_O17,i) &
@@ -16265,6 +16265,6 @@
    USE isotopes_mod,      ONLY: isoName,iso_HDO,iso_eau
    USE phyetat0_get_mod,  ONLY: phyetat0_get, phyetat0_srf
-   USE readTracFiles_mod, ONLY: new2oldH2O
-   USE strings_mod,       ONLY: strIdx, strTail, maxlen, msg, int2str
+   USE lmdz_readTracFiles, ONLY: new2oldH2O
+   USE lmdz_strings,       ONLY: strIdx, strTail, maxlen, msg, int2str
 #ifdef ISOVERIF
    USE isotopes_verif_mod
@@ -16316,5 +16316,5 @@
 #endif
       found = phyetat0iso_srf3(fxtevap,     "XTEVAP", "evaporation",  0.)
-      if (.NOT.found) CALL abort_physic('isotopes_routines_mod', 'phyiso_etat0_fichier 16581a: unfound isotopic variable',1)
+      IF (.NOT.found) CALL abort_physic('isotopes_routines_mod', 'phyiso_etat0_fichier 16581a: unfound isotopic variable',1)
       found = phyetat0iso_get2(xtrain_fall, "xtrain_f", "xrain fall", 0.)
       found = phyetat0iso_get2(xtsnow_fall, "xtsnow_f", "xsnow fall", 0.)
@@ -16345,5 +16345,5 @@
       IF(ixt <= niso) THEN
          found = phyetat0iso_get2(xtsol, "XTSOL", "Surface humidity / bucket", 0.)
-         if (.NOT.found) CALL abort_physic('isotopes_routines_mod', 'phyiso_etat0_fichier 16581b: unfound isotopic variable',1)
+         IF (.NOT.found) CALL abort_physic('isotopes_routines_mod', 'phyiso_etat0_fichier 16581b: unfound isotopic variable',1)
          found = phyetat0iso_get2(Rland_ice, "Rland_ice", "SR land ice", 0.)
          found = phyetat0iso_srf3(xtsnow,      "XTSNOW", "Surface snow", 0.) ! CR avril 2023: deplacer ici 
@@ -16417,7 +16417,7 @@
    END DO
 #endif 
-        ! endif ISOVERIF       
+        ! END IF ISOVERIF
 #endif  
-        ! endif ISOTRAC      
+        ! END IF ISOTRAC
 
 CONTAINS
@@ -16493,32 +16493,32 @@
       !real rlat(klon), rlon(klon) ! Latitude et longitude en degre
       !real rlatd(klon), rlond(klon) ! Latitude et longitude en radian
-      real paprs(klon,klev+1) ! input-R-pression pour chaque inter-couche (en Pa)
-      real zphi(klon,klev) ! input-R-geopotentiel de chaque couche (reference ocean, en m2/s2)
-      real pplay(klon,klev) ! input-R-pression pour le mileu de chaque couche (en Pa)
-      real dtime ! pas de temps en secondes
+      REAL paprs(klon,klev+1) ! input-R-pression pour chaque inter-couche (en Pa)
+      REAL zphi(klon,klev) ! input-R-geopotentiel de chaque couche (reference ocean, en m2/s2)
+      REAL pplay(klon,klev) ! input-R-pression pour le mileu de chaque couche (en Pa)
+      REAL dtime ! pas de temps en secondes
       !real airephy(klon) ! aire d'une grille (m2)
 
 ! output
-      real d_xt_prod_nucl(ntraciso,klon,klev) ! tritium provenant des essais nucleaires
-      real d_xt_cosmo(ntraciso,klon,klev) ! production naturelle de tritium
-      real d_xt_decroiss(ntraciso,klon,klev) ! decroissance radioactive
-      real xt_seri(ntraciso,klon,klev) ! quantite d'isotopes de l'eau
+      REAL d_xt_prod_nucl(ntraciso,klon,klev) ! tritium provenant des essais nucleaires
+      REAL d_xt_cosmo(ntraciso,klon,klev) ! production naturelle de tritium
+      REAL d_xt_decroiss(ntraciso,klon,klev) ! decroissance radioactive
+      REAL xt_seri(ntraciso,klon,klev) ! quantite d'isotopes de l'eau
 
 ! local
 !      integer iso_verif_noNAN_nostop ! pour debuggage
 !      integer iso_verif_positif_strict_nostop ! pour debuggage
-      integer ixt,i,k,k_ref,kb,nlev_prod
-      real pi
+      INTEGER ixt,i,k,k_ref,kb,nlev_prod
+      REAL pi
       parameter (pi=4.*atan(1.))
-      real rlat_geo(klon) ! latitude geomagnetique de la grille (en radians, entre 0 et 90 degres)
-      real glat ! latitude du pole geomagnetique
-      real glon ! longitude du pole geomagnetique
-      real lat_geo,qcos
+      REAL rlat_geo(klon) ! latitude geomagnetique de la grille (en radians, entre 0 et 90 degres)
+      REAL glat ! latitude du pole geomagnetique
+      REAL glon ! longitude du pole geomagnetique
+      REAL lat_geo,qcos
       parameter (nlev_prod=34)
-      real p_ref ! grille de pression de reference
+      REAL p_ref ! grille de pression de reference
       dimension p_ref(nlev_prod)
-      real masse_tritium ! masse d'une molecule de HTO en kg
+      REAL masse_tritium ! masse d'une molecule de HTO en kg
       parameter (masse_tritium=33.3388E-27 )
-      real tau_decroissance_tritium ! periode radioactive du tritium (17.77 ans en secondes)
+      REAL tau_decroissance_tritium ! periode radioactive du tritium (17.77 ans en secondes)
       parameter (tau_decroissance_tritium=560520955.6)
       data p_ref / &
@@ -16533,6 +16533,6 @@
             5886.00, 2943.00 /
 
-      integer j_1ere_bombe !  numero du premier essai nucleaire de la journee en cours (486 au total)
-      integer nbombe ! pour savoir si c'est un jour de bombe et le nombre de bombes durant ce jour
+      INTEGER j_1ere_bombe !  numero du premier essai nucleaire de la journee en cours (486 au total)
+      INTEGER nbombe ! pour savoir si c'est un jour de bombe et le nombre de bombes durant ce jour
 
 #ifdef ISOVERIF
@@ -16578,6 +16578,6 @@
           qcos=sin(glat)*sin(latitude(i))
           qcos=qcos+cos(glat)*cos(latitude(i))*cos(longitude(i)-glon)
-          if ( qcos .lt. -1.) qcos = -1.
-          if ( qcos .gt. 1.) qcos = 1.
+          IF ( qcos .lt. -1.) qcos = -1.
+          IF ( qcos .gt. 1.) qcos = 1.
           rlat_geo(i)=pi/2.-acos(qcos)
        enddo
@@ -16587,5 +16587,5 @@
 ! la production de tritium
        
-       if (iso_HTO.gt.0) then ! Tritium
+       IF (iso_HTO.gt.0) then ! Tritium
        ixt=iso_HTO
 
@@ -16596,5 +16596,5 @@
        k_ref = 1
        do kb = 1,nlev_prod
-          if (p_ref(kb) .gt. pplay(i,k)) k_ref=kb
+          IF (p_ref(kb) .gt. pplay(i,k)) k_ref=kb
        enddo
 
@@ -16602,24 +16602,24 @@
        ! Pour le moment, la production d_xt_cosmo est exprime en at/g/s
 
-       if ( k_ref .eq. 1 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 1 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 8.9433E-7
                    
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 8.9432E-7
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 8.9247E-7
                    
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 8.4992E-7
                    
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 7.655E-7
                    
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 6.9815E-7
                    
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 6.4847E-7
                    
@@ -16631,21 +16631,21 @@
        
        
-       if ( k_ref .eq. 2 ) THEN
-           if (lat_geo.ge.60.)                                  THEN
+       IF ( k_ref .EQ. 2 ) THEN
+           IF (lat_geo.ge.60.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 1.736E-6
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.171E-6
                    
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.1121E-6
                    
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 9.9709E-7
                    
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 9.0662E-7
                    
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 8.3986E-7
                    
@@ -16657,21 +16657,21 @@
        
        
-       if ( k_ref .eq. 3 ) THEN
-           if (lat_geo.ge.60.)                                  THEN
+       IF ( k_ref .EQ. 3 ) THEN
+           IF (lat_geo.ge.60.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 1.5402E-6
            
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.5365E-6
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.4552E-6
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.2989E-6
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.1775E-6
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.0879E-6
            
@@ -16683,21 +16683,21 @@
        
        
-       if ( k_ref .eq. 4 ) THEN
-           if (lat_geo.ge.60.)                                  THEN
+       IF ( k_ref .EQ. 4 ) THEN
+           IF (lat_geo.ge.60.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 2.0198E-6
            
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.0145E-6
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.9024E-6
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.6901E-6
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.5273E-6
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.4072E-6
            
@@ -16709,24 +16709,24 @@
        
        
-       if ( k_ref .eq. 5 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 5 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 2.6465E-6
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.6464E-6
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.6389E-6
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.4846E-6
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.1965E-6
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.9785E-6
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.8177E-6
            
@@ -16738,24 +16738,24 @@
        
        
-       if ( k_ref .eq. 6 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 6 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 3.4646E-6
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.4645E-6
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.454E-6
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.2415E-6
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.851E-6
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.5595E-6
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.3444E-6
            
@@ -16767,24 +16767,24 @@
        
        
-       if ( k_ref .eq. 7 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 7 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 4.5316E-6
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.5315E-6
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.5166E-6
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.2244E-6
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.6958E-6
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.3062E-6
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.0191E-6
            
@@ -16796,24 +16796,24 @@
        
        
-       if ( k_ref .eq. 8 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 8 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 5.9217E-6
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 5.9216E-6
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 5.9006E-6
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 5.499E-6
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.7842E-6
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.2644E-6
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.8815E-6
            
@@ -16825,24 +16825,24 @@
        
        
-       if ( k_ref .eq. 9 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 9 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 7.7309E-6
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 7.7307E-6
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 7.701E-6
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 7.1498E-6
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 6.1842E-6
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 5.4915E-6
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.9818E-6
            
@@ -16854,21 +16854,21 @@
        
        
-       if ( k_ref .eq. 10 ) THEN
-           if (lat_geo.ge.60.)                                  THEN
+       IF ( k_ref .EQ. 10 ) THEN
+           IF (lat_geo.ge.60.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 1.0082E-5
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.004E-5
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 9.2843E-6
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 7.9817E-6
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 7.0598E-6
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 6.3824E-6
            
@@ -16880,21 +16880,21 @@
        
        
-       if ( k_ref .eq. 11 ) THEN
-           if (lat_geo.ge.60.)                                  THEN
+       IF ( k_ref .EQ. 11 ) THEN
+           IF (lat_geo.ge.60.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 1.3135E-5
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.3076E-5
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.204E-5
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.0285E-5
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 9.0599E-6
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 8.1612E-6
            
@@ -16906,21 +16906,21 @@
        
        
-       if ( k_ref .eq. 12 ) THEN
-           if (lat_geo.ge.60.)                                  THEN
+       IF ( k_ref .EQ. 12 ) THEN
+           IF (lat_geo.ge.60.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 1.7093E-5
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.701E-5
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.5592E-5
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.3231E-5
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.1605E-5
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.0414E-5
            
@@ -16932,24 +16932,24 @@
        
        
-       if ( k_ref .eq. 13 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 13 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 2.2217E-5
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.2216E-5
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.21E-5
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.0162E-5
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.6989E-5
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.4835E-5
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.3261E-5
            
@@ -16961,24 +16961,24 @@
        
        
-       if ( k_ref .eq. 14 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 14 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 2.8816E-5
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.8815E-5
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.8652E-5
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.6002E-5
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.1746E-5
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.8898E-5
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.6822E-5
            
@@ -16990,24 +16990,24 @@
        
        
-       if ( k_ref .eq. 15 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 15 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 3.7386E-5
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.7384E-5
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.7157E-5
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.3546E-5
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.7847E-5
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.4084E-5
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.1349E-5
            
@@ -17019,24 +17019,24 @@
        
        
-       if ( k_ref .eq. 16 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 16 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 4.8393E-5
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.8392E-5
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.8073E-5
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.3156E-5
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.5536E-5
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.0578E-5
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.6983E-5
            
@@ -17048,24 +17048,24 @@
        
        
-       if ( k_ref .eq. 17 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 17 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 6.2543E-5
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 6.2541E-5
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 6.2097E-5
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 5.541E-5
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.5241E-5
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.8722E-5
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.4007E-5
            
@@ -17077,24 +17077,24 @@
        
        
-       if ( k_ref .eq. 18 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 18 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 8.0696E-5
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 8.0693E-5
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 8.0074E-5
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 7.0993E-5
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 5.7449E-5
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.8897E-5
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.273E-5
            
@@ -17106,24 +17106,24 @@
        
        
-       if ( k_ref .eq. 19 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 19 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 1.0393E-4
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.0392E-4
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.0306E-4
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 9.0753E-5
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 7.2752E-5
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 6.1561E-5
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 5.3513E-5
            
@@ -17135,21 +17135,21 @@
        
        
-       if ( k_ref .eq. 20 ) THEN
-           if (lat_geo.ge.60.)                                  THEN
+       IF ( k_ref .EQ. 20 ) THEN
+           IF (lat_geo.ge.60.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 1.3358E-4
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.3238E-4
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.1573E-4
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 9.1859E-5
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 7.7254E-5
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 6.678E-5
            
@@ -17161,24 +17161,24 @@
        
        
-       if ( k_ref .eq. 21 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 21 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 1.7134E-4
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.7133E-4
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.6968E-4
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.4718E-4
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.1561E-4
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 9.661E-5
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 8.3017E-5
            
@@ -17190,24 +17190,24 @@
        
        
-       if ( k_ref .eq. 22 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 22 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 2.1926E-4
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.1925E-4
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.1696E-4
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.8664E-4
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.45E-4
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.2036E-4
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.0277E-4
            
@@ -17219,24 +17219,24 @@
        
        
-       if ( k_ref .eq. 23 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 23 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 2.7986E-4
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.7984E-4
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.7669E-4
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.3591E-4
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.8117E-4
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.4931E-4
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.2663E-4
            
@@ -17248,24 +17248,24 @@
        
        
-       if ( k_ref .eq. 24 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 24 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 3.5619E-4
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.5617E-4
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.5183E-4
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.9712E-4
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.2536E-4
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.8436E-4
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.552E-4
            
@@ -17277,24 +17277,24 @@
        
        
-       if ( k_ref .eq. 25 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 25 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 4.5186E-4
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.5183E-4
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.4587E-4
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.7264E-4
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.7894E-4
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.2638E-4
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.8906E-4
            
@@ -17306,24 +17306,24 @@
        
        
-       if ( k_ref .eq. 26 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 26 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 5.7102E-4
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 5.7098E-4
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 5.628E-4
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.6503E-4
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.4318E-4
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.7618E-4
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.2861E-4
            
@@ -17335,24 +17335,24 @@
        
        
-       if ( k_ref .eq. 27 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 27 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 7.1820E-4
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 7.1815E-4
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 7.0693E-4
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 5.7675E-4
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.1904E-4
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.3416E-4
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.7389E-4
            
@@ -17364,24 +17364,24 @@
        
        
-       if ( k_ref .eq. 28 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 28 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 8.9801E-4
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 8.9794E-4
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 8.8255E-4
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 7.0966E-4
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 5.0671E-4
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.0001E-4
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.242E-4
            
@@ -17393,24 +17393,24 @@
        
        
-       if ( k_ref .eq. 29 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 29 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 1.1145E-3
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.1144E-3
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.0932E-3
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 8.6421E-4
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 6.0487E-4
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.7209E-4
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.7768E-4
            
@@ -17422,24 +17422,24 @@
        
        
-       if ( k_ref .eq. 30 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 30 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 1.3709E-3
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.3708E-3
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.3415E-3
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.0387E-3
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 7.1001E-4
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 5.4689E-4
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.3085E-4
            
@@ -17451,24 +17451,24 @@
        
        
-       if ( k_ref .eq. 31 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 31 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 1.6712E-3
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.671E-3
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.63E-3
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.2296E-3
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 8.1648E-4
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 6.1899E-4
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 4.787E-4
            
@@ -17480,24 +17480,24 @@
        
        
-       if ( k_ref .eq. 32 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 32 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 2.0296E-3
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.0293E-3
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.9704E-3
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.4366E-3
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 9.1906E-4
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 6.8278E-4
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 5.1594E-4
            
@@ -17509,24 +17509,24 @@
        
        
-       if ( k_ref .eq. 33 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 33 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 2.4971E-3
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.4967E-3
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 2.4078E-3
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.6751E-3
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.017E-3
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 7.3425E-4
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 5.3723E-4
            
@@ -17538,24 +17538,24 @@
        
        
-       if ( k_ref .eq. 34 ) THEN
-           if (lat_geo.ge.70.)                                  THEN
+       IF ( k_ref .EQ. 34 ) THEN
+           IF (lat_geo.ge.70.)                                  THEN
                    d_xt_cosmo(ixt,i,k) = 3.2169E-3
            
-           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) THEN
+           ELSE IF ( (lat_geo.ge.60.0) .AND. (lat_geo.lt.70.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.2161E-3
                    
-           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) THEN
+           ELSE IF ( (lat_geo.ge.50.0) .AND. (lat_geo.lt.60.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 3.0665E-3
            
-           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) THEN
+           ELSE IF ( (lat_geo.ge.40.0) .AND. (lat_geo.lt.50.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.9861E-3
            
-           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) THEN
+           ELSE IF ( (lat_geo.ge.30.0) .AND. (lat_geo.lt.40.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 1.1059E-3
            
-           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) THEN
+           ELSE IF ( (lat_geo.ge.20.0) .AND. (lat_geo.lt.30.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 7.6337E-4
            
-           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) THEN
+           ELSE IF ( (lat_geo.ge.10.0) .AND. (lat_geo.lt.20.0) ) THEN
                    d_xt_cosmo(ixt,i,k) = 5.2801E-4
            
@@ -17567,5 +17567,5 @@
        
 !#ifdef ISOVERIF
-!          if (k.eq.klev) THEN
+!          if (k.EQ.klev) THEN
 !          WRITE(*,*) 'iso_tritium 1096'
 !          WRITE(*,*) 'ixt,i,k,klev=',ixt,i,k,klev
@@ -17581,6 +17581,6 @@
 
 #ifdef ISOVERIF
-          if (iso_verif_positif_strict_nostop(d_xt_cosmo(ixt,i,k), &
-            'iso_tritium 1110 : d_xt_cosmo negatif ou pas').eq.1) THEN
+          IF (iso_verif_positif_strict_nostop(d_xt_cosmo(ixt,i,k), &
+            'iso_tritium 1110 : d_xt_cosmo negatif ou pas').EQ.1) THEN
           WRITE(*,*) 'i,k,klev=',i,k,klev
           WRITE(*,*) 'latitude_deg,latitude=',latitude_deg(i),latitude(i)
@@ -17604,6 +17604,6 @@
          d_xt_cosmo(ixt,i,k)=d_xt_cosmo(ixt,i,k)*masse_tritium*1000.
 #ifdef ISOVERIF
-         if ((iso_HTO.gt.0).and.(ixt.eq.iso_HTO)) THEN
-            if (d_xt_cosmo(ixt,i,k).eq.0) THEN
+         IF ((iso_HTO.gt.0).AND.(ixt.EQ.iso_HTO)) THEN
+            IF (d_xt_cosmo(ixt,i,k).EQ.0) THEN
                WRITE(*,*) 'prod cosmo nulle iso_tritium 1134'
                WRITE(*,*) 'ixt,i,k',ixt,i,k
@@ -17611,5 +17611,5 @@
                stop
             endif
-!            if ((k.eq.klev).and.(ixt.eq.iso_HTO)) THEN
+!            if ((k.EQ.klev).AND.(ixt.EQ.iso_HTO)) THEN
 !               WRITE(*,*) 'iso_tritium 1140'
 !               WRITE(*,*) 'ixt,i,k,klev=',ixt,i,k,klev
@@ -17629,6 +17629,6 @@
           do i=1,klon ! boucler sur toutes les points horizontaux
           do k=1,klev ! boucler sur l'échelle vertical
-            if (iso_verif_noNAN_nostop(d_xt_cosmo(ixt,i,k), &
-               'iso_tritium cosmo 1151').eq.1) THEN
+            IF (iso_verif_noNAN_nostop(d_xt_cosmo(ixt,i,k), &
+               'iso_tritium cosmo 1151').EQ.1) THEN
           WRITE(*,*) 'ixt,i,k,klev=',ixt,i,k,klev
           WRITE(*,*) 'latitude_deg,latitude=',latitude_deg(i),latitude(i)
@@ -17655,7 +17655,7 @@
 ! --------------------------------------------------------------------------------
        
-      if (ok_prod_nucl_tritium) then ! production nucleaire de tritium = true 
+      IF (ok_prod_nucl_tritium) then ! production nucleaire de tritium = true
           
-          if (iso_HTO.gt.0) then ! Tritium
+          IF (iso_HTO.gt.0) then ! Tritium
              ixt=iso_HTO 
              
@@ -17665,5 +17665,5 @@
            WRITE(*,*) 'j_1ere_bombe, nbombe', j_1ere_bombe, nbombe
  
-             if (nbombe.ge.1) then ! si c'est un jour avec un ou plusieurs essais nucleaires
+             IF (nbombe.ge.1) then ! si c'est un jour avec un ou plusieurs essais nucleaires
                  CALL lancer_bombes(nbombe, j_1ere_bombe, &
                                     zphi, &
@@ -17680,8 +17680,8 @@
       do i=1,klon ! boucler sur toutes les points horizontaux
       do k=1,klev ! boucler sur l'échelle verticle
-         if ((.not.ok_prod_nucl_tritium).or. &
-             (iso_HTO.eq.0).or.(ixt.ne.iso_HTO).or. &
-            (nbombe.eq.0)) THEN
-            if (d_xt_prod_nucl(ixt,i,k).ne.0.) THEN
+         IF ((.NOT.ok_prod_nucl_tritium).OR. &
+             (iso_HTO.EQ.0).OR.(ixt.NE.iso_HTO).OR. &
+            (nbombe.EQ.0)) THEN
+            IF (d_xt_prod_nucl(ixt,i,k).NE.0.) THEN
             WRITE(*,*) 'iso_tritium 1208 apres d_xt_prod_nucl'
             WRITE(*,*) 'la prod nucleaire d isotopes devrait etre nulle'
@@ -17700,6 +17700,6 @@
           do i=1,klon ! boucler sur toutes les points horizontaux
           do k=1,klev ! boucler sur l'échelle verticae
-            if (iso_verif_noNAN_nostop(d_xt_prod_nucl(ixt,i,k), &
-               'iso_tritium prod nucl 1225').eq.1) THEN
+            IF (iso_verif_noNAN_nostop(d_xt_prod_nucl(ixt,i,k), &
+               'iso_tritium prod nucl 1225').EQ.1) THEN
           WRITE(*,*) 'ixt,i,k,latitude_deg(i)',ixt,i,k,latitude_deg(i)
           stop
@@ -17720,5 +17720,5 @@
 ! ------------------------------------------------------------------------
 #ifdef ISOTRAC
-        if (iso_HTO.gt.0) THEN
+        IF (iso_HTO.gt.0) THEN
         WRITE(*,*) 'cas pas prevu, a coder'
         ! utiliser index_iso au lieu de ixt dans la condition ci dessous
@@ -17728,5 +17728,5 @@
 #endif
         do ixt=1,ntraciso ! boucler sur tous les isotopes
-           if ((iso_HTO.gt.0).and.(ixt.eq.iso_HTO)) then ! Tritium
+           IF ((iso_HTO.gt.0).AND.(ixt.EQ.iso_HTO)) then ! Tritium
            do i=1,klon ! boucler sur toutes les points horizontaux
            do k=1,klev ! boucler sur l'échelle verticale
@@ -17758,5 +17758,5 @@
 
 !#ifdef ISOVERIF
-!      if ((ixt.eq.iso_HTO).and.(k.ge.(klev-2))) then !ok
+!      if ((ixt.EQ.iso_HTO).AND.(k.ge.(klev-2))) then !ok
 !         WRITE(*,*) 'iso_tritium 1284 - test concentration totale'
 !         WRITE(*,*) 'ixt,i,k,klev=',ixt,i,k,klev
@@ -17815,8 +17815,8 @@
 
 !     local
-      integer iessai
-
-
-      if (ok_prod_nucl_tritium) THEN
+      INTEGER iessai
+
+
+      IF (ok_prod_nucl_tritium) THEN
       ! tableau pour day_nucl
       open(30, file='day_nucl.txt')
@@ -17930,14 +17930,14 @@
 !     &                               year_essai, j_1ere_bombe, nbombe)
 
-      use phys_cal_mod ! pour le calendrier
-      use isotopes_mod, ONLY: nessai, day_nucl, month_nucl, year_nucl
+      USE phys_cal_mod ! pour le calendrier
+      USE isotopes_mod, ONLY: nessai, day_nucl, month_nucl, year_nucl
       IMPLICIT NONE
 
       ! Arguments
-      integer nbombe,j_1ere_bombe ! pour un jour dans la simulation, on cherche le nombre de bombes nbombe de la journee et la ligne correspondant a la 1ere bombe de cette journee
+      INTEGER nbombe,j_1ere_bombe ! pour un jour dans la simulation, on cherche le nombre de bombes nbombe de la journee et la ligne correspondant a la 1ere bombe de cette journee
 !      integer day_essai(nessai),month_essai(nessai),year_essai(nessai) ! date (jour, mois, annee) des essais nucleaires
 
       ! local
-      integer j ! indices
+      INTEGER j ! indices
  
       ! initialisation
@@ -17948,15 +17948,15 @@
 
       do j=1,nessai ! il faut que le tableau d'entree soit dans l'ordre chronologique
-         if (nbombe.eq.0) THEN
-            if ((day_cur.eq.day_nucl(j)).and. &
-                (mth_cur.eq.month_nucl(j)).and. &
-                (year_cur.eq.year_nucl(j))) THEN
+         IF (nbombe.EQ.0) THEN
+            IF ((day_cur.EQ.day_nucl(j)).AND. &
+                (mth_cur.EQ.month_nucl(j)).AND. &
+                (year_cur.EQ.year_nucl(j))) THEN
             nbombe=1
             j_1ere_bombe=j
             endif
          else
-            if ((day_cur.eq.day_nucl(j)).and. &
-               (mth_cur.eq.month_nucl(j)).and. &
-               (year_cur.eq.year_nucl(j))) THEN
+            IF ((day_cur.EQ.day_nucl(j)).AND. &
+               (mth_cur.EQ.month_nucl(j)).AND. &
+               (year_cur.EQ.year_nucl(j))) THEN
                nbombe=nbombe+1
             else
@@ -17997,8 +17997,8 @@
 !     &                         prod_nucl_HTO)
 
-        use isotopes_mod, ONLY: nessai, lat_nucl, lon_nucl, &
+        USE isotopes_mod, ONLY: nessai, lat_nucl, lon_nucl, &
 &               zmin_nucl, zmax_nucl, HTO_nucl
         USE dimphy, ONLY: klon,klev
-        use lmdz_geometry, ONLY: latitude_deg,longitude_deg
+        USE lmdz_geometry, ONLY: latitude_deg,longitude_deg
 #ifdef ISOVERIF
         USE isotopes_verif_mod
@@ -18008,22 +18008,22 @@
 !     Arguments
       !integer iim, jjm
-      integer nbombe, j_1ere_bombe
+      INTEGER nbombe, j_1ere_bombe
       !integer klon, klev
       !integer ntest
-      real zphi(klon,klev)
+      REAL zphi(klon,klev)
       !real rlat(klon), rlon(klon)
-      real paprs(klon,klev+1)
+      REAL paprs(klon,klev+1)
       !real lat_nucl(ntest), lon_nucl(ntest) ! latitude et longitude des essais nucleaires
       !real zmin_nucl(ntest), zmax_nucl(ntest) ! altitudes min et max des nbombes champignons atomiques
       !real HTO_nucl(ntest) ! production de HTO en kg par les essais nucleaires
-      real prod_nucl_HTO(ntraciso,klon,klev) ! calcul de la production de tritium (kg/kg d'air) liee aux essais nucleaire de la journee --> d_xt_prod_nucl(ntraciso,klon,klev)
+      REAL prod_nucl_HTO(ntraciso,klon,klev) ! calcul de la production de tritium (kg/kg d'air) liee aux essais nucleaire de la journee --> d_xt_prod_nucl(ntraciso,klon,klev)
 
 !     local
-      integer ibombe,jessai
-      real lat_HTO, lon_HTO ! latitude et longitude de l'essai nucleaire jessai
-      real zmin_HTO, zmax_HTO ! altitudes min et max du champignon atomique jessai
-      real P_HTO ! production de HTO en kg de l'essai nucleaire jessai
-      integer coord_HTO 
-      integer kmin_HTO, kmax_HTO ! coordonnees lat, lon, zmin et zmax de l'essai nucleaire jessai
+      INTEGER ibombe,jessai
+      REAL lat_HTO, lon_HTO ! latitude et longitude de l'essai nucleaire jessai
+      REAL zmin_HTO, zmax_HTO ! altitudes min et max du champignon atomique jessai
+      REAL P_HTO ! production de HTO en kg de l'essai nucleaire jessai
+      INTEGER coord_HTO
+      INTEGER kmin_HTO, kmax_HTO ! coordonnees lat, lon, zmin et zmax de l'essai nucleaire jessai
 
       do ibombe=1,nbombe
@@ -18049,5 +18049,5 @@
                                   kmin_HTO,kmax_HTO)
             
-         if (coord_HTO.gt.0) then ! quand on trouve les coordonnees de l'essai nucleaire dans la simulation
+         IF (coord_HTO.gt.0) then ! quand on trouve les coordonnees de l'essai nucleaire dans la simulation
        WRITE(*,*) 'iso_tritium 1552 dans SUBROUTINE lancer_bombes'
        WRITE(*,*) 'Apres CALL coord_prod_nucl_HTO pour coord_HTO>0'
@@ -18077,5 +18077,5 @@
                                      kmin_jessai,kmax_jessai)
         USE dimphy, ONLY: klon,klev
-        use lmdz_geometry, ONLY: latitude_deg,longitude_deg
+        USE lmdz_geometry, ONLY: latitude_deg,longitude_deg
         USE lmdz_yomcst
 #ifdef ISOVERIF
@@ -18089,14 +18089,14 @@
       !integer klon, klev ! indices grilles horizontales et verticales
       !integer iim, jjm ! nombre de mailles en longitude et latitude 
-      real zphi(klon,klev) ! input-R-geopotentiel de chaque couche (reference ocean, en m2/s2)
+      REAL zphi(klon,klev) ! input-R-geopotentiel de chaque couche (reference ocean, en m2/s2)
       !real rlat(klon), rlon(klon) ! latitude et longitude en degres
-      real lat_jessai, lon_jessai ! latitude et longitude de l'essai nucleaire jessai
-      real zmin_jessai, zmax_jessai ! altitudes min et max du champignon atomique jessai
-      integer coord_jessai, kmin_jessai, kmax_jessai ! coordonnees lat, lon, zmin et zmax en sortie de la SUBROUTINE de l'essai nucleaire jessai
+      REAL lat_jessai, lon_jessai ! latitude et longitude de l'essai nucleaire jessai
+      REAL zmin_jessai, zmax_jessai ! altitudes min et max du champignon atomique jessai
+      INTEGER coord_jessai, kmin_jessai, kmax_jessai ! coordonnees lat, lon, zmin et zmax en sortie de la SUBROUTINE de l'essai nucleaire jessai
 
 !     local
-      integer i,k ! pour le boucles
-      real dlat, dlon ! pas en latitude et longitude
-      real alt(klon,klev) ! altitude a chaque niveau
+      INTEGER i,k ! pour le boucles
+      REAL dlat, dlon ! pas en latitude et longitude
+      REAL alt(klon,klev) ! altitude a chaque niveau
 
 !     initialisation
@@ -18127,10 +18127,10 @@
         ! ajout Camille Risi 14 aout 2017: calcul local de dlat et dlon en cas
         ! de grille zoomée
-        if (i.gt.1) THEN
+        IF (i.gt.1) THEN
           dlon=longitude_deg(i)-longitude_deg(i-1)
         else
           dlon=longitude_deg(i+1)-longitude_deg(i)
         endif        
-        if (i.gt.iim) THEN
+        IF (i.gt.iim) THEN
           dlat=latitude_deg(i)-latitude_deg(i-iim)
         else
@@ -18143,20 +18143,20 @@
         CALL iso_verif_positif(20.0-dlat,'iso_routines 18504d')
 #endif
-         if (((latitude_deg(i)-dlat/2.).le.lat_jessai).and. &
-             ((latitude_deg(i)+dlat/2.).gt.lat_jessai).and. &
-             ((longitude_deg(i)-dlon/2.).le.lon_jessai).and. &
+         IF (((latitude_deg(i)-dlat/2.).le.lat_jessai).AND. &
+             ((latitude_deg(i)+dlat/2.).gt.lat_jessai).AND. &
+             ((longitude_deg(i)-dlon/2.).le.lon_jessai).AND. &
              ((longitude_deg(i)+dlon/2.).gt.lon_jessai)) THEN
                 coord_jessai=i
-                if (alt(i,1).ge.zmin_jessai)    kmin_jessai = 1 ! si base du champignon est plus bas que le niveau 1 dans le modele
-                if (alt(i,1).ge.zmax_jessai)    kmax_jessai = 2 ! si le haut du champignon est plus bas que le niveau 1 du modele
-                if (alt(i,klev).lt.zmin_jessai) kmin_jessai = klev  ! si base du champignon est plus haut que le niveau klev dans le modele
-                if (alt(i,klev).lt.zmax_jessai) kmax_jessai = klev ! si le haut du champignon est plus haut que le niveau klev du modele
+                IF (alt(i,1).ge.zmin_jessai)    kmin_jessai = 1 ! si base du champignon est plus bas que le niveau 1 dans le modele
+                IF (alt(i,1).ge.zmax_jessai)    kmax_jessai = 2 ! si le haut du champignon est plus bas que le niveau 1 du modele
+                IF (alt(i,klev).lt.zmin_jessai) kmin_jessai = klev  ! si base du champignon est plus haut que le niveau klev dans le modele
+                IF (alt(i,klev).lt.zmax_jessai) kmax_jessai = klev ! si le haut du champignon est plus haut que le niveau klev du modele
                 do k=1,klev-1
-                    if ((alt(i,k).lt.zmin_jessai).and. &
+                    IF ((alt(i,k).lt.zmin_jessai).AND. &
                         (alt(i,k+1).ge.zmin_jessai)) THEN
                          kmin_jessai = max(1,k) ! si base du champignon est entre le niveau k et k+1
                     endif
 
-                    if ((alt(i,k).lt.zmax_jessai).and. &
+                    IF ((alt(i,k).lt.zmax_jessai).AND. &
                         (alt(i,k+1).ge.zmax_jessai)) THEN
                          kmax_jessai = min(k+1,klev) ! si le haut du champignon est entre le niveau k et k+1
@@ -18168,5 +18168,5 @@
 
 #ifdef ISOVERIF
-      if (kmin_jessai.gt.kmax_jessai) then ! on plante si kmin>=kmax pour k<klev
+      IF (kmin_jessai.gt.kmax_jessai) then ! on plante si kmin>=kmax pour k<klev
          WRITE(*,*) 'Pb SUBROUTINE coord_prod_nucl_HTO(kmin>kmax)'
          WRITE(*,*) 'coord_jessai', coord_jessai
@@ -18177,5 +18177,5 @@
        endif
 
-      if ((kmin_jessai.eq.klev).and.(kmax_jessai.ne.klev)) then ! on plante si on n'a pas kmax=klev quand kmin=klev
+      IF ((kmin_jessai.EQ.klev).AND.(kmax_jessai.NE.klev)) then ! on plante si on n'a pas kmax=klev quand kmin=klev
          WRITE(*,*) 'Pb SUBROUTINE coord_prod_nucl_HTO(kmin=klev)'
          WRITE(*,*) 'coord_jessai', coord_jessai
@@ -18218,6 +18218,6 @@
                                       prod_nucl)
         USE isotopes_mod, ONLY: iso_HTO
-        use lmdz_geometry, ONLY: cell_area
-        use dimphy, ONLY: klon,klev
+        USE lmdz_geometry, ONLY: cell_area
+        USE dimphy, ONLY: klon,klev
         USE lmdz_yomcst
 #ifdef ISOVERIF
@@ -18227,16 +18227,16 @@
 
 !     Arguments
-      real P_jessai ! production de HTO en kg par l'essai nucleaire jessai
-      integer coord_jessai ! indice de coordonnee lat(coord_jessai) et lon(coord_jessai) de l'essai nucleaire jessai
-      integer kmin_jessai, kmax_jessai ! indice de hauteur (ou pression) min et max du champignon atomique jessai
+      REAL P_jessai ! production de HTO en kg par l'essai nucleaire jessai
+      INTEGER coord_jessai ! indice de coordonnee lat(coord_jessai) et lon(coord_jessai) de l'essai nucleaire jessai
+      INTEGER kmin_jessai, kmax_jessai ! indice de hauteur (ou pression) min et max du champignon atomique jessai
       !integer klon, klev
-      real paprs(klon,klev+1)  ! input-R-pression pour chaque inter-couche (en Pa) 
+      REAL paprs(klon,klev+1)  ! input-R-pression pour chaque inter-couche (en Pa)
       !real airephy(klon) ! aire d'une grille (m2)
-      real prod_nucl(ntraciso,klon,klev) ! calcul de la production de HTO en kg par kg d'air sur la journee entre zmin et zmax --> d_xt_prod_nucl
+      REAL prod_nucl(ntraciso,klon,klev) ! calcul de la production de HTO en kg par kg d'air sur la journee entre zmin et zmax --> d_xt_prod_nucl
 
 !     local
-      integer ixt,i,j,k ! pour les boucles
-      real day_sec ! 1 jour en secondes
-      real prod_nucl_tmp(klon,klev) ! calcul de la production de HTO en kg/kg d'air pour l'essai nucleaire jessai
+      INTEGER ixt,i,j,k ! pour les boucles
+      REAL day_sec ! 1 jour en secondes
+      REAL prod_nucl_tmp(klon,klev) ! calcul de la production de HTO en kg/kg d'air pour l'essai nucleaire jessai
 
       day_sec = 86400.
@@ -18254,5 +18254,5 @@
 !#endif
 
-      if (kmin_jessai.lt.klev) then ! si kmin < klev, normalement kmin < kmax
+      IF (kmin_jessai.lt.klev) then ! si kmin < klev, normalement kmin < kmax
          do k=kmin_jessai,kmax_jessai
               prod_nucl_tmp(j,k) =  &
@@ -18262,5 +18262,5 @@
               prod_nucl(ixt,j,k)=prod_nucl(ixt,j,k)+prod_nucl_tmp(j,k)
 #ifdef ISOVERIF
-       if (kmin_jessai.ge.kmax_jessai) THEN
+       IF (kmin_jessai.ge.kmax_jessai) THEN
        WRITE(*,*) 'Pb SUBROUTINE calcul_prod_nucl_HTO(k<klev)'
        WRITE(*,*) 'kmin_HTO devrait etre plus petit que kmax_HTO'
@@ -18271,5 +18271,5 @@
        endif
 
-       if ((prod_nucl_tmp(j,k).le.0.).or. &
+       IF ((prod_nucl_tmp(j,k).le.0.).OR. &
             (prod_nucl(ixt,j,k).le.0.)) THEN
        WRITE(*,*) 'Pb SUBROUTINE calcul_prod_nucl_HTO(k<klev)'
@@ -18296,6 +18296,6 @@
               prod_nucl(ixt,j,k)=prod_nucl(ixt,j,k)+prod_nucl_tmp(j,k)
 #ifdef ISOVERIF
-       if ((kmin_jessai.ne.kmax_jessai).and. &
-           (kmin_jessai.ne.klev)) THEN
+       IF ((kmin_jessai.NE.kmax_jessai).AND. &
+           (kmin_jessai.NE.klev)) THEN
        WRITE(*,*) 'Pb SUBROUTINE calcul_prod_nucl_HTO(k=klev)'
        WRITE(*,*) 'kmin_HTO et kmax_HTO devraient etre egaux a klev'
@@ -18306,5 +18306,5 @@
        endif
 
-       if ((prod_nucl_tmp(j,k).le.0.).or. &
+       IF ((prod_nucl_tmp(j,k).le.0.).OR. &
            (prod_nucl(ixt,j,k).le.0.)) THEN
        WRITE(*,*) 'Pb SUBROUTINE calcul_prod_nucl_HTO(k=klev)'
@@ -18364,5 +18364,5 @@
 &       bidouille_anti_divergence,ridicule
 !    USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectiso
-    use isotrac_mod, ONLY: index_iso, index_zone,option_traceurs,izone_cond
+    USE isotrac_mod, ONLY: index_iso, index_zone,option_traceurs,izone_cond
 #ifdef ISOVERIF
     USE isotopes_verif_mod
@@ -18376,13 +18376,13 @@
         ! déclarations
         ! **inputs
-        real xt(ntraciso),qt,cond,tcond,zfice ! tcond en K        
+        REAL xt(ntraciso),qt,cond,tcond,zfice ! tcond en K
         ! **outputs
-        real zxtice(ntraciso),zxtliq(ntraciso)
+        REAL zxtice(ntraciso),zxtliq(ntraciso)
         ! **locals
-        integer ixt
-        real zcond
-        integer ieau,izone,iiso
-        real zcondtrac,qttrac
-        real xttrac(ntraciso),zxtliqtrac(ntraciso), &
+        INTEGER ixt
+        REAL zcond
+        INTEGER ieau,izone,iiso
+        REAL zcondtrac,qttrac
+        REAL xttrac(ntraciso),zxtliqtrac(ntraciso), &
                  zxticetrac(ntraciso)
         ! normallement, niso en dimension suffirait, mais serait pas
@@ -18391,6 +18391,6 @@
 
         ! verif que qt n'est pas nul
-        if (qt.eq.0) THEN
-            if (cond.lt.ridicule) THEN
+        IF (qt.EQ.0) THEN
+            IF (cond.lt.ridicule) THEN
               do ixt=1,ntraciso  
                 zxtliq(ixt)=0
@@ -18405,5 +18405,5 @@
                 stop
             endif
-        endif !if (qt.eq.0) THEN
+        endif !if (qt.EQ.0) THEN
         zcond=max(0.0,min(cond,qt))
 
@@ -18432,8 +18432,8 @@
           enddo
 #ifdef ISOVERIF  
-        if (iso_HDO.gt.0) THEN
-              if (zcondtrac.gt.ridicule) THEN
-                  if (iso_verif_aberrant_nostop(zxtice(iso_HDO)/cond &
-                   /faccond,'condiso_trac 79').eq.1) THEN
+        IF (iso_HDO.gt.0) THEN
+              IF (zcondtrac.gt.ridicule) THEN
+                  IF (iso_verif_aberrant_nostop(zxtice(iso_HDO)/cond &
+                   /faccond,'condiso_trac 79').EQ.1) THEN
                   WRITE(*,*) 'izone=',izone
                   WRITE(*,*) 'zcondtrac/qttrac=',cond/qt
@@ -18441,5 +18441,5 @@
                                  deltaD(xttrac(iso_HDO)/qttrac)
                   WRITE(*,*) 'tcond=',tcond-273,'°C'
-                  if (tcond-273.gt.-40.0) THEN
+                  IF (tcond-273.gt.-40.0) THEN
                       ! au dessus de -40, il y a de quoi s'inquiéter
                       ! en dessous, on ne sait pas ce que valent les alphas
@@ -18464,16 +18464,16 @@
 #endif
 
-        if (option_traceurs.eq.17) THEN
+        IF (option_traceurs.EQ.17) THEN
            ! colorier le condensat en un tag spécifique
            do ixt=1,ntraciso
-             if (index_zone(ixt).eq.izone_cond) THEN
+             IF (index_zone(ixt).EQ.izone_cond) THEN
                 zxtliq(ixt)=zxtliq(index_iso(ixt))
                 zxtice(ixt)=zxtice(index_iso(ixt))
-             else !if (index_zone(ixt).eq.izone_cond) THEN
+             else !if (index_zone(ixt).EQ.izone_cond) THEN
                 zxtliq(ixt)=0.0
                 zxtice(ixt)=0.0
-             endif !if (index_zone(ixt).eq.izone_cond) THEN
+             endif !if (index_zone(ixt).EQ.izone_cond) THEN
            enddo !do ixt=1,ntraciso      
-        endif !if (option_traceurs.eq.17) THEN
+        endif !if (option_traceurs.EQ.17) THEN
 #ifdef ISOVERIF
         CALL iso_verif_traceur(zxtliq(1), &
@@ -18493,5 +18493,5 @@
 &       ridicule
 !    USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall
-    use isotrac_mod, ONLY: index_iso, index_zone,option_traceurs,izone_cond, &
+    USE isotrac_mod, ONLY: index_iso, index_zone,option_traceurs,izone_cond, &
 &        ridicule_trac
 #ifdef ISOVERIF
@@ -18506,11 +18506,11 @@
         ! déclarations
         ! **inputs
-        integer n
-        real xt(ntraciso,n),qt(n),cond(n),tcond(n),zfice(n) ! tcond en K        
+        INTEGER n
+        REAL xt(ntraciso,n),qt(n),cond(n),tcond(n),zfice(n) ! tcond en K
         ! **outputs
-        real zxtice(ntraciso,n),zxtliq(ntraciso,n)
+        REAL zxtice(ntraciso,n),zxtliq(ntraciso,n)
         ! **locals
-        integer ixt, i ! compteurs
-        real zcond(n)
+        INTEGER ixt, i ! compteurs
+        REAL zcond(n)
 !#ifdef ISOVERIF
 !        integer iso_verif_aberrant_nostop ! debugage
@@ -18518,7 +18518,7 @@
 !        real deltaD
 !#endif 
-        integer izone,ieau,iiso
-        real zcondtrac(n),qttrac(n)
-        real xttrac(ntraciso,n),zxtliqtrac(ntraciso,n), &
+        INTEGER izone,ieau,iiso
+        REAL zcondtrac(n),qttrac(n)
+        REAL xttrac(ntraciso,n),zxtliqtrac(ntraciso,n), &
                  zxticetrac(ntraciso,n)
         ! normallement, niso en dimension suffirait, mais serait pas
@@ -18531,5 +18531,5 @@
 !        ! verif qt pas nul
 !        do i=1,n
-!          if (qt(i).eq.0) THEN
+!          if (qt(i).EQ.0) THEN
 !            if (cond(i).lt.ridicule) THEN
 !              do ixt=1,ntraciso  
@@ -18545,5 +18545,5 @@
 !                stop
 !            endif
-!          endif !if (qt(i).eq.0) THEN
+!          endif !if (qt(i).EQ.0) THEN
 !        enddo !do i=1,n
 
@@ -18565,13 +18565,13 @@
           do i=1,n
             qttrac(i)=xt(ieau,i)
-            if (qt(i).gt.0.0) then ! modif C Risi juillet 2020 ! remodif Camille 9 mars 2023
-!            if ((qt(i).gt.0.0).and.(xt(ieau,i).gt.0.0)) THEN
+            IF (qt(i).gt.0.0) then ! modif C Risi juillet 2020 ! remodif Camille 9 mars 2023
+!            if ((qt(i).gt.0.0).AND.(xt(ieau,i).gt.0.0)) THEN
                zcondtrac(i)=(zcond(i)/qt(i))*qttrac(i)
-            else !if (qt(i).eq.0) THEN
+            else !if (qt(i).EQ.0) THEN
 #ifdef ISOVERIF              
                 CALL iso_verif_egalite(cond(i),0.0,'condisotrac 195')
 #endif
                 zcondtrac(i)=0.0
-            endif !if (qt(i).eq.0) THEN
+            endif !if (qt(i).EQ.0) THEN
             zcondtrac(i)=min(zcondtrac(i),qttrac(i))
             do iiso=1,niso          
@@ -18579,10 +18579,10 @@
             enddo ! do iiso=1,niso
 #ifdef ISOVERIF
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(qttrac(i), &
                  xttrac(iso_eau,i),'condisotrac 148', &
                  errmax,errmaxrel)
             endif
-            if (iso_HDO.gt.0) THEN
+            IF (iso_HDO.gt.0) THEN
                 CALL iso_verif_aberrant_choix(xttrac(iso_HDO,i), &
                  qttrac(i),ridicule_trac,deltalimtrac, &
@@ -18635,20 +18635,20 @@
 
         ! inputs
-        real q ! humidité spec
-        integer ixt ! indice isotopique
-        real alpha ! coef frac à l'eq
-        real kcin ! coef frac cinétique
-        real toce ! rapport iso ds ocean surface
+        REAL q ! humidité spec
+        INTEGER ixt ! indice isotopique
+        REAL alpha ! coef frac à l'eq
+        REAL kcin ! coef frac cinétique
+        REAL toce ! rapport iso ds ocean surface
 
         ! outputs
-        real xt ! equivalent iso de l'humidité spec, même unité.
+        REAL xt ! equivalent iso de l'humidité spec, même unité.
 
         ! locals
-        real RMerlivat
-        real q0,h0 ! conditions initiales de la distill de Rayleigh
+        REAL RMerlivat
+        REAL q0,h0 ! conditions initiales de la distill de Rayleigh
         parameter (q0=20e-3,h0=0.7)
 
         ! verifier que ixt est un isotope et pas un tagging
-        if (ixt.gt.niso) THEN
+        IF (ixt.gt.niso) THEN
           CALL abort_physic('isotopes_routines_mod', 'iso_init_ideal, ixt>niso', 1)
         endif
@@ -18662,6 +18662,6 @@
 #ifdef ISOVERIF
         CALL iso_verif_noNaN(xt, 'isotopes_routines_mod 18930a: iso_init_ideal')
-        if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) THEN
-            if (q.gt.ridicule) THEN
+        IF ((iso_HDO.gt.0).AND.(ixt.EQ.iso_HDO)) THEN
+            IF (q.gt.ridicule) THEN
                     WRITE(*,*) 'xt,q=',xt,q
                     WRITE(*,*) 'alpha=',alpha
@@ -18671,5 +18671,5 @@
             endif
         endif
-        if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+        IF ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
              CALL iso_verif_egalite(xt,q, 'isotopes_routines_mod 18930c: iso_init_ideal')
         endif
@@ -18685,7 +18685,7 @@
 USE isotopes_mod, ONLY: iso_eau, iso_HDO,thumxt1, &
 &       bidouille_anti_divergence,ridicule,Rdefault
-use infotrac_phy, ONLY: ntraciso=>ntiso, niso
+USE infotrac_phy, ONLY: ntraciso=>ntiso, niso
 #ifdef ISOTRAC
-    use isotrac_mod, ONLY: option_cond,izone_cond,index_iso,index_zone,izone_poubelle
+    USE isotrac_mod, ONLY: option_cond,izone_cond,index_iso,index_zone,izone_poubelle
 #endif
 #ifdef ISOVERIF
@@ -18696,20 +18696,20 @@
 
 ! inputs
-integer nloc,na,i ! dimension horiz effective
-logical lwork(nloc)
-real wdtrain(nloc),xtwdtrain(ntraciso,nloc)
-real xt(ntraciso,nloc,na)
-real evap(nloc,na),water(nloc,na),rpprec(nloc,na),rr(nloc,na)
-integer inb(nloc)
+INTEGER nloc,na,i ! dimension horiz effective
+LOGICAL lwork(nloc)
+REAL wdtrain(nloc),xtwdtrain(ntraciso,nloc)
+REAL xt(ntraciso,nloc,na)
+REAL evap(nloc,na),water(nloc,na),rpprec(nloc,na),rr(nloc,na)
+INTEGER inb(nloc)
 
 ! outputs
-real xtevap(ntraciso,nloc,na),xtwater(ntraciso,nloc,na),xtp(ntraciso,nloc,na)
+REAL xtevap(ntraciso,nloc,na),xtwater(ntraciso,nloc,na),xtp(ntraciso,nloc,na)
 
 ! locals
-integer il,ixt
+INTEGER il,ixt
 
      do il=1,nloc
-       if (i.le.inb(il) .and. lwork(il)) THEN
-          if (wdtrain(il).gt.0.) THEN
+       IF (i.le.inb(il) .AND. lwork(il)) THEN
+          IF (wdtrain(il).gt.0.) THEN
             do ixt=1,ntraciso
              xtwater(ixt,il,i)= xtwdtrain(ixt,il)/wdtrain(il)*water(il,i)
@@ -18723,5 +18723,5 @@
 #ifdef ISOTRAC
             do ixt=1+niso,ntraciso
-             if (index_zone(ixt).eq.izone_poubelle) THEN
+             IF (index_zone(ixt).EQ.izone_poubelle) THEN
                xtwater(ixt,il,i)= Rdefault(index_iso(ixt))*water(il,i)
                xtevap(ixt,il,i)= Rdefault(index_iso(ixt))*evap(il,i)
@@ -18743,14 +18743,14 @@
 SUBROUTINE dispatch(klon,klev,qx,q_seri,xt_seri,ql_seri,xtl_seri,qs_seri,xts_seri)
 
-use infotrac_phy, ONLY: nqtot,nqo,ivap,iliq,isol,iqIsoPha,ntraciso=>ntiso
+USE infotrac_phy, ONLY: nqtot,nqo,ivap,iliq,isol,iqIsoPha,ntraciso=>ntiso
 IMPLICIT NONE
 
 ! inputs
-integer, intent(in) :: klon,klev
-real,dimension(klon,klev,nqtot), intent(in) ::qx
+INTEGER, INTENT(IN) :: klon,klev
+REAL,DIMENSION(klon,klev,nqtot), INTENT(IN) ::qx
 
 ! outputs
-real,dimension(klon,klev), intent(out) ::q_seri,ql_seri,qs_seri
-real,dimension(ntraciso,klon,klev), intent(out) :: xt_seri,xtl_seri,xts_seri
+REAL,DIMENSION(klon,klev), INTENT(OUT) ::q_seri,ql_seri,qs_seri
+REAL,DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: xt_seri,xtl_seri,xts_seri
 
 ! locals
@@ -18769,7 +18769,7 @@
           xt_seri(ixt,i,k)  = qx(i,k,iqIsoPha(ixt,ivap))
           xtl_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,iliq))
-          if (nqo.eq.2) THEN
+          IF (nqo.EQ.2) THEN
              xts_seri(ixt,i,k) = 0.
-          else if (nqo.eq.3) THEN
+          ELSE IF (nqo.EQ.3) THEN
              xts_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,isol))
           endif
@@ -18783,14 +18783,14 @@
 SUBROUTINE together(klon,klev,qx,q_seri,xt_seri,ql_seri,xtl_seri,qs_seri,xts_seri)
 
-use infotrac_phy, ONLY: nqtot,nqo,ivap,iliq,isol,iqIsoPha,ntraciso=>ntiso
+USE infotrac_phy, ONLY: nqtot,nqo,ivap,iliq,isol,iqIsoPha,ntraciso=>ntiso
 IMPLICIT NONE
 
 ! inputs
-integer, intent(in) :: klon,klev
-real,dimension(klon,klev), intent(in) ::q_seri,ql_seri,qs_seri
-real,dimension(ntraciso,klon,klev), intent(in) :: xt_seri,xtl_seri,xts_seri
+INTEGER, INTENT(IN) :: klon,klev
+REAL,DIMENSION(klon,klev), INTENT(IN) ::q_seri,ql_seri,qs_seri
+REAL,DIMENSION(ntraciso,klon,klev), INTENT(IN) :: xt_seri,xtl_seri,xts_seri
 
 ! inputs
-real,dimension(klon,klev,nqtot), intent(out) ::qx
+REAL,DIMENSION(klon,klev,nqtot), INTENT(OUT) ::qx
 
 ! locals
@@ -18807,5 +18807,5 @@
           qx(i,k,iqIsoPha(ixt,ivap)) = xt_seri(ixt,i,k)  
           qx(i,k,iqIsoPha(ixt,iliq)) = xtl_seri(ixt,i,k)
-          if (nqo.ge.3) THEN
+          IF (nqo.ge.3) THEN
              qx(i,k,iqIsoPha(ixt,isol)) = xts_seri(ixt,i,k)
           endif
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_verif_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_verif_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_verif_mod.F90	(revision 5117)
@@ -13,15 +13,15 @@
 
 ! variables de vérifications
-real errmax ! erreur maximale en absolu.
+REAL errmax ! erreur maximale en absolu.
 parameter (errmax=1e-8)
-real errmax_sol ! erreur maximale en absolu.
+REAL errmax_sol ! erreur maximale en absolu.
 parameter (errmax_sol=5e-7)
-      real errmaxrel ! erreur maximale en relatif autorisée
+      REAL errmaxrel ! erreur maximale en relatif autorisée
 !      parameter (errmaxrel=1e10)
       parameter (errmaxrel=1e-3)
-      real borne ! valeur maximale que n'importe quelle variable peut
+      REAL borne ! valeur maximale que n'importe quelle variable peut
                  ! atteindre, en val abs; utile pour vérif que pas NAN
       parameter (borne=1e19)
-      real, save ::  deltalim ! deltalim est le maximum de deltaD qu'on
+      REAL, save ::  deltalim ! deltalim est le maximum de deltaD qu'on
                              ! autorise dans la vapeur, au-dela, en suppose que c'est abérrant.
                              ! dans le liquide, on autorise deltalim*faccond.
@@ -31,21 +31,21 @@
        ! maintenant défini dans iso.def
 
-       real, save :: deltalimtrac ! max de deltaD dans les traceurs, défini dans iso.def
+       REAL, save :: deltalimtrac ! max de deltaD dans les traceurs, défini dans iso.def
 !$OMP THREADPRIVATE(deltalimtrac)
 
-      real, save ::  deltalim_snow ! deltalim est le maximum de deltaD qu'on
+      REAL, save ::  deltalim_snow ! deltalim est le maximum de deltaD qu'on
                              ! autorise dans la neige, au-dela, en suppose que c'est abérrant.
 !$OMP THREADPRIVATE(deltalim_snow)
 !      parameter (deltalim_snow=500.0) ! initalisé dans iso_init
 
-	real, save ::  deltaDmin
+	REAL, save ::  deltaDmin
 !$OMP THREADPRIVATE(deltaDmin)
 !	parameter (deltaDmin=-900.0)
     ! maintentant, défini dans iso.def
 
-      real, save ::  o17excess_bas,o17excess_haut ! bornes inf et sup de l'O17-excess
+      REAL, save ::  o17excess_bas,o17excess_haut ! bornes inf et sup de l'O17-excess
 !      parameter(o17excess_bas=-200.0,o17excess_haut=120)
 !$OMP THREADPRIVATE(o17excess_bas,o17excess_haut)
-      integer nlevmaxO17
+      INTEGER nlevmaxO17
 !$OMP THREADPRIVATE(nlevmaxO17)
 
@@ -54,11 +54,11 @@
 !      parameter (O17_verif=.TRUE.)
 
-	real, save ::  dexcess_min,dexcess_max
+	REAL, save ::  dexcess_min,dexcess_max
 !$OMP THREADPRIVATE(dexcess_min,dexcess_max)
 
-      real faccond  ! dans le liquide, on autorise R(deltalim)*faccond.
+      REAL faccond  ! dans le liquide, on autorise R(deltalim)*faccond.
       parameter (faccond=1.1)
       
-!      logical bidouille_anti_divergence ! si true, alors on fait un
+!      LOGICAL bidouille_anti_divergence ! si true, alors on fait un
 !                                        ! rappel régulier des xt4 vers les q pour 
 !                                        !éviter accumulation d'érreurs et  divergences
@@ -72,5 +72,5 @@
         ! cette vapeur donne des deltaDevap aberrants.
         parameter (deltaDfaible=-300)
-        real deltaDfaible_lax ! deltaD en dessous duquel la vapeur est tellement faible 
+        REAL deltaDfaible_lax ! deltaD en dessous duquel la vapeur est tellement faible
         !que on peut accepter que la remise à l'équilibre du sol avec 
         ! cette vapeur donne des deltaDevap aberrants.
@@ -93,6 +93,6 @@
 
         SUBROUTINE iso_verif_init()
-        use lmdz_ioipsl_getin_p, ONLY: getin_p
-        use isotopes_mod, ONLY: iso_O17, iso_O18, iso_HDO
+        USE lmdz_ioipsl_getin_p, ONLY: getin_p
+        USE isotopes_mod, ONLY: iso_O17, iso_O18, iso_HDO
         IMPLICIT NONE
 
@@ -114,5 +114,5 @@
 
 WRITE(*,*) 'iso_O17,iso_O18,iso_HDO=',iso_O17,iso_O18,iso_HDO
-IF ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
   CALL getin_p('O17_verif',O17_verif)
   CALL getin_p('o17excess_bas',o17excess_bas)
@@ -120,5 +120,5 @@
   CALL getin_p('nlevmaxO17',nlevmaxO17)
 END IF
-IF ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
   CALL getin_p('dexcess_min',dexcess_min)
   CALL getin_p('dexcess_max',dexcess_max)
@@ -142,5 +142,5 @@
 
         ! input:
-        real a, b
+        REAL a, b
         character*(*) err_msg ! message d''erreur à afficher
 
@@ -149,6 +149,6 @@
 
 
-        if (iso_verif_egalite_choix_nostop(a,b,err_msg, &
-                 errmax,errmaxrel).eq.1) THEN
+        IF (iso_verif_egalite_choix_nostop(a,b,err_msg, &
+                 errmax,errmaxrel).EQ.1) THEN
                 stop
         endif
@@ -171,8 +171,8 @@
 
         ! input:
-        real a, b
+        REAL a, b
         character*(*) err_msg ! message d''erreur à afficher
         !ouptut
-        integer iso_verif_egalite_nostop
+        INTEGER iso_verif_egalite_nostop
         ! local 
         !integer iso_verif_egalite_choix_nostop
@@ -196,5 +196,5 @@
 
         SUBROUTINE iso_verif_aberrant(R,err_msg)
-        use isotopes_mod, ONLY: ridicule, iso_HDO
+        USE isotopes_mod, ONLY: ridicule, iso_HDO
         IMPLICIT NONE
         ! si le rapprot iso R est plus grand que deltaDlim, on affiche message
@@ -202,5 +202,5 @@
 
         ! input:
-        real R
+        REAL R
         character*(*) err_msg ! message d''erreur à afficher
         !real deltaD
@@ -208,11 +208,11 @@
 
 
-        if (iso_verif_aberrant_choix_nostop(R,1.0,ridicule, &
-                 deltalim,err_msg).eq.1) THEN
+        IF (iso_verif_aberrant_choix_nostop(R,1.0,ridicule, &
+                 deltalim,err_msg).EQ.1) THEN
              stop
         endif 
 
 #ifdef ISOVERIF
-        if (.not.(iso_HDO.gt.0)) THEN
+        IF (.NOT.(iso_HDO.gt.0)) THEN
          WRITE(*,*) 'iso86: err_msg=',err_msg,': pourquoi verif?'
           stop
@@ -226,5 +226,5 @@
 
         SUBROUTINE iso_verif_aberrant_encadre(R,err_msg)
-        use isotopes_mod, ONLY: ridicule, iso_HDO
+        USE isotopes_mod, ONLY: ridicule, iso_HDO
         IMPLICIT NONE
         ! si le rapprot iso R est plus grand que deltaDlim, on affiche message
@@ -232,5 +232,5 @@
 
         ! input:
-        real R
+        REAL R
         character*(*) err_msg ! message d''erreur à afficher
         !real deltaD
@@ -239,6 +239,6 @@
 
 
-        if (iso_verif_aberrant_enc_choix_nostop(R,1.0,ridicule, &
-                 deltalim,err_msg).eq.1) THEN
+        IF (iso_verif_aberrant_enc_choix_nostop(R,1.0,ridicule, &
+                 deltalim,err_msg).EQ.1) THEN
              WRITE(*,*) 'deltaD=',deltaD(R)
              CALL abort_physic('isotopes_verif_mod > iso_verif_aberrant_encadre',err_msg,1)
@@ -247,5 +247,5 @@
 
 #ifdef ISOVERIF
-        if (.not.(iso_HDO.gt.0)) THEN
+        IF (.NOT.(iso_HDO.gt.0)) THEN
          WRITE(*,*) 'iso86: err_msg=',err_msg,': pourquoi verif?'
           stop
@@ -261,5 +261,5 @@
 
         SUBROUTINE iso_verif_aberrant_choix(xt,q,qmin,deltaDmax,err_msg)
-        use isotopes_mod, ONLY: iso_HDO
+        USE isotopes_mod, ONLY: iso_HDO
         IMPLICIT NONE
         ! si le rapprot iso R est plus grand que deltaDlim, on affiche message
@@ -267,5 +267,5 @@
 
         ! input:
-        real xt,q,qmin,deltaDmax
+        REAL xt,q,qmin,deltaDmax
         character*(*) err_msg ! message d''erreur à afficher
         !real deltaD
@@ -275,11 +275,11 @@
 
 
-        if (iso_verif_aberrant_choix_nostop(xt,q,qmin, &
-                 deltaDmax,err_msg).eq.1) THEN
+        IF (iso_verif_aberrant_choix_nostop(xt,q,qmin, &
+                 deltaDmax,err_msg).EQ.1) THEN
              stop
         endif
 
 #ifdef ISOVERIF
-        if (.not.(iso_HDO.gt.0)) THEN
+        IF (.NOT.(iso_HDO.gt.0)) THEN
          WRITE(*,*) 'iso122: err_msg=',err_msg,': pourquoi verif?'
           stop
@@ -295,5 +295,5 @@
 
         function iso_verif_aberrant_nostop(R,err_msg)
-        use isotopes_mod, ONLY: ridicule,iso_HDO
+        USE isotopes_mod, ONLY: ridicule,iso_HDO
         IMPLICIT NONE
         ! si le rapprot iso R est plus grand que deltaDlim, on affiche message
@@ -301,7 +301,7 @@
 
         ! input:
-        real R
-        character*(*) err_msg ! message d''erreur à afficher
-        integer iso_verif_aberrant_nostop ! output: 1 si erreur, 0 sinon
+        REAL R
+        character*(*) err_msg ! message d''erreur à afficher
+        INTEGER iso_verif_aberrant_nostop ! output: 1 si erreur, 0 sinon
         !real deltaD
 
@@ -313,5 +313,5 @@
 
 #ifdef ISOVERIF
-        if (.not.(iso_HDO.gt.0)) THEN
+        IF (.NOT.(iso_HDO.gt.0)) THEN
          WRITE(*,*) 'iso156: err_msg=',err_msg,': pourquoi verif?'
           stop
@@ -326,5 +326,5 @@
 
         function iso_verif_aberrant_enc_nostop(R,err_msg)
-        use isotopes_mod, ONLY: ridicule,iso_HDO
+        USE isotopes_mod, ONLY: ridicule,iso_HDO
         IMPLICIT NONE
         ! si le rapprot iso R est plus grand que deltaDlim, on affiche message
@@ -332,7 +332,7 @@
 
         ! input:
-        real R
-        character*(*) err_msg ! message d''erreur à afficher
-        integer iso_verif_aberrant_enc_nostop ! output: 1 si erreur, 0 sinon
+        REAL R
+        character*(*) err_msg ! message d''erreur à afficher
+        INTEGER iso_verif_aberrant_enc_nostop ! output: 1 si erreur, 0 sinon
         !real deltaD
 
@@ -345,5 +345,5 @@
 
 #ifdef ISOVERIF
-        if (.not.(iso_HDO.gt.0)) THEN
+        IF (.NOT.(iso_HDO.gt.0)) THEN
          WRITE(*,*) 'iso156: err_msg=',err_msg,': pourquoi verif?'
           stop
@@ -361,5 +361,5 @@
                   qmin,deltaDmax,err_msg)
 
-        use isotopes_mod, ONLY: iso_HDO
+        USE isotopes_mod, ONLY: iso_HDO
         IMPLICIT NONE
         ! si le rapprot iso R est plus grand que deltaDlim, on affiche message
@@ -367,8 +367,8 @@
 
         ! input:
-        real xt,q,qmin,deltaDmax
+        REAL xt,q,qmin,deltaDmax
         character*(*) err_msg ! message d''erreur à afficher
         ! output
-        integer iso_verif_aberrant_choix_nostop
+        INTEGER iso_verif_aberrant_choix_nostop
         ! locals
         !real deltaD
@@ -379,9 +379,9 @@
 
 #ifdef ISOVERIF        
-        if (iso_verif_noNaN_nostop(q,err_msg).eq.1) THEN
+        IF (iso_verif_noNaN_nostop(q,err_msg).EQ.1) THEN
             WRITE(*,*) 'q=',q
             iso_verif_aberrant_choix_nostop=1
         endif      
-        if (iso_verif_noNaN_nostop(xt,err_msg).eq.1) THEN
+        IF (iso_verif_noNaN_nostop(xt,err_msg).EQ.1) THEN
             WRITE(*,*) 'xt=',xt
             iso_verif_aberrant_choix_nostop=1
@@ -389,8 +389,8 @@
 #endif
 
-        if (q.gt.qmin) THEN
-        if ((deltaD(xt/q).gt.deltaDmax).or. &
-                (deltaD(xt/q).lt.-borne).or. &
-                (xt.lt.-borne).or. &
+        IF (q.gt.qmin) THEN
+        IF ((deltaD(xt/q).gt.deltaDmax).OR. &
+                (deltaD(xt/q).lt.-borne).OR. &
+                (xt.lt.-borne).OR. &
                 (xt.gt.borne)) THEN
             WRITE(*,*) 'erreur detectee par '// &
@@ -400,5 +400,5 @@
             WRITE(*,*) 'deltaDmax=',deltaDmax
             iso_verif_aberrant_choix_nostop=1
-            if (abs(xt-q)/q.lt.errmax) THEN
+            IF (abs(xt-q)/q.lt.errmax) THEN
                 WRITE(*,*) 'attention, n''a-t-on pas confondu'// &
                  ' iso_HDO et iso_eau dans l''appel à la verif?'
@@ -408,5 +408,5 @@
 
 #ifdef ISOVERIF
-        if (.not.(iso_HDO.gt.0)) THEN
+        IF (.NOT.(iso_HDO.gt.0)) THEN
          WRITE(*,*) 'iso205: err_msg=',err_msg,': pourquoi verif?'
           stop
@@ -422,5 +422,5 @@
         function iso_verif_aberrant_enc_choix_nostop(xt,q,   &
                   qmin,deltaDmax,err_msg)
-        use isotopes_mod, ONLY: iso_HDO
+        USE isotopes_mod, ONLY: iso_HDO
         IMPLICIT NONE
         ! si le rapprot iso R est plus grand que deltaDlim, on affiche message
@@ -428,14 +428,14 @@
 
         ! input:
-        real xt,q,qmin,deltaDmax
+        REAL xt,q,qmin,deltaDmax
         character*(*) err_msg ! message d''erreur à afficher
         ! output
-        integer iso_verif_aberrant_enc_choix_nostop
+        INTEGER iso_verif_aberrant_enc_choix_nostop
         ! locals
         !real deltaD
 
         iso_verif_aberrant_enc_choix_nostop=0
-        if (q.gt.qmin) THEN
-        if ((deltaD(xt/q).gt.deltaDmax).or. &
+        IF (q.gt.qmin) THEN
+        IF ((deltaD(xt/q).gt.deltaDmax).OR. &
                 (deltaD(xt/q).lt.deltaDmin)) THEN
             WRITE(*,*) 'erreur detectee par '// &
@@ -444,5 +444,5 @@
             WRITE(*,*) 'q,deltaD=',q,deltaD(xt/q)
             iso_verif_aberrant_enc_choix_nostop=1
-            if (abs(xt-q)/q.lt.errmax) THEN
+            IF (abs(xt-q)/q.lt.errmax) THEN
                 WRITE(*,*) 'attention, n''a-t-on pas confondu'// &
                  ' iso_HDO et iso_eau dans l''appel à la verif?'
@@ -452,5 +452,5 @@
 
 #ifdef ISOVERIF
-        if (.not.(iso_HDO.gt.0)) THEN
+        IF (.NOT.(iso_HDO.gt.0)) THEN
          WRITE(*,*) 'iso205: err_msg=',err_msg,': pourquoi verif?'
           stop
@@ -472,5 +472,5 @@
 
         ! input:
-        real R17,R18
+        REAL R17,R18
         character*(*) err_msg ! message d''erreur à afficher
         !real o17excess
@@ -480,7 +480,7 @@
 
 !        WRITE(*,*) 'O17_verif=',O17_verif
-        if (O17_verif) THEN
-            if (iso_verif_aberrant_o17_nostop(R17,R18,err_msg) &
-                 .eq.1) THEN
+        IF (O17_verif) THEN
+            IF (iso_verif_aberrant_o17_nostop(R17,R18,err_msg) &
+                 .EQ.1) THEN
                 stop
             endif
@@ -504,14 +504,14 @@
 
         ! input:
-        real R17,R18
+        REAL R17,R18
         character*(*) err_msg ! message d''erreur à afficher
         !local
         !real o17excess
         ! output
-        integer iso_verif_aberrant_o17_nostop
-
-        if (O17_verif) THEN
+        INTEGER iso_verif_aberrant_o17_nostop
+
+        IF (O17_verif) THEN
         iso_verif_aberrant_o17_nostop=0
-        if ((o17excess(R17,R18).gt.o17excess_haut).or. &
+        IF ((o17excess(R17,R18).gt.o17excess_haut).OR. &
                   (o17excess(R17,R18).lt.o17excess_bas)) THEN
             WRITE(*,*) 'erreur detectee par iso_verif_aberrant_O17:'
@@ -543,5 +543,5 @@
 
         ! input:
-        real x
+        REAL x
         character*(*) err_msg ! message d''erreur à afficher
 
@@ -549,5 +549,5 @@
         !integer iso_verif_noNAN_nostop
 
-        if (iso_verif_noNAN_nostop(x,err_msg).eq.1) THEN
+        IF (iso_verif_noNAN_nostop(x,err_msg).EQ.1) THEN
             stop
         endif
@@ -568,11 +568,11 @@
 
         ! input:
-        real x
+        REAL x
         character*(*) err_msg ! message d''erreur à afficher
 
         ! output 
-        integer iso_verif_noNAN_nostop
-
-        if ((x.gt.-borne).and.(x.lt.borne)) THEN
+        INTEGER iso_verif_noNAN_nostop
+
+        IF ((x.gt.-borne).AND.(x.lt.borne)) THEN
                 iso_verif_noNAN_nostop=0
         else
@@ -598,6 +598,6 @@
 
         ! input:
-          integer n,m,ni
-        real x(ni,n,m)
+          INTEGER n,m,ni
+        REAL x(ni,n,m)
         character*(*) err_msg ! message d''erreur à afficher
 
@@ -605,17 +605,17 @@
 
         ! locals        
-        integer i,j,ixt
+        INTEGER i,j,ixt
 
       do i=1,n
        do j=1,m
         do ixt=1,ni
-         if ((x(ixt,i,j).gt.-borne).and. &
+         IF ((x(ixt,i,j).gt.-borne).AND. &
                   (x(ixt,i,j).lt.borne)) THEN
-         else !if ((x(ixt,i,j).gt.-borne).and.
+         else !if ((x(ixt,i,j).gt.-borne).AND.
             WRITE(*,*) 'erreur detectee par iso_verif_nonNAN:'
             WRITE(*,*) err_msg
             WRITE(*,*) 'x,ixt,i,j=',x(ixt,i,j),ixt,i,j
             stop
-         endif  !if ((x(ixt,i,j).gt.-borne).and.
+         endif  !if ((x(ixt,i,j).gt.-borne).AND.
         enddo !do ixt=1,ni
        enddo !do j=1,m
@@ -637,6 +637,6 @@
 
         ! input:
-          integer n,ni
-        real x(ni,n)
+          INTEGER n,ni
+        REAL x(ni,n)
         character*(*) err_msg ! message d''erreur à afficher
 
@@ -644,16 +644,16 @@
 
         ! locals        
-        integer i,ixt
+        INTEGER i,ixt
 
       do i=1,n
         do ixt=1,ni
-         if ((x(ixt,i).gt.-borne).and. &
+         IF ((x(ixt,i).gt.-borne).AND. &
                   (x(ixt,i).lt.borne)) THEN
-         else !if ((x(ixt,i,j).gt.-borne).and.
+         else !if ((x(ixt,i,j).gt.-borne).AND.
             WRITE(*,*) 'erreur detectee par iso_verif_nonNAN:'
             WRITE(*,*) err_msg
             WRITE(*,*) 'x,ixt,i=',x(ixt,i),ixt,i
             stop
-         endif  !if ((x(ixt,i,j).gt.-borne).and.
+         endif  !if ((x(ixt,i,j).gt.-borne).AND.
         enddo !do ixt=1,ni
       enddo !do i=1,n     
@@ -677,6 +677,6 @@
 
         ! input:
-        real a, b
-        real erabs,errel !erreur absolue et relative
+        REAL a, b
+        REAL erabs,errel !erreur absolue et relative
         character*(*) err_msg ! message d''erreur à afficher
 
@@ -684,6 +684,6 @@
         !integer iso_verif_egalite_choix_nostop
 
-        if (iso_verif_egalite_choix_nostop( &
-                  a,b,err_msg,erabs,errel).eq.1) THEN
+        IF (iso_verif_egalite_choix_nostop( &
+                  a,b,err_msg,erabs,errel).EQ.1) THEN
            stop
         endif
@@ -706,10 +706,10 @@
 
         ! input:
-        real a, b
-        real erabs,errel !erreur absolue et relative
+        REAL a, b
+        REAL erabs,errel !erreur absolue et relative
         character*(*) err_msg ! message d''erreur à afficher
 
         ! output
-        integer iso_verif_egalite_choix_nostop
+        INTEGER iso_verif_egalite_choix_nostop
         ! locals
         !integer iso_verif_noNaN_nostop
@@ -718,9 +718,9 @@
 
 #ifdef ISOVERIF
-        if (iso_verif_noNaN_nostop(a,err_msg).eq.1) THEN
+        IF (iso_verif_noNaN_nostop(a,err_msg).EQ.1) THEN
             WRITE(*,*) 'a=',a
             iso_verif_egalite_choix_nostop=1
         endif      
-        if (iso_verif_noNaN_nostop(b,err_msg).eq.1) THEN
+        IF (iso_verif_noNaN_nostop(b,err_msg).EQ.1) THEN
             WRITE(*,*) 'b=',b
             iso_verif_egalite_choix_nostop=1
@@ -728,6 +728,6 @@
 #endif
 
-        if (abs(a-b).gt.erabs) THEN
-          if (abs((a-b)/max(max(abs(b),abs(a)),1e-18)) &
+        IF (abs(a-b).gt.erabs) THEN
+          IF (abs((a-b)/max(max(abs(b),abs(a)),1e-18)) &
                   .gt.errel) THEN
             WRITE(*,*) 'erreur detectee par iso_verif_egalite:'
@@ -754,5 +754,5 @@
         !******************
         SUBROUTINE iso_verif_positif(x,err_msg)
-        use isotopes_mod, ONLY: ridicule
+        USE isotopes_mod, ONLY: ridicule
         IMPLICIT NONE
         ! si x<0, on plante.
@@ -760,5 +760,5 @@
 
         ! input:
-        real x
+        REAL x
         character*(*) err_msg ! message d''erreur à afficher
 
@@ -766,6 +766,6 @@
         !integer iso_verif_positif_choix_nostop
 
-        if (iso_verif_positif_choix_nostop(x,ridicule,err_msg) &
-                 .eq.1) THEN
+        IF (iso_verif_positif_choix_nostop(x,ridicule,err_msg) &
+                 .EQ.1) THEN
            stop
         endif
@@ -782,26 +782,26 @@
         !******************
         SUBROUTINE iso_verif_positif_vect(x,n,err_msg)
-        use isotopes_mod, ONLY: ridicule
+        USE isotopes_mod, ONLY: ridicule
         IMPLICIT NONE
         ! si x<0, on plante.
 
         ! input:
-        integer n
-        real x(n)
-        character*(*) err_msg ! message d''erreur à afficher
-
-        ! locals
-        integer i
-        integer iso_verif_positif_nostop
-        integer ifaux
+        INTEGER n
+        REAL x(n)
+        character*(*) err_msg ! message d''erreur à afficher
+
+        ! locals
+        INTEGER i
+        INTEGER iso_verif_positif_nostop
+        INTEGER ifaux
 
         iso_verif_positif_nostop=0
         do i=1,n
-          if (x(i).lt.-ridicule) THEN
+          IF (x(i).lt.-ridicule) THEN
             iso_verif_positif_nostop=1
             ifaux=i
           endif
         enddo 
-        if (iso_verif_positif_nostop.eq.1) THEN
+        IF (iso_verif_positif_nostop.EQ.1) THEN
           WRITE(*,*) 'erreur detectee par iso_verif_positif_vect:'
           WRITE(*,*) err_msg
@@ -817,21 +817,21 @@
 
         ! input:
-        integer n
-        real x(n)
-        real ridic
+        INTEGER n
+        REAL x(n)
+        REAL ridic
         character*(*) err_msg ! message d''erreur à afficher
         ! locals 
-        integer i
-        integer iso_verif_positif_nostop
-        integer ifaux
+        INTEGER i
+        INTEGER iso_verif_positif_nostop
+        INTEGER ifaux
 
         iso_verif_positif_nostop=0
         do i=1,n
-          if (x(i).lt.-ridic) THEN
+          IF (x(i).lt.-ridic) THEN
                 iso_verif_positif_nostop=1
                 ifaux=i
           endif
         enddo 
-        if (iso_verif_positif_nostop.eq.1) THEN
+        IF (iso_verif_positif_nostop.EQ.1) THEN
          WRITE(*,*) 'erreur detectee par iso_verif_positif_choix_vect:'
          WRITE(*,*) err_msg
@@ -850,5 +850,5 @@
 
         ! input:
-        real x
+        REAL x
         character*(*) err_msg ! message d''erreur à afficher
 
@@ -856,6 +856,6 @@
         !integer iso_verif_positif_strict_nostop
 
-        if (iso_verif_positif_strict_nostop(x,err_msg) &
-                 .eq.1) THEN
+        IF (iso_verif_positif_strict_nostop(x,err_msg) &
+                 .EQ.1) THEN
            stop
         endif            
@@ -871,11 +871,11 @@
 
         ! input:
-        real x
+        REAL x
         character*(*) err_msg ! message d''erreur à afficher*
 
         ! output
-        integer iso_verif_positif_strict_nostop
-
-        if (x.gt.0.0) THEN
+        INTEGER iso_verif_positif_strict_nostop
+
+        IF (x.gt.0.0) THEN
             iso_verif_positif_strict_nostop=0
         else     
@@ -898,6 +898,6 @@
 
         ! input:
-        real x
-        real ridic
+        REAL x
+        REAL ridic
         character*(*) err_msg ! message d''erreur à afficher
 
@@ -905,6 +905,6 @@
         !integer iso_verif_positif_choix_nostop
 
-        if (iso_verif_positif_choix_nostop(x,ridic,err_msg) &
-                 .eq.1) THEN
+        IF (iso_verif_positif_choix_nostop(x,ridic,err_msg) &
+                 .EQ.1) THEN
            stop
         endif
@@ -921,5 +921,5 @@
         !******************
         function iso_verif_positif_nostop(x,err_msg)
-        use isotopes_mod, ONLY: ridicule
+        USE isotopes_mod, ONLY: ridicule
         IMPLICIT NONE
         ! si x<0, on plante.
@@ -927,9 +927,9 @@
 
         ! input:
-        real x
+        REAL x
         character*(*) err_msg ! message d''erreur à afficher
 
         ! output
-        integer iso_verif_positif_nostop
+        INTEGER iso_verif_positif_nostop
 
         ! locals
@@ -957,12 +957,12 @@
 
         ! input:
-        real x
-        real ridic
+        REAL x
+        REAL ridic
         character*(*) err_msg ! message d''erreur à afficher
 
         ! output
-        integer iso_verif_positif_choix_nostop
-
-        if (x.lt.-ridic) THEN
+        INTEGER iso_verif_positif_choix_nostop
+
+        IF (x.lt.-ridic) THEN
             WRITE(*,*) 'erreur detectee par iso_verif_positif_nostop:'
             WRITE(*,*) err_msg
@@ -995,5 +995,5 @@
         ! 2) dexcess dans bonne gamme
         ! input:
-        real Rd,Ro
+        REAL Rd,Ro
         character*(*) err_msg ! message d''erreur à afficher
 
@@ -1001,5 +1001,5 @@
         !integer iso_verif_O18_aberrant_nostop
 
-        if (iso_verif_O18_aberrant_nostop(Rd,Ro,err_msg).eq.1) THEN
+        IF (iso_verif_O18_aberrant_nostop(Rd,Ro,err_msg).EQ.1) THEN
             stop
         endif
@@ -1016,12 +1016,12 @@
 
         ! input:
-        real Rd,Ro
+        REAL Rd,Ro
         character*(*) err_msg ! message d''erreur à afficher
 
         ! outputs
-        integer iso_verif_O18_aberrant_nostop
+        INTEGER iso_verif_O18_aberrant_nostop
 
         !locals
-        real deltaD,deltao,dexcess
+        REAL deltaD,deltao,dexcess
 
         deltaD=(Rd/tnat(iso_hdo)-1)*1000
@@ -1030,8 +1030,8 @@
 
         iso_verif_O18_aberrant_nostop=0
-        if ((deltaD.lt.deltaDmin).or.(deltao.lt.deltaDmin/2.0).or. &
-              (deltaD.gt.deltalim).or.(deltao.gt.deltalim/8.0).or. &
-              ((deltaD.gt.-500.0).and.((dexcess.lt.dexcess_min) &
-              .or.(dexcess.gt.dexcess_max)))) THEN
+        IF ((deltaD.lt.deltaDmin).OR.(deltao.lt.deltaDmin/2.0).OR. &
+              (deltaD.gt.deltalim).OR.(deltao.gt.deltalim/8.0).OR. &
+              ((deltaD.gt.-500.0).AND.((dexcess.lt.dexcess_min) &
+              .OR.(dexcess.gt.dexcess_max)))) THEN
             WRITE(*,*) 'erreur detectee par iso_verif_O18_aberrant:'
             WRITE(*,*) err_msg
@@ -1058,8 +1058,8 @@
         USE isotopes_mod, ONLY: tnat,iso_HDO
         IMPLICIT NONE
-        real R,deltaD
-
-        
-        if (iso_HDO.gt.0) THEN
+        REAL R,deltaD
+
+        
+        IF (iso_HDO.gt.0) THEN
            deltaD=(R/tnat(iso_HDO)-1)*1000.0
         else
@@ -1074,7 +1074,7 @@
         USE isotopes_mod, ONLY: tnat,iso_O18
         IMPLICIT NONE
-        real R,deltaO
-        
-        if (iso_O18.gt.0) THEN
+        REAL R,deltaO
+        
+        IF (iso_O18.gt.0) THEN
            deltaO=(R/tnat(iso_O18)-1)*1000.0
         else
@@ -1089,7 +1089,7 @@
         USE isotopes_mod, ONLY: tnat,iso_O18,iso_HDO
         IMPLICIT NONE
-        real RD,RO,deltaD,deltaO,dexcess
-        
-        if ((iso_O18.gt.0).and.(iso_HDO.gt.0)) THEN
+        REAL RD,RO,deltaD,deltaO,dexcess
+        
+        IF ((iso_O18.gt.0).AND.(iso_HDO.gt.0)) THEN
            deltaD=(RD/tnat(iso_HDO)-1)*1000.0
            deltaO=(RO/tnat(iso_O18)-1)*1000.0
@@ -1106,6 +1106,6 @@
         USE isotopes_mod, ONLY: tnat
         IMPLICIT NONE
-        real R,delta_all
-        integer ixt 
+        REAL R,delta_all
+        INTEGER ixt
         
         delta_all=(R/tnat(ixt)-1)*1000.0
@@ -1117,6 +1117,6 @@
         USE isotopes_mod, ONLY: tnat
         IMPLICIT NONE
-        real delta,delta_to_R
-        integer ixt
+        REAL delta,delta_to_R
+        INTEGER ixt
         
         delta_to_R=(delta/1000.0+1.0)*tnat(ixt)
@@ -1128,7 +1128,7 @@
         USE isotopes_mod, ONLY: tnat,iso_O18,iso_O17
         IMPLICIT NONE
-        real R17,R18,o17excess
-        
-        if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+        REAL R17,R18,o17excess
+        
+        IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
            o17excess=1e6*(log(R17/tnat(iso_o17)) &
                  -0.528*log(R18/tnat(iso_O18)))
@@ -1150,22 +1150,22 @@
 
           ! inputs 
-          integer n,m,ni
-          real q(n,m)
-          real xt(ni,n,m)
+          INTEGER n,m,ni
+          REAL q(n,m)
+          REAL xt(ni,n,m)
           character*(*) err_msg
 
         ! locals
-        integer iso_verif_egalite_nostop_loc
-        integer i,j,ixt
-        integer ifaux,jfaux
+        INTEGER iso_verif_egalite_nostop_loc
+        INTEGER i,j,ixt
+        INTEGER ifaux,jfaux
 
         !WRITE(*,*) 'iso_verif_egalite_vect2D 1099 tmp: q(2,1),xt(iso_eau,2,1)=',q(2,1),xt(iso_eau,2,1)
         !WRITE(*,*) 'ni,n,m=',ni,n,m,errmax,errmaxrel
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
         iso_verif_egalite_nostop_loc=0
         do i=1,n
          do j=1,m
-          if (abs(q(i,j)-xt(iso_eau,i,j)).gt.errmax) THEN
-           if (abs((q(i,j)-xt(iso_eau,i,j))/ &
+          IF (abs(q(i,j)-xt(iso_eau,i,j)).gt.errmax) THEN
+           IF (abs((q(i,j)-xt(iso_eau,i,j))/ &
                  max(max(abs(q(i,j)),abs(xt(iso_eau,i,j))),1e-18)) &
                  .gt.errmaxrel) THEN
@@ -1178,5 +1178,5 @@
         enddo !do i=1,n
 
-        if (iso_verif_egalite_nostop_loc.eq.1) THEN
+        IF (iso_verif_egalite_nostop_loc.EQ.1) THEN
           WRITE(*,*) 'erreur detectee par iso_verif_egalite_vect2D:'
           WRITE(*,*) err_msg
@@ -1201,19 +1201,19 @@
 
         ! inputs 
-        integer n,ni
-        real q(n)
-        real xt(ni,n)
+        INTEGER n,ni
+        REAL q(n)
+        REAL xt(ni,n)
         character*(*) err_msg
 
         ! locals
-        integer iso_verif_egalite_nostop_loc
-        integer i
-        integer ifaux
-
-        if (iso_eau.gt.0) THEN
+        INTEGER iso_verif_egalite_nostop_loc
+        INTEGER i
+        INTEGER ifaux
+
+        IF (iso_eau.gt.0) THEN
         iso_verif_egalite_nostop_loc=0
         do i=1,n
-          if (abs(q(i)-xt(iso_eau,i)).gt.errmax) THEN
-           if (abs((q(i)-xt(iso_eau,i))/ &
+          IF (abs(q(i)-xt(iso_eau,i)).gt.errmax) THEN
+           IF (abs((q(i)-xt(iso_eau,i))/ &
                  max(max(abs(q(i)),abs(xt(iso_eau,i))),1e-18)) &
                  .gt.errmaxrel) THEN
@@ -1224,5 +1224,5 @@
         enddo !do i=1,n
 
-        if (iso_verif_egalite_nostop_loc.eq.1) THEN
+        IF (iso_verif_egalite_nostop_loc.EQ.1) THEN
           WRITE(*,*) 'erreur detectee par iso_verif_egalite_vect2D:'
           WRITE(*,*) err_msg
@@ -1230,5 +1230,5 @@
           WRITE(*,*) 'xt,q=',xt(iso_eau,ifaux),q(ifaux)
           stop
-        endif  !if (iso_verif_egalite_nostop.eq.1) THEN
+        endif  !if (iso_verif_egalite_nostop.EQ.1) THEN
         endif !if (iso_eau.gt.0) THEN
         END SUBROUTINE  iso_verif_egalite_vect1D
@@ -1240,20 +1240,20 @@
 
           ! inputs 
-          integer n,m,ni
-          real a(n,m)
-          real b(n,m)
+          INTEGER n,m,ni
+          REAL a(n,m)
+          REAL b(n,m)
           character*(*) err_msg
-          real errmax,errmaxrel
-
-        ! locals
-        integer iso_verif_egalite_nostop_loc
-        integer i,j
-        integer ifaux,jfaux
+          REAL errmax,errmaxrel
+
+        ! locals
+        INTEGER iso_verif_egalite_nostop_loc
+        INTEGER i,j
+        INTEGER ifaux,jfaux
 
         iso_verif_egalite_nostop_loc=0
         do i=1,n
          do j=1,m
-          if (abs(a(i,j)-b(i,j)).gt.errmax) THEN
-           if (abs((a(i,j)-b(i,j))/ &
+          IF (abs(a(i,j)-b(i,j)).gt.errmax) THEN
+           IF (abs((a(i,j)-b(i,j))/ &
                  max(max(abs(a(i,j)),abs(b(i,j))),1e-18)) &
                  .gt.errmaxrel) THEN
@@ -1266,5 +1266,5 @@
         enddo !do i=1,n
 
-        if (iso_verif_egalite_nostop_loc.eq.1) THEN
+        IF (iso_verif_egalite_nostop_loc.EQ.1) THEN
           WRITE(*,*) 'erreur detectee par iso_verif_egalite_vect2D:'
           WRITE(*,*) err_msg
@@ -1279,26 +1279,26 @@
         SUBROUTINE iso_verif_aberrant_vect2D( &
                  xt,q,err_msg,ni,n,m)
-        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
+        USE isotopes_mod, ONLY: ridicule,tnat,iso_HDO
           IMPLICIT NONE
 
           ! inputs   
-          integer n,m,ni
-          real q(n,m)
-          real xt(ni,n,m)
+          INTEGER n,m,ni
+          REAL q(n,m)
+          REAL xt(ni,n,m)
           character*(*) err_msg
 
         ! locals
-        integer iso_verif_aberrant_nostop_loc
-        integer i,j
-        integer ifaux,jfaux
+        INTEGER iso_verif_aberrant_nostop_loc
+        INTEGER i,j
+        INTEGER ifaux,jfaux
         !real deltaD
 
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
         iso_verif_aberrant_nostop_loc=0
         do i=1,n
          do j=1,m
-          if (q(i,j).gt.ridicule) THEN
-            if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
-                         .gt.deltalim).or. &
+          IF (q(i,j).gt.ridicule) THEN
+            IF (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
+                         .gt.deltalim).OR. &
                 ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
                          .lt.-borne)) THEN
@@ -1311,5 +1311,5 @@
         enddo !do i=1,n
 
-        if (iso_verif_aberrant_nostop_loc.eq.1) THEN
+        IF (iso_verif_aberrant_nostop_loc.EQ.1) THEN
           WRITE(*,*) 'erreur detectee par iso_verif_aberrant_vect2D:'
           WRITE(*,*) err_msg
@@ -1326,29 +1326,29 @@
                  xt,q,err_msg,ni,n,m)
 
-        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
+        USE isotopes_mod, ONLY: ridicule,tnat,iso_HDO
           IMPLICIT NONE
 
           ! inputs   
-          integer n,m,ni
-          real q(n,m)
-          real xt(ni,n,m)
+          INTEGER n,m,ni
+          REAL q(n,m)
+          REAL xt(ni,n,m)
           character*(*) err_msg
 
         ! locals
-        integer iso_verif_aberrant_nostop_loc
-        integer i,j
-        integer ifaux,jfaux
+        INTEGER iso_verif_aberrant_nostop_loc
+        INTEGER i,j
+        INTEGER ifaux,jfaux
         !real deltaD
 
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
         iso_verif_aberrant_nostop_loc=0
         do i=1,n
          do j=1,m
-          if (q(i,j).gt.ridicule) THEN
-            if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
-                         .gt.deltalim).or. &
+          IF (q(i,j).gt.ridicule) THEN
+            IF (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
+                         .gt.deltalim).OR. &
                 ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
-                         .lt.deltaDmin).or. &
-                 (xt(iso_HDO,i,j).lt.-borne).or. &
+                         .lt.deltaDmin).OR. &
+                 (xt(iso_HDO,i,j).lt.-borne).OR. &
                  (xt(iso_HDO,i,j).gt.borne)) THEN
               iso_verif_aberrant_nostop_loc=1
@@ -1360,5 +1360,5 @@
         enddo !do i=1,n
 
-        if (iso_verif_aberrant_nostop_loc.eq.1) THEN
+        IF (iso_verif_aberrant_nostop_loc.EQ.1) THEN
           WRITE(*,*) 'erreur detectee par ', &
                  'iso_verif_aberrant_enc_vect2D:'
@@ -1378,26 +1378,26 @@
                  xt,q,err_msg,ni,n,m)
 
-        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
+        USE isotopes_mod, ONLY: ridicule,tnat,iso_HDO
           IMPLICIT NONE
 
           ! inputs   
-          integer n,m,ni
-          real q(n,m)
-          real xt(ni,n,m)
+          INTEGER n,m,ni
+          REAL q(n,m)
+          REAL xt(ni,n,m)
           character*(*) err_msg
 
         ! locals
-        integer iso_verif_aberrant_nostop_loc
-        integer i,j
-        integer ifaux,jfaux
+        INTEGER iso_verif_aberrant_nostop_loc
+        INTEGER i,j
+        INTEGER ifaux,jfaux
         !real deltaD
 
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
         iso_verif_aberrant_nostop_loc=0
         do i=1,n
          do j=1,m
-          if (q(i,j).gt.ridicule) THEN
-            if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
-                         .gt.deltalim).or. &
+          IF (q(i,j).gt.ridicule) THEN
+            IF (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
+                         .gt.deltalim).OR. &
                 ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
                          .lt.deltaDmin)) THEN
@@ -1410,5 +1410,5 @@
         enddo !do i=1,n
 
-        if (iso_verif_aberrant_nostop_loc.eq.1) THEN
+        IF (iso_verif_aberrant_nostop_loc.EQ.1) THEN
           WRITE(*,*) 'erreur detectee par ', &
                  'iso_verif_aberrant_vect2D_ns:'
@@ -1427,28 +1427,28 @@
                  xt,q,err_msg,ni,n,m,deltaDmax)
 
-        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
+        USE isotopes_mod, ONLY: ridicule,tnat,iso_HDO
           IMPLICIT NONE
 
 
           ! inputs   
-          integer n,m,ni
-          real q(n,m)
-          real xt(ni,n,m)
+          INTEGER n,m,ni
+          REAL q(n,m)
+          REAL xt(ni,n,m)
           character*(*) err_msg
-          real deltaDmax
-
-        ! locals
-        integer iso_verif_aberrant_nostop_loc
-        integer i,j
-        integer ifaux,jfaux
+          REAL deltaDmax
+
+        ! locals
+        INTEGER iso_verif_aberrant_nostop_loc
+        INTEGER i,j
+        INTEGER ifaux,jfaux
         !real deltaD
 
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
         iso_verif_aberrant_nostop_loc=0
         do i=1,n
          do j=1,m
-          if (q(i,j).gt.ridicule) THEN
-            if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
-                         .gt.deltaDmax).or. &
+          IF (q(i,j).gt.ridicule) THEN
+            IF (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
+                         .gt.deltaDmax).OR. &
                 ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
                          .lt.-borne)) THEN
@@ -1461,5 +1461,5 @@
         enddo !do i=1,n
 
-        if (iso_verif_aberrant_nostop_loc.eq.1) THEN
+        IF (iso_verif_aberrant_nostop_loc.EQ.1) THEN
           WRITE(*,*) 'erreur detectee par iso_verif_aberrant_vect2D:'
           WRITE(*,*) err_msg
@@ -1476,31 +1476,31 @@
                  xt,q,err_msg,ni,n,m)
 
-        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO,iso_O18
+        USE isotopes_mod, ONLY: ridicule,tnat,iso_HDO,iso_O18
           IMPLICIT NONE
 
           ! inputs   
-          integer n,m,ni
-          real q(n,m)
-          real xt(ni,n,m)
+          INTEGER n,m,ni
+          REAL q(n,m)
+          REAL xt(ni,n,m)
           character*(*) err_msg
 
         ! locals
-        integer iso_verif_aberrant_nostop_loc
-        integer i,j
-        integer ifaux,jfaux
-        real deltaDloc,deltaoloc,dexcessloc
-
-        if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+        INTEGER iso_verif_aberrant_nostop_loc
+        INTEGER i,j
+        INTEGER ifaux,jfaux
+        REAL deltaDloc,deltaoloc,dexcessloc
+
+        IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
         iso_verif_aberrant_nostop_loc=0
         do i=1,n
          do j=1,m
-          if (q(i,j).gt.ridicule) THEN
+          IF (q(i,j).gt.ridicule) THEN
             deltaDloc=(xt(iso_HDO,i,j)/q(i,j)/tnat(iso_hdo)-1)*1000
             deltaoloc=(xt(iso_O18,i,j)/q(i,j)/tnat(iso_O18)-1)*1000
             dexcessloc=deltaDloc-8*deltaoloc
-            if ((deltaDloc.lt.deltaDmin).or.(deltaoloc.lt.deltaDmin/2.0).or. &
-              (deltaDloc.gt.deltalim).or.(deltaoloc.gt.deltalim/8.0).or. &
-              ((deltaDloc.gt.-500.0).and.((dexcessloc.lt.dexcess_min) &
-              .or.(dexcessloc.gt.dexcess_max)))) THEN
+            IF ((deltaDloc.lt.deltaDmin).OR.(deltaoloc.lt.deltaDmin/2.0).OR. &
+              (deltaDloc.gt.deltalim).OR.(deltaoloc.gt.deltalim/8.0).OR. &
+              ((deltaDloc.gt.-500.0).AND.((dexcessloc.lt.dexcess_min) &
+              .OR.(dexcessloc.gt.dexcess_max)))) THEN
               iso_verif_aberrant_nostop_loc=1
               ifaux=i
@@ -1512,5 +1512,5 @@
         enddo !do i=1,n
 
-        if (iso_verif_aberrant_nostop_loc.eq.1) THEN
+        IF (iso_verif_aberrant_nostop_loc.EQ.1) THEN
           WRITE(*,*) 'erreur detectee par ', &
                  'iso_verif_aberrant_enc_vect2D:'
@@ -1530,11 +1530,11 @@
 
         ! inputs
-        integer n1,n2,n3,n4
-        real var(n1,n2,n3,n4)
-        integer i1,i4
+        INTEGER n1,n2,n3,n4
+        REAL var(n1,n2,n3,n4)
+        INTEGER i1,i4
         ! outputs
-        real vec(n2,n3)
-        ! locals
-        integer i2,i3
+        REAL vec(n2,n3)
+        ! locals
+        INTEGER i2,i3
 
         do i2=1,n2
@@ -1553,11 +1553,11 @@
 
         ! inputs
-        integer ntime,nlev,nlat,nlon
-        real var(ntime,nlev,nlat,nlon)
-        integer itime,ilev,ilat
+        INTEGER ntime,nlev,nlat,nlon
+        REAL var(ntime,nlev,nlat,nlon)
+        INTEGER itime,ilev,ilat
         ! outputs
-        real vec(nlon)
-        ! locals
-        integer ilon
+        REAL vec(nlon)
+        ! locals
+        INTEGER ilon
 
         do ilon=1,nlon
@@ -1573,11 +1573,11 @@
 
         ! inputs
-        integer n1,n2,n3,n4,n5
-        real var(n1,n2,n3,n4,n5)
-        integer i1,i2,i3,i4
+        INTEGER n1,n2,n3,n4,n5
+        REAL var(n1,n2,n3,n4,n5)
+        INTEGER i1,i2,i3,i4
         ! outputs
-        real vec(n5)
-        ! locals
-        integer i5
+        REAL vec(n5)
+        ! locals
+        INTEGER i5
 
         do i5=1,n5
@@ -1593,11 +1593,11 @@
 
         ! inputs
-        integer ntime,nlat,nlon
-        real var(ntime,nlat,nlon)
-        integer itime,ilat
+        INTEGER ntime,nlat,nlon
+        REAL var(ntime,nlat,nlon)
+        INTEGER itime,ilat
         ! outputs
-        real vec(nlon)
-        ! locals
-        integer ilon
+        REAL vec(nlon)
+        ! locals
+        INTEGER ilon
 
         do ilon=1,nlon
@@ -1613,11 +1613,11 @@
 
         ! inputs
-        integer n1,n2,n3
-        real var(n1,n2,n3)
-        integer i1
+        INTEGER n1,n2,n3
+        REAL var(n1,n2,n3)
+        INTEGER i1
         ! outputs
-        real vec(n2,n3)
-        ! locals
-        integer i2,i3
+        REAL vec(n2,n3)
+        ! locals
+        INTEGER i2,i3
 
         do i2=1,n2
@@ -1634,11 +1634,11 @@
 
         ! inputs
-        integer n1,n2,n3,n4
-        real vec(n2,n3)
-        integer i1,i4
+        INTEGER n1,n2,n3,n4
+        REAL vec(n2,n3)
+        INTEGER i1,i4
         ! inout
-        real var(n1,n2,n3,n4)
-        ! locals
-        integer i2,i3
+        REAL var(n1,n2,n3,n4)
+        ! locals
+        INTEGER i2,i3
 
        do i2=1,n2
@@ -1656,11 +1656,11 @@
 
         ! inputs
-        integer n1,n2,n3,n4
-        real vec(n1,n2)
-        integer i3,i4
+        INTEGER n1,n2,n3,n4
+        REAL vec(n1,n2)
+        INTEGER i3,i4
         ! inout
-        real var(n1,n2,n3,n4)
-        ! locals
-        integer i1,i2
+        REAL var(n1,n2,n3,n4)
+        ! locals
+        INTEGER i1,i2
 
        do i1=1,n1
@@ -1677,11 +1677,11 @@
 
         ! inputs
-        integer n1,n2,n3
-        real vec(n2,n3)
-        integer i1
+        INTEGER n1,n2,n3
+        REAL vec(n2,n3)
+        INTEGER i1
         ! inout
-        real var(n1,n2,n3)
-        ! locals
-        integer i2,i3
+        REAL var(n1,n2,n3)
+        ! locals
+        INTEGER i2,i3
 
        do i2=1,n2
@@ -1701,6 +1701,6 @@
 
         ! input:
-          integer n,m,ni,ib,ie
-        real x(ni,n,m)
+          INTEGER n,m,ni,ib,ie
+        REAL x(ni,n,m)
         character*(*) err_msg ! message d''erreur à afficher
 
@@ -1708,17 +1708,17 @@
 
         ! locals        
-        integer i,j,ixt
+        INTEGER i,j,ixt
 
       do i=ib,ie
        do j=1,m
         do ixt=1,ni
-         if ((x(ixt,i,j).gt.-borne).and. &
+         IF ((x(ixt,i,j).gt.-borne).AND. &
                   (x(ixt,i,j).lt.borne)) THEN
-         else !if ((x(ixt,i,j).gt.-borne).and.
+         else !if ((x(ixt,i,j).gt.-borne).AND.
             WRITE(*,*) 'erreur detectee par iso_verif_nonNAN:'
             WRITE(*,*) err_msg
             WRITE(*,*) 'x,ixt,i,j=',x(ixt,i,j),ixt,i,j
             stop
-         endif  !if ((x(ixt,i,j).gt.-borne).and.
+         endif  !if ((x(ixt,i,j).gt.-borne).AND.
         enddo !do ixt=1,ni
        enddo !do j=1,m
@@ -1738,26 +1738,26 @@
                  xt,q,err_msg,ni,n,m,ib,ie)
 
-        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
+        USE isotopes_mod, ONLY: ridicule,tnat,iso_HDO
           IMPLICIT NONE
 
           ! inputs   
-          integer n,m,ni,ib,ie
-          real q(n,m)
-          real xt(ni,n,m)
+          INTEGER n,m,ni,ib,ie
+          REAL q(n,m)
+          REAL xt(ni,n,m)
           character*(*) err_msg
 
         ! locals
-        integer iso_verif_aberrant_nostop_loc
-        integer i,j
-        integer ifaux,jfaux
+        INTEGER iso_verif_aberrant_nostop_loc
+        INTEGER i,j
+        INTEGER ifaux,jfaux
         !real deltaD
 
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
         iso_verif_aberrant_nostop_loc=0
         do i=ib,ie
          do j=1,m
-          if (q(i,j).gt.ridicule) THEN
-            if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
-                         .gt.deltalim).or. &
+          IF (q(i,j).gt.ridicule) THEN
+            IF (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
+                         .gt.deltalim).OR. &
                 ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
                          .lt.deltaDmin)) THEN
@@ -1770,5 +1770,5 @@
         enddo !do i=1,n
 
-        if (iso_verif_aberrant_nostop_loc.eq.1) THEN
+        IF (iso_verif_aberrant_nostop_loc.EQ.1) THEN
           WRITE(*,*) 'erreur detectee par iso_verif_aberrant_par2D:'
           WRITE(*,*) err_msg
@@ -1791,20 +1791,20 @@
 
           ! inputs 
-          integer n,m,ni,ib,ie
-          real q(n,m)
-          real xt(ni,n,m)
+          INTEGER n,m,ni,ib,ie
+          REAL q(n,m)
+          REAL xt(ni,n,m)
           character*(*) err_msg
 
         ! locals
-        integer iso_verif_egalite_nostop_loc
-        integer i,j
-        integer ifaux,jfaux
-
-        if (iso_eau.gt.0) THEN
+        INTEGER iso_verif_egalite_nostop_loc
+        INTEGER i,j
+        INTEGER ifaux,jfaux
+
+        IF (iso_eau.gt.0) THEN
         iso_verif_egalite_nostop_loc=0
         do i=ib,ie
          do j=1,m
-          if (abs(q(i,j)-xt(iso_eau,i,j)).gt.errmax) THEN
-           if (abs((q(i,j)-xt(iso_eau,i,j))/ &
+          IF (abs(q(i,j)-xt(iso_eau,i,j)).gt.errmax) THEN
+           IF (abs((q(i,j)-xt(iso_eau,i,j))/ &
                  max(max(abs(q(i,j)),abs(xt(iso_eau,i,j))),1e-18)) &
                  .gt.errmaxrel) THEN
@@ -1817,5 +1817,5 @@
         enddo !do i=1,n
 
-        if (iso_verif_egalite_nostop_loc.eq.1) THEN
+        IF (iso_verif_egalite_nostop_loc.EQ.1) THEN
           WRITE(*,*) 'erreur detectee par iso_verif_egalite_vect2D:'
           WRITE(*,*) err_msg
@@ -1832,5 +1832,5 @@
       function iso_verif_traceur_choix_nostop(x,err_msg, &
              errmax,errmaxrel,ridicule_trac,deltalimtrac)
-        use isotopes_mod, ONLY: iso_HDO
+        USE isotopes_mod, ONLY: iso_HDO
         IMPLICIT NONE
         ! vérifier des choses sur les traceurs
@@ -1839,10 +1839,10 @@
        
        ! inputs
-       real x(ntraciso)
+       REAL x(ntraciso)
        character*(*) err_msg ! message d''erreur à afficher
-       real errmax,errmaxrel,ridicule_trac,deltalimtrac
+       REAL errmax,errmaxrel,ridicule_trac,deltalimtrac
 
        ! output
-       integer iso_verif_traceur_choix_nostop
+       INTEGER iso_verif_traceur_choix_nostop
 
        ! locals
@@ -1855,24 +1855,24 @@
 
         ! verif noNaN
-        if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) THEN
+        IF (iso_verif_traceur_noNaN_nostop(x,err_msg).EQ.1) THEN
              iso_verif_traceur_choix_nostop=1
         endif 
         
         ! verif masse
-        if (iso_verif_tracm_choix_nostop(x,err_msg, &
-                 errmax,errmaxrel).eq.1) THEN
+        IF (iso_verif_tracm_choix_nostop(x,err_msg, &
+                 errmax,errmaxrel).EQ.1) THEN
              iso_verif_traceur_choix_nostop=1
         endif              
 
         ! verif deltaD
-        if (iso_HDO.gt.0) THEN
-        if (iso_verif_tracdD_choix_nostop(x,err_msg, &
-                 ridicule_trac,deltalimtrac).eq.1) THEN
+        IF (iso_HDO.gt.0) THEN
+        IF (iso_verif_tracdD_choix_nostop(x,err_msg, &
+                 ridicule_trac,deltalimtrac).EQ.1) THEN
              iso_verif_traceur_choix_nostop=1
         endif  
         endif !if (iso_HDO.gt.0) THEN
         ! verif pas aberramment negatif
-        if (iso_verif_tracpos_choix_nostop(x,err_msg, &
-                 1e-5).eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(x,err_msg, &
+                 1e-5).EQ.1) THEN
              iso_verif_traceur_choix_nostop=1
         endif 
@@ -1890,10 +1890,10 @@
        
        ! inputs
-       real x(ntraciso)
+       REAL x(ntraciso)
        character*(*) err_msg ! message d''erreur à afficher
-       real errmax,errmaxrel,ridicule_trac,deltalimtrac
+       REAL errmax,errmaxrel,ridicule_trac,deltalimtrac
 
        ! output
-       integer iso_verif_tracnps_choix_nostop
+       INTEGER iso_verif_tracnps_choix_nostop
 
        ! locals
@@ -1905,18 +1905,18 @@
 
         ! verif noNaN
-        if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) THEN
+        IF (iso_verif_traceur_noNaN_nostop(x,err_msg).EQ.1) THEN
              iso_verif_tracnps_choix_nostop=1
         endif 
         
         ! verif masse
-        if (iso_verif_tracm_choix_nostop(x,err_msg, &
-                 errmax,errmaxrel).eq.1) THEN
+        IF (iso_verif_tracm_choix_nostop(x,err_msg, &
+                 errmax,errmaxrel).EQ.1) THEN
              iso_verif_tracnps_choix_nostop=1
         endif              
 
         ! verif deltaD
-        if (iso_HDO.gt.0) THEN
-        if (iso_verif_tracdD_choix_nostop(x,err_msg, &
-                 ridicule_trac,deltalimtrac).eq.1) THEN
+        IF (iso_HDO.gt.0) THEN
+        IF (iso_verif_tracdD_choix_nostop(x,err_msg, &
+                 ridicule_trac,deltalimtrac).EQ.1) THEN
              iso_verif_tracnps_choix_nostop=1
         endif   
@@ -1925,18 +1925,18 @@
 
         function iso_verif_tracpos_choix_nostop(x,err_msg,seuil)
-        use isotopes_mod, ONLY: isoName
+        USE isotopes_mod, ONLY: isoName
         IMPLICIT NONE
 
         ! inputs
-       real x(ntraciso)
+       REAL x(ntraciso)
        character*(*) err_msg ! message d''erreur à afficher
-       real seuil
+       REAL seuil
 
        ! output
-       integer iso_verif_tracpos_choix_nostop
+       INTEGER iso_verif_tracpos_choix_nostop
 
        ! locals
-       integer lnblnk
-       integer iiso,ixt
+       INTEGER lnblnk
+       INTEGER iiso,ixt
        !integer iso_verif_positif_choix_nostop
 
@@ -1944,6 +1944,6 @@
 
        do ixt=niso+1,ntraciso
-          if (iso_verif_positif_choix_nostop(x(ixt),seuil,err_msg// &
-                 ', verif positif, iso'//TRIM(isoName(ixt))).eq.1) THEN
+          IF (iso_verif_positif_choix_nostop(x(ixt),seuil,err_msg// &
+                 ', verif positif, iso'//TRIM(isoName(ixt))).EQ.1) THEN
             iso_verif_tracpos_choix_nostop=1
           endif
@@ -1954,18 +1954,18 @@
 
         function iso_verif_traceur_noNaN_nostop(x,err_msg)
-        use isotopes_mod, ONLY: isoName
+        USE isotopes_mod, ONLY: isoName
         IMPLICIT NONE
 
         ! on vérifie juste que pas NaN
         ! inputs
-       real x(ntraciso)
+       REAL x(ntraciso)
        character*(*) err_msg ! message d''erreur à afficher
 
        ! output
-       integer iso_verif_traceur_noNaN_nostop
+       INTEGER iso_verif_traceur_noNaN_nostop
 
        ! locals
-       integer lnblnk
-       integer iiso,ixt
+       INTEGER lnblnk
+       INTEGER iiso,ixt
        !integer iso_verif_nonaN_nostop
 
@@ -1974,7 +1974,7 @@
         do ixt=niso+1,ntraciso
 !          WRITE(*,*) 'iso_verif_traceurs 154: iiso,ixt=',iiso,ixt
-          if (iso_verif_noNaN_nostop(x(ixt),err_msg// &
+          IF (iso_verif_noNaN_nostop(x(ixt),err_msg// &
                  ', verif trac no NaN, iso'//TRIM(isoName(ixt))) &
-                 .eq.1) THEN
+                 .EQ.1) THEN
             iso_verif_traceur_noNaN_nostop=1
           endif
@@ -1986,20 +1986,20 @@
                  errmaxin,errmaxrelin)
 
-        use isotopes_mod, ONLY: ridicule,isoName
+        USE isotopes_mod, ONLY: ridicule,isoName
         ! on vérifie juste bilan de masse
         IMPLICIT NONE
         
         ! inputs
-        real x(ntraciso)
-        character*(*) err_msg ! message d''erreur à afficher
-        real errmaxin,errmaxrelin
+        REAL x(ntraciso)
+        character*(*) err_msg ! message d''erreur à afficher
+        REAL errmaxin,errmaxrelin
 
         ! output
-        integer iso_verif_tracm_choix_nostop
+        INTEGER iso_verif_tracm_choix_nostop
 
        ! locals
        !integer iso_verif_egalite_choix_nostop
-       integer iiso,izone,ixt
-       real xtractot
+       INTEGER iiso,izone,ixt
+       REAL xtractot
 
        iso_verif_tracm_choix_nostop=0
@@ -2013,8 +2013,8 @@
           enddo
 
-          if (iso_verif_egalite_choix_nostop(xtractot,x(iiso), &
+          IF (iso_verif_egalite_choix_nostop(xtractot,x(iiso), &
               err_msg//', verif trac egalite1, iso '// &
               TRIM(isoName(iiso)), &
-              errmaxin,errmaxrelin).eq.1) THEN
+              errmaxin,errmaxrelin).EQ.1) THEN
             WRITE(*,*) 'iso_verif_traceur 202: x=',x
 !            WRITE(*,*) 'xtractot=',xtractot
@@ -2027,5 +2027,5 @@
 
           ! verif ajoutée le 19 fev 2011
-          if ((abs(xtractot).lt.ridicule**2).and. &
+          IF ((abs(xtractot).lt.ridicule**2).AND. &
                  (abs(x(iiso)).gt.ridicule)) THEN
             WRITE(*,*) err_msg,', verif masse traceurs, iso ', &
@@ -2043,31 +2043,31 @@
 
         USE isotopes_mod, ONLY: iso_eau, iso_HDO
-        use isotrac_mod, ONLY: strtrac
+        USE isotrac_mod, ONLY: strtrac
         ! on vérifie juste deltaD
         IMPLICIT NONE
                 
         ! inputs
-        real x(ntraciso)
-        character*(*) err_msg ! message d''erreur à afficher
-        real ridicule_trac,deltalimtrac
+        REAL x(ntraciso)
+        character*(*) err_msg ! message d''erreur à afficher
+        REAL ridicule_trac,deltalimtrac
 
         ! output
-        integer iso_verif_tracdD_choix_nostop        
+        INTEGER iso_verif_tracdD_choix_nostop
 
        ! locals
-       integer izone,ieau,ixt
+       INTEGER izone,ieau,ixt
        !integer iso_verif_aberrant_choix_nostop
 
         iso_verif_tracdD_choix_nostop=0
 
-        if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) THEN
+        IF ((iso_eau.gt.0).AND.(iso_HDO.gt.0)) THEN
         do izone=1,nzone
              ieau=itZonIso(izone,iso_eau)
              ixt=itZonIso(izone,iso_HDO)
 
-             if (iso_verif_aberrant_choix_nostop(x(ixt),x(ieau), &
+             IF (iso_verif_aberrant_choix_nostop(x(ixt),x(ieau), &
                  ridicule_trac,deltalimtrac,err_msg// &
                  ', verif trac no aberrant zone '//strtrac(izone)) &
-                 .eq.1) THEN
+                 .EQ.1) THEN
                iso_verif_tracdD_choix_nostop=1
              endif
@@ -2078,5 +2078,5 @@
 !             endif
         enddo !do izone=1,nzone
-       endif ! if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) THEN
+       endif ! if ((iso_eau.gt.0).AND.(iso_HDO.gt.0)) THEN
        END FUNCTION iso_verif_tracdD_choix_nostop
 
@@ -2123,5 +2123,5 @@
 
       SUBROUTINE iso_verif_traceur(x,err_msg)
-        use isotrac_mod, ONLY: ridicule_trac
+        USE isotrac_mod, ONLY: ridicule_trac
         IMPLICIT NONE
         ! vérifier des choses sur les traceurs
@@ -2133,5 +2133,5 @@
        
        ! inputs
-       real x(ntraciso)
+       REAL x(ntraciso)
        character*(*) err_msg ! message d''erreur à afficher
 
@@ -2139,7 +2139,7 @@
        !integer iso_verif_traceur_choix_nostop  
 
-        if (iso_verif_traceur_choix_nostop(x,err_msg, &
+        IF (iso_verif_traceur_choix_nostop(x,err_msg, &
              errmax,errmaxrel,ridicule_trac,deltalimtrac) &
-             .eq.1) THEN
+             .EQ.1) THEN
                 stop
         endif
@@ -2150,5 +2150,5 @@
       SUBROUTINE iso_verif_traceur_retourne3D(x,n1,n2,n3, &
                  i1,i2,i3,err_msg)
-        use isotrac_mod, ONLY: ridicule_trac
+        USE isotrac_mod, ONLY: ridicule_trac
 
         IMPLICIT NONE
@@ -2161,18 +2161,18 @@
        
        ! inputs
-       integer n1,n2,n3
-       real x(n1,n2,n3,ntraciso)
+       INTEGER n1,n2,n3
+       REAL x(n1,n2,n3,ntraciso)
        character*(*) err_msg ! message d''erreur à afficher
-       integer i1,i2,i3
+       INTEGER i1,i2,i3
 
        ! locals
        !integer iso_verif_traceur_choix_nostop  
-       real xiso(ntraciso)
+       REAL xiso(ntraciso)
 
         CALL select_dim4_from4D(n1,n2,n3,ntraciso, &
             x,xiso,i1,i2,i3)
-        if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
+        IF (iso_verif_traceur_choix_nostop(xiso,err_msg, &
              errmax,errmaxrel,ridicule_trac,deltalimtrac) &
-             .eq.1) THEN
+             .EQ.1) THEN
                 stop
         endif
@@ -2182,5 +2182,5 @@
         SUBROUTINE iso_verif_traceur_retourne4D(x,n1,n2,n3,n4, &
                  i1,i2,i3,i4,err_msg)
-        use isotrac_mod, ONLY: ridicule_trac
+        USE isotrac_mod, ONLY: ridicule_trac
 
         IMPLICIT NONE
@@ -2193,18 +2193,18 @@
        
        ! inputs
-       integer n1,n2,n3,n4
-       real x(n1,n2,n3,n4,ntraciso)
+       INTEGER n1,n2,n3,n4
+       REAL x(n1,n2,n3,n4,ntraciso)
        character*(*) err_msg ! message d''erreur à afficher
-       integer i1,i2,i3,i4
+       INTEGER i1,i2,i3,i4
 
        ! locals
        !integer iso_verif_traceur_choix_nostop  
-       real xiso(ntraciso)
+       REAL xiso(ntraciso)
 
         CALL select_dim5_from5D(n1,n2,n3,n4,ntraciso, &
             x,xiso,i1,i2,i3,i4)
-        if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
+        IF (iso_verif_traceur_choix_nostop(xiso,err_msg, &
              errmax,errmaxrel,ridicule_trac,deltalimtrac) &
-             .eq.1) THEN
+             .EQ.1) THEN
                 stop
         endif
@@ -2215,5 +2215,5 @@
       SUBROUTINE iso_verif_traceur_retourne2D(x,n1,n2, &
                  i1,i2,err_msg)
-        use isotrac_mod, ONLY: ridicule_trac
+        USE isotrac_mod, ONLY: ridicule_trac
         IMPLICIT NONE
         ! vérifier des choses sur les traceurs
@@ -2225,18 +2225,18 @@
        
        ! inputs
-       integer n1,n2
-       real x(n1,n2,ntraciso)
+       INTEGER n1,n2
+       REAL x(n1,n2,ntraciso)
        character*(*) err_msg ! message d''erreur à afficher
-       integer i1,i2
+       INTEGER i1,i2
 
        ! locals
        !integer iso_verif_traceur_choix_nostop  
-       real xiso(ntraciso)
+       REAL xiso(ntraciso)
 
         CALL select_dim3_from3D(n1,n2,ntraciso, &
             x,xiso,i1,i2)
-        if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
+        IF (iso_verif_traceur_choix_nostop(xiso,err_msg, &
              errmax,errmaxrel,ridicule_trac,deltalimtrac) &
-             .eq.1) THEN
+             .EQ.1) THEN
                 stop
         endif
@@ -2255,12 +2255,12 @@
        
        ! inputs
-       integer n,m
-       real x(ntraciso,n,m)
+       INTEGER n,m
+       REAL x(ntraciso,n,m)
        character*(*) err_msg ! message d''erreur à afficher
 
        ! locals
-       logical iso_verif_traceur_nostop
-       integer i,j,ixt,iiso,izone,ieau
-       integer ifaux,jfaux,ixtfaux
+       LOGICAL iso_verif_traceur_nostop
+       INTEGER i,j,ixt,iiso,izone,ieau
+       INTEGER ifaux,jfaux,ixtfaux
        
        CALL iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
@@ -2270,5 +2270,5 @@
 
         ! verif deltaD: iso_verif_tracdD_choix_nostop    
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
         CALL iso_verif_tracdd_vect(x,n,m,err_msg)
         endif !if (iso_HDO.gt.0) THEN
@@ -2289,12 +2289,12 @@
        
        ! inputs
-       integer n,m
-       real x(ntraciso,n,m)
+       INTEGER n,m
+       REAL x(ntraciso,n,m)
        character*(*) err_msg ! message d''erreur à afficher
 
        ! locals
-       logical iso_verif_traceur_nostop
-       integer i,j,ixt,iiso,izone,ieau
-       integer ifaux,jfaux,ixtfaux
+       LOGICAL iso_verif_traceur_nostop
+       INTEGER i,j,ixt,iiso,izone,ieau
+       INTEGER ifaux,jfaux,ixtfaux
        
        CALL iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
@@ -2304,5 +2304,5 @@
 
         ! verif deltaD: iso_verif_tracdD_choix_nostop    
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
         CALL iso_verif_tracdd_vect(x,n,m,err_msg)
         endif !if (iso_HDO.gt.0) THEN
@@ -2314,12 +2314,12 @@
        
        ! inputs
-       integer n,m
-       real x(ntraciso,n,m)
+       INTEGER n,m
+       REAL x(ntraciso,n,m)
        character*(*) err_msg ! message d''erreur à afficher
 
        ! locals
-       logical iso_verif_traceur_nostop
-       integer i,j,ixt,iiso
-       integer ifaux,jfaux,ixtfaux
+       LOGICAL iso_verif_traceur_nostop
+       INTEGER i,j,ixt,iiso
+       INTEGER ifaux,jfaux,ixtfaux
 
 
@@ -2329,10 +2329,10 @@
         do i=1,n
         do ixt=niso+1,ntraciso
-          if ((x(ixt,i,j).gt.-borne).and.(x(ixt,i,j).lt.borne)) THEN
-          else !if ((x.gt.-borne).and.(x.lt.borne)) THEN
+          IF ((x(ixt,i,j).gt.-borne).AND.(x(ixt,i,j).lt.borne)) THEN
+          else !if ((x.gt.-borne).AND.(x.lt.borne)) THEN
               iso_verif_traceur_nostop=.TRUE.
               ifaux=i
               jfaux=i
-          endif !if ((x.gt.-borne).and.(x.lt.borne)) THEN
+          endif !if ((x.gt.-borne).AND.(x.lt.borne)) THEN
         enddo !do ixt=niso+1,ntraciso
         enddo ! do i=1,n
@@ -2340,5 +2340,5 @@
         
 
-        if (iso_verif_traceur_nostop) THEN
+        IF (iso_verif_traceur_nostop) THEN
             WRITE(*,*) 'erreur detectée par iso_verif_nonNAN ', &
                  'dans iso_verif_traceur_vect'
@@ -2354,19 +2354,19 @@
         SUBROUTINE iso_verif_trac_masse_vect(x,n,m,err_msg, &
                   errmax,errmaxrel)
-        use isotopes_mod, ONLY: isoName
+        USE isotopes_mod, ONLY: isoName
         IMPLICIT NONE
        
         ! inputs
-       integer n,m
-       real x(ntraciso,n,m)
+       INTEGER n,m
+       REAL x(ntraciso,n,m)
        character*(*) err_msg ! message d''erreur à afficher
-       real errmax,errmaxrel
+       REAL errmax,errmaxrel
 
        ! locals
-       logical iso_verif_traceur_nostop
-       integer i,j,ixt,iiso,izone
-       integer ifaux,jfaux,ixtfaux
-       real xtractot(n,m)
-       real xiiso(n,m)
+       LOGICAL iso_verif_traceur_nostop
+       INTEGER i,j,ixt,iiso,izone
+       INTEGER ifaux,jfaux,ixtfaux
+       REAL xtractot(n,m)
+       REAL xiiso(n,m)
 
         do iiso=1,niso        
@@ -2393,20 +2393,20 @@
 
         SUBROUTINE iso_verif_tracdd_vect(x,n,m,err_msg)
-        use isotopes_mod, ONLY: iso_HDO,iso_eau
-        use isotrac_mod, ONLY: strtrac
+        USE isotopes_mod, ONLY: iso_HDO,iso_eau
+        USE isotrac_mod, ONLY: strtrac
         IMPLICIT NONE
        
         ! inputs
-       integer n,m
-       real x(ntraciso,n,m)
+       INTEGER n,m
+       REAL x(ntraciso,n,m)
        character*(*) err_msg ! message d''erreur à afficher
 
        ! locals
-       integer i,j,iiso,izone,ieau,ixt
-       real xiiso(niso,n,m)
-       real xeau(n,m)
-       integer lnblnk
-
-       if (iso_HDO.gt.0) THEN
+       INTEGER i,j,iiso,izone,ieau,ixt
+       REAL xiiso(niso,n,m)
+       REAL xeau(n,m)
+       INTEGER lnblnk
+
+       IF (iso_HDO.gt.0) THEN
         do izone=1,nzone
           ieau=itZonIso(izone,iso_eau)
@@ -2437,13 +2437,13 @@
 
        ! inputs
-       integer n,m
-       real x(ntraciso,n,m)
+       INTEGER n,m
+       REAL x(ntraciso,n,m)
        character*(*) err_msg ! message d''erreur à afficher
-       real seuil
+       REAL seuil
 
        ! locals
-       integer i,j,ixt
-       logical iso_verif_traceur_nostop
-       integer ifaux,jfaux,ixtfaux
+       INTEGER i,j,ixt
+       LOGICAL iso_verif_traceur_nostop
+       INTEGER ifaux,jfaux,ixtfaux
 
         iso_verif_traceur_nostop=.FALSE.
@@ -2451,5 +2451,5 @@
         do i=1,n
         do ixt=niso+1,ntraciso
-          if (x(ixt,i,j).lt.-seuil) THEN
+          IF (x(ixt,i,j).lt.-seuil) THEN
               ifaux=i
               jfaux=j
@@ -2461,5 +2461,5 @@
         enddo !do j=1,m        
 
-        if (iso_verif_traceur_nostop) THEN
+        IF (iso_verif_traceur_nostop) THEN
             WRITE(*,*) 'erreur detectée par verif positif ', &
                  'dans iso_verif_traceur_vect'
@@ -2475,5 +2475,5 @@
 
         SUBROUTINE iso_verif_tracnps(x,err_msg)
-        use isotrac_mod, ONLY: ridicule_trac
+        USE isotrac_mod, ONLY: ridicule_trac
 
         IMPLICIT NONE
@@ -2486,5 +2486,5 @@
        
        ! inputs
-       real x(ntraciso)
+       REAL x(ntraciso)
        character*(*) err_msg ! message d''erreur à afficher
 
@@ -2492,7 +2492,7 @@
        !integer iso_verif_tracnps_choix_nostop  
 
-        if (iso_verif_tracnps_choix_nostop(x,err_msg, &
+        IF (iso_verif_tracnps_choix_nostop(x,err_msg, &
              errmax,errmaxrel,ridicule_trac,deltalimtrac) &
-             .eq.1) THEN
+             .EQ.1) THEN
                 stop
         endif
@@ -2510,13 +2510,13 @@
        
        ! inputs
-       real x(ntraciso)
+       REAL x(ntraciso)
        character*(*) err_msg ! message d''erreur à afficher
-       real seuil
+       REAL seuil
 
        ! locals
        !integer iso_verif_tracpos_choix_nostop  
 
-        if (iso_verif_tracpos_choix_nostop(x,err_msg,seuil) &
-             .eq.1) THEN
+        IF (iso_verif_tracpos_choix_nostop(x,err_msg,seuil) &
+             .EQ.1) THEN
                 stop
         endif
@@ -2532,14 +2532,14 @@
        
        ! inputs
-       real x(ntraciso)
+       REAL x(ntraciso)
        character*(*) err_msg ! message d''erreur à afficher
-       real errmax,errmaxrel,ridicule_trac_loc,deltalimtrac
+       REAL errmax,errmaxrel,ridicule_trac_loc,deltalimtrac
 
        ! locals
        !integer iso_verif_traceur_choix_nostop  
 
-        if (iso_verif_traceur_choix_nostop(x,err_msg, &
+        IF (iso_verif_traceur_choix_nostop(x,err_msg, &
              errmax,errmaxrel,ridicule_trac_loc,deltalimtrac) &
-             .eq.1) THEN
+             .EQ.1) THEN
                 stop
         endif
@@ -2548,5 +2548,5 @@
 
         function iso_verif_traceur_nostop(x,err_msg)
-        use isotrac_mod, ONLY: ridicule_trac
+        USE isotrac_mod, ONLY: ridicule_trac
         !use isotopes_verif, ONLY: errmax,errmaxrel,deltalimtrac
         IMPLICIT NONE
@@ -2559,9 +2559,9 @@
        
        ! inputs
-       real x(ntraciso)
+       REAL x(ntraciso)
        character*(*) err_msg ! message d''erreur à afficher
 
        ! output
-       integer iso_verif_traceur_nostop
+       INTEGER iso_verif_traceur_nostop
 
        ! locals
@@ -2583,5 +2583,5 @@
        
        ! inputs
-       real x(ntraciso)
+       REAL x(ntraciso)
        character*(*) err_msg ! message d''erreur à afficher
 
@@ -2591,11 +2591,11 @@
 
         ! verif noNaN
-        if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) THEN
+        IF (iso_verif_traceur_noNaN_nostop(x,err_msg).EQ.1) THEN
              stop
         endif 
         
         ! verif masse
-        if (iso_verif_tracm_choix_nostop(x,err_msg, &
-                 errmax,errmaxrel).eq.1) THEN
+        IF (iso_verif_tracm_choix_nostop(x,err_msg, &
+                 errmax,errmaxrel).EQ.1) THEN
              stop
         endif    
@@ -2611,9 +2611,9 @@
        
        ! inputs
-       real x(ntraciso)
+       REAL x(ntraciso)
        character*(*) err_msg ! message d''erreur à afficher
 
        ! output
-       integer iso_verif_traceur_jm_nostop
+       INTEGER iso_verif_traceur_jm_nostop
 
        ! locals
@@ -2623,11 +2623,11 @@
         iso_verif_traceur_jm_nostop=0
 !        ! verif noNaN
-!        if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) THEN
+!        if (iso_verif_traceur_noNaN_nostop(x,err_msg).EQ.1) THEN
 !             iso_verif_traceur_jm_nostop=1
 !        endif 
         
         ! verif masse
-        if (iso_verif_tracm_choix_nostop(x,err_msg, &
-                 errmax,errmaxrel).eq.1) THEN
+        IF (iso_verif_tracm_choix_nostop(x,err_msg, &
+                 errmax,errmaxrel).EQ.1) THEN
              iso_verif_traceur_jm_nostop=1
         endif   
@@ -2637,10 +2637,10 @@
         SUBROUTINE iso_verif_tag17_q_deltaD_vect(x,n,m,err_msg)
         USE isotopes_mod, ONLY: tnat,iso_eau, ridicule,iso_HDO
-        use isotrac_mod, ONLY: option_traceurs,nzone_temp
+        USE isotrac_mod, ONLY: option_traceurs,nzone_temp
         IMPLICIT NONE
 
         ! inputs
-        integer n,m
-        real x(ntraciso,n,m)
+        INTEGER n,m
+        REAL x(ntraciso,n,m)
         character*(*) err_msg
 
@@ -2648,9 +2648,9 @@
         !integer iso_verif_positif_nostop
         !real deltaD
-        integer ieau,ixt,ieau1
-        integer i,k
-
-        if ((option_traceurs.eq.17).or. &
-                 (option_traceurs.eq.18)) THEN
+        INTEGER ieau,ixt,ieau1
+        INTEGER i,k
+
+        IF ((option_traceurs.EQ.17).OR. &
+                 (option_traceurs.EQ.18)) THEN
         ! verifier que deltaD du tag de la couche la plus haute <
         ! 200 permil, et vérifier que son q est inférieur à 
@@ -2660,6 +2660,6 @@
         do i=1,n
          do k=1,m
-           if (x(ieau,i,k).gt.ridicule) THEN
-             if ((x(ixt,i,k)/x(ieau,i,k)/tnat(iso_HDO)-1)*1000 &
+           IF (x(ieau,i,k).gt.ridicule) THEN
+             IF ((x(ixt,i,k)/x(ieau,i,k)/tnat(iso_HDO)-1)*1000 &
                   .gt.-200.0) THEN
                 WRITE(*,*) err_msg,', vect:deltaDt05 trop fort'
@@ -2669,5 +2669,5 @@
              endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
            endif !if (x(ieau).gt.ridicule) THEN
-           if (x(ieau,i,k).gt.2.0e-3) THEN
+           IF (x(ieau,i,k).gt.2.0e-3) THEN
                 WRITE(*,*) err_msg,', vect:qt05 trop fort'
                 WRITE(*,*) 'i,k=',i,k
@@ -2675,6 +2675,6 @@
                 stop
            endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
-           if (x(iso_eau,i,k).lt.2.0e-3) THEN
-                if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) THEN
+           IF (x(iso_eau,i,k).lt.2.0e-3) THEN
+                IF (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) THEN
                    WRITE(*,*) err_msg,', vect: qt01 trop abondant'
                    WRITE(*,*) 'i,k=',i,k
@@ -2689,5 +2689,5 @@
         enddo !do i=1,n
 
-        endif !if (option_traceurs.eq.17) THEN
+        endif !if (option_traceurs.EQ.17) THEN
         END SUBROUTINE  iso_verif_tag17_q_deltaD_vect
 
@@ -2695,10 +2695,10 @@
         SUBROUTINE iso_verif_tag17_q_deltaD_vect_ret3D(x,n,m,nq,err_msg)
         USE isotopes_mod, ONLY: tnat,iso_eau,iso_HDO,ridicule
-        use isotrac_mod, ONLY: option_traceurs,nzone_temp
+        USE isotrac_mod, ONLY: option_traceurs,nzone_temp
         IMPLICIT NONE
 
         ! inputs
-        integer n,m,nq
-        real x(n,m,nq,ntraciso)
+        INTEGER n,m,nq
+        REAL x(n,m,nq,ntraciso)
         character*(*) err_msg
 
@@ -2706,9 +2706,9 @@
         !integer iso_verif_positif_nostop
         !real deltaD
-        integer ieau,ixt,ieau1
-        integer i,k,iq
-
-        if ((option_traceurs.eq.17).or. &
-                 (option_traceurs.eq.18)) THEN
+        INTEGER ieau,ixt,ieau1
+        INTEGER i,k,iq
+
+        IF ((option_traceurs.EQ.17).OR. &
+                 (option_traceurs.EQ.18)) THEN
         ! verifier que deltaD du tag de la couche la plus haute <
         ! 200 permil, et vérifier que son q est inférieur à 
@@ -2719,6 +2719,6 @@
         do i=1,n
          do k=1,m
-           if (x(i,k,iq,ieau).gt.ridicule) THEN
-             if ((x(i,k,iq,ixt)/x(i,k,iq,ieau)/tnat(iso_HDO)-1)*1000 &
+           IF (x(i,k,iq,ieau).gt.ridicule) THEN
+             IF ((x(i,k,iq,ixt)/x(i,k,iq,ieau)/tnat(iso_HDO)-1)*1000 &
                   .gt.-200.0) THEN
                 WRITE(*,*) err_msg,', vect:deltaDt05 trop fort'
@@ -2728,5 +2728,5 @@
              endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
            endif !if (x(ieau).gt.ridicule) THEN
-           if (x(i,k,iq,ieau).gt.2.0e-3) THEN
+           IF (x(i,k,iq,ieau).gt.2.0e-3) THEN
                 WRITE(*,*) err_msg,', vect:qt05 trop fort'
                 WRITE(*,*) 'i,k=',i,k
@@ -2734,6 +2734,6 @@
                 stop
            endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
-           if (x(i,k,iq,iso_eau).lt.2.0e-3) THEN
-                if (x(i,k,iq,ieau1)/x(i,k,iq,iso_eau).gt.0.1) THEN
+           IF (x(i,k,iq,iso_eau).lt.2.0e-3) THEN
+                IF (x(i,k,iq,ieau1)/x(i,k,iq,iso_eau).gt.0.1) THEN
                    WRITE(*,*) err_msg,', vect: qt01 trop abondant'
                    WRITE(*,*) 'i,k=',i,k
@@ -2749,14 +2749,14 @@
         enddo ! do iq=1,nq
 
-        endif !if (option_traceurs.eq.17) THEN
+        endif !if (option_traceurs.EQ.17) THEN
         END SUBROUTINE  iso_verif_tag17_q_deltaD_vect_ret3D
 
 
 #endif
-! endif ISOTRAC
+! END IF ISOTRAC
 
 END MODULE isotopes_verif_mod
 
 #endif         
-! endif ISOVERIF 
-
+! END IF ISOVERIF
+
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotrac_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotrac_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotrac_mod.F90	(revision 5117)
@@ -4,5 +4,5 @@
 MODULE isotrac_mod
   USE infotrac_phy,      ONLY: niso, ntiso, nzone
-  USE readTracFiles_mod, ONLY: delPhase
+  USE lmdz_readTracFiles, ONLY: delPhase
   USE isotopes_mod,      ONLY: ridicule, get_in
 
@@ -149,5 +149,5 @@
    USE isotopes_mod, ONLY: iso_eau, ntracisoOR, initialisation_iso
    USE dimphy,       ONLY: klon, klev
-   USE  strings_mod, ONLY: int2str, strStack, strTail, strHead, strIdx, fmsg
+   USE  lmdz_strings, ONLY: int2str, strStack, strTail, strHead, strIdx, fmsg
 
    IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotrac_routines_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotrac_routines_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotrac_routines_mod.F90	(revision 5117)
@@ -27,17 +27,17 @@
 
          ! inputs
-         integer ncas,ncum
-         integer cas(ncum)
-         real xtevap_cas(niso,ncum)
-         real xtp_cas(niso,ncum)
-         real xtwater_cas(niso,ncum)
-         integer izone
+         INTEGER ncas,ncum
+         INTEGER cas(ncum)
+         REAL xtevap_cas(niso,ncum)
+         REAL xtp_cas(niso,ncum)
+         REAL xtwater_cas(niso,ncum)
+         INTEGER izone
          ! outputs
-         real xtwater(ntraciso,ncum)
-         real xtp(ntraciso,ncum)
-         real xtevap(ntraciso,ncum)
+         REAL xtwater(ntraciso,ncum)
+         REAL xtp(ntraciso,ncum)
+         REAL xtevap(ntraciso,ncum)
 
          ! locals
-         integer il,ixt,iiso,ixt_revap
+         INTEGER il,ixt,iiso,ixt_revap
 
 
@@ -78,28 +78,28 @@
 
          ! inputs
-         integer ncas,ncum
-         integer cas(ncum)
-         real xtevap_cas(niso,ncum)
-         real xtp_cas(niso,ncum)
-         real xtwater_cas(niso,ncum)
-         integer izone
-         real Eqi_stewart(ncum)
-         real xtp_avantevap_cas(niso,ncum)
-         real fac_ftmr_cas(ncum) 
-         integer liq  
-         real hdiag(ncas)      
+         INTEGER ncas,ncum
+         INTEGER cas(ncum)
+         REAL xtevap_cas(niso,ncum)
+         REAL xtp_cas(niso,ncum)
+         REAL xtwater_cas(niso,ncum)
+         INTEGER izone
+         REAL Eqi_stewart(ncum)
+         REAL xtp_avantevap_cas(niso,ncum)
+         REAL fac_ftmr_cas(ncum)
+         INTEGER liq
+         REAL hdiag(ncas)
          
          ! outputs
-         real xtwater(ntraciso,ncum)
-         real xtp(ntraciso,ncum)
-         real xtevap(ntraciso,ncum)
+         REAL xtwater(ntraciso,ncum)
+         REAL xtp(ntraciso,ncum)
+         REAL xtevap(ntraciso,ncum)
 
          ! locals
-         integer il,ixt,iiso,ixt_revap
-         real xtaddp_tag(niso,ncum)
-#ifdef ISOVERIF
-         integer ieau,iHDO
-         real Exi_cas(niso,ncum)
-         real Exi(ntraciso,ncum)
+         INTEGER il,ixt,iiso,ixt_revap
+         REAL xtaddp_tag(niso,ncum)
+#ifdef ISOVERIF
+         INTEGER ieau,iHDO
+         REAL Exi_cas(niso,ncum)
+         REAL Exi(ntraciso,ncum)
          !USE isotopes_verif, ONLY: 
 #endif         
@@ -109,16 +109,16 @@
 
          do il=1,ncas       
-          if ((option_revap.eq.1).and. &
-              ((((liq.eq.1).and. &
+          IF ((option_revap.EQ.1).AND. &
+              ((((liq.EQ.1).AND. &
               (Eqi_stewart(il)*fac_ftmr_cas(il).gt.evap_franche) &
-              .and.(hdiag(il).lt.0.99)).or. &
-              ((liq.eq.0).and. &
-              (Eqi_stewart(il)*fac_ftmr_cas(il).ge.0.0))).or. &
-              (izone.eq.izone_revap))) THEN
-!          if ((option_revap.eq.1).and.
+              .AND.(hdiag(il).lt.0.99)).OR. &
+              ((liq.EQ.0).AND. &
+              (Eqi_stewart(il)*fac_ftmr_cas(il).ge.0.0))).OR. &
+              (izone.EQ.izone_revap))) THEN
+!          if ((option_revap.EQ.1).AND.
 !     :           (((Eqi_stewart(il)*fac_ftmr_cas(il).gt.evap_franche)
-!     :           .or.((liq.eq.0).and.
-!     :           (Eqi_stewart(il)*fac_ftmr_cas(il).ge.0.0))).or.
-!     :           (izone.eq.izone_revap))) THEN
+!     :           .OR.((liq.EQ.0).AND.
+!     :           (Eqi_stewart(il)*fac_ftmr_cas(il).ge.0.0))).OR.
+!     :           (izone.EQ.izone_revap))) THEN
             ! on met la revap dans izone_revap si option_revap=1 et si:
             ! * evap glace (non fractionnante)
@@ -127,5 +127,5 @@
             ! si option_revap=1 et izone=izone_revap, on met aussi dans izone_revap
 !#ifdef ISOVERIF            
-!            if (il.eq.1) THEN
+!            if (il.EQ.1) THEN
 !            WRITE(*,*) 'compress tmp 341: revap dans izone_revap'
 !            WRITE(*,*) 'Eqi_stewart(il),fac_ftmr_cas(il),evap_franche=',
@@ -157,6 +157,6 @@
             enddo !do iiso=1,niso
 #ifdef ISOVERIF
-            if (iso_HDO.gt.0) THEN
-                if (xtevap_cas(iso_eau,il).gt.ridicule_evap) THEN
+            IF (iso_HDO.gt.0) THEN
+                IF (xtevap_cas(iso_eau,il).gt.ridicule_evap) THEN
                     CALL iso_verif_aberrant_choix( &
                        xtevap_cas(iso_HDO,il),xtevap_cas(iso_eau,il), &
@@ -172,5 +172,5 @@
 
             ! l'évap des autres zones devient nulle
-            if (izone.ne.izone_revap) THEN
+            IF (izone.NE.izone_revap) THEN
                 do iiso=1,niso
                   ixt=index_trac(izone,iiso)
@@ -181,5 +181,5 @@
 
 !#ifdef ISOVERIF            
-!            if (il.eq.1) THEN
+!            if (il.EQ.1) THEN
 !            WRITE(*,*) 'compress tmp 341: revap dans izone_revap'
 !            WRITE(*,*) 'xtp(ixt_revap,cas(il))=',
@@ -239,13 +239,13 @@
          ! compression dans le cas condensation_facftmr
          ! inputs
-         integer nd,ncum,nloc
-         integer ncas
-         integer cas(ncum)
-         integer i
-         integer izone
+         INTEGER nd,ncum,nloc
+         INTEGER ncas
+         INTEGER cas(ncum)
+         INTEGER i
+         INTEGER izone
          real  &
           xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum), &
           water_cas(ncum),water(ncum)
-         real Eqi_prime_cas(ncum),Eqi_prime(ncum), &
+         REAL Eqi_prime_cas(ncum),Eqi_prime(ncum), &
           Pqisup_cas(ncum),Pqisup(ncum),  &
           Pxtisup_cas(niso,ncum),Pxtisup(ntraciso,ncum),  &
@@ -253,12 +253,12 @@
           xtp_avantevap_cas(niso,ncum),xtp_avantevap(ntraciso,ncum)
 #ifdef ISOVERIF      
-         real evap_cas(ncum),evap(ncum)
+         REAL evap_cas(ncum),evap(ncum)
 #endif         
          ! locals
-         integer il,ixt,ieau,iiso
+         INTEGER il,ixt,ieau,iiso
 
           ieau=index_trac(izone,iso_eau)
           do il=1,ncas
-            if (qp_avantevap(cas(il)).gt.0.0) THEN
+            IF (qp_avantevap(cas(il)).gt.0.0) THEN
                Eqi_prime_cas(il)=Eqi_prime(cas(il)) &
               *(xtp_avantevap(ieau,cas(il))/qp_avantevap(cas(il)))
@@ -272,5 +272,5 @@
             endif !if (qp_avantevap_cas(cas(il)).gt.0.0) thens
             
-            if (Pqisup(cas(il))-Eqi_prime(cas(il)).gt.0.0) THEN
+            IF (Pqisup(cas(il))-Eqi_prime(cas(il)).gt.0.0) THEN
                water_cas(il)=water(cas(il)) &
                  *((Pxtisup(ieau,cas(il))-Eqi_prime_cas(il)) &
@@ -326,14 +326,14 @@
          ! compression dans le cas condensation_facftmr
          ! inputs
-         integer nloc,nd,ncum
-         integer ncas
-         integer cas(ncum)
-         integer i
-         integer izone
+         INTEGER nloc,nd,ncum
+         INTEGER ncas
+         INTEGER cas(ncum)
+         INTEGER i
+         INTEGER izone
          real  &
           xt_cas(niso,ncum),q_cas(ncum),xt(ntraciso,ncum),q(ncum),  &
           xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum), &
           water_cas(ncum),water(ncum)
-         real Eqi_prime_cas(ncum),Eqi_prime(ncum), &
+         REAL Eqi_prime_cas(ncum),Eqi_prime(ncum), &
           Pqisup_cas(ncum),Pqisup(ncum),  &
           Pxtisup_cas(niso,ncum),Pxtisup(ntraciso,ncum), &
@@ -341,12 +341,12 @@
           xtp_avantevap_cas(niso,ncum),xtp_avantevap(ntraciso,ncum)
 #ifdef ISOVERIF
-         real evap_cas(ncum),evap(ncum)
+         REAL evap_cas(ncum),evap(ncum)
 #endif         
          ! locals
-          integer il,ixt,ieau,iiso
+          INTEGER il,ixt,ieau,iiso
 
           ieau=index_trac(izone,iso_eau)
           do il=1,ncas
-            if (qp_avantevap(cas(il)).gt.0) THEN
+            IF (qp_avantevap(cas(il)).gt.0) THEN
               Eqi_prime_cas(il)=Eqi_prime(cas(il)) &
                  *(xtp_avantevap(ieau,cas(il))/qp_avantevap(cas(il)))
@@ -356,5 +356,5 @@
             endif
             
-            if (Pqisup(cas(il))-Eqi_prime(cas(il)).gt.0.0) THEN
+            IF (Pqisup(cas(il))-Eqi_prime(cas(il)).gt.0.0) THEN
               water_cas(il)=water(cas(il)) &
                  *((Pxtisup(ieau,cas(il))-Eqi_prime_cas(il)) &
@@ -410,23 +410,23 @@
 
          ! compression dans le cas condensation_facftmr
-         integer nloc,nd,ncum
-         integer ncas
-         integer cas(ncum)
-         integer i
-         integer izone
-         real xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum), &
+         INTEGER nloc,nd,ncum
+         INTEGER ncas
+         INTEGER cas(ncum)
+         INTEGER i
+         INTEGER izone
+         REAL xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum), &
           water_cas(ncum),water(ncum)
-         real Pqisup_cas(ncum),Pqisup(ncum),  &
+         REAL Pqisup_cas(ncum),Pqisup(ncum),  &
           Pxtisup_cas(niso,ncum),Pxtisup(ntraciso,ncum),   &
           xtp_avantevap_cas(niso,ncum),xtp_avantevap(ntraciso,ncum)
 #ifdef ISOVERIF        
-        real evap_cas(ncum),evap(ncum)
+        REAL evap_cas(ncum),evap(ncum)
 #endif 
-         integer il,ixt,ieau,iiso
+         INTEGER il,ixt,ieau,iiso
 
           ieau=index_trac(izone,iso_eau)
           do il=1,ncas
             Pqisup_cas(il)=Pxtisup(ieau,cas(il))
-            if (Pqisup(cas(il)).gt.0.0) THEN
+            IF (Pqisup(cas(il)).gt.0.0) THEN
                water_cas(il)=water(cas(il)) &
                  *(Pxtisup(ieau,cas(il))/Pqisup(cas(il)))
@@ -478,22 +478,22 @@
          ! compression dans le cas condensation_facftmr
         ! inputs et outputs 
-         integer iflag_con
-         integer izone    
-         integer nloc,nd,ncum
-         integer ncas
-         integer cas(ncum)
+         INTEGER iflag_con
+         INTEGER izone
+         INTEGER nloc,nd,ncum
+         INTEGER ncas
+         INTEGER cas(ncum)
 !         integer i
-         real xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum)
-         real xtp_avantevap_cas(niso,ncum), &
+         REAL xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum)
+         REAL xtp_avantevap_cas(niso,ncum), &
                  xtp_avantevap(ntraciso,ncum)
-         real water_cas(ncum),water(ncum)
-         real xtp_avantevaptrac_cas(niso,ncum), &
+         REAL water_cas(ncum),water(ncum)
+         REAL xtp_avantevaptrac_cas(niso,ncum), &
                  qp_avantevaptrac_cas(ncum)
-         real ptrac(ncum)
+         REAL ptrac(ncum)
 !         real qp_cas(ncum)
 #ifdef ISOVERIF           
-         real evap_cas(ncum),evap(ncum)
+         REAL evap_cas(ncum),evap(ncum)
 #endif         
-         real &
+         REAL &
           Eqi_stewart(ncum),Pqiinf_stewart(ncum),Eqi_prime_cas(ncum), &
           Pqiinf(ncum),Eqi_par(ncum),Pqiinf_par(ncum), &
@@ -502,5 +502,5 @@
           Eqi(ncum),Eqi_cas(ncum)
          ! locals
-          integer il,ixt,iiso,ieau
+          INTEGER il,ixt,iiso,ieau
 
 !          WRITE(*,*) 'compress 910: xtp_avantevap(iso_eau,cas(1))=',
@@ -513,5 +513,5 @@
             Pqisup_cas(il)=Pxtisup(ieau,cas(il))
 
-            if (Pqisup(cas(il)).gt.0.0) THEN
+            IF (Pqisup(cas(il)).gt.0.0) THEN
               ptrac(il)=Pxtisup(ieau,cas(il))/Pqisup(cas(il))
               Eqi_prime_cas(il)=Eqi_prime(cas(il)) &
@@ -526,5 +526,5 @@
             endif
 
-            if (Pqisup(cas(il))-Eqi_prime(cas(il)).gt.0.0) THEN
+            IF (Pqisup(cas(il))-Eqi_prime(cas(il)).gt.0.0) THEN
                water_cas(il)=water(cas(il)) &
                  *((Pxtisup(ieau,cas(il))-Eqi_prime_cas(il)) &
@@ -570,6 +570,6 @@
       !    Eqi_prime sont les même que Eqi_par
           do il=1,ncas  
-           if (Pqisup(cas(il)).gt.0.0) THEN
-            if ((water(cas(il)).gt.ridicule/100).and. &
+           IF (Pqisup(cas(il)).gt.0.0) THEN
+            IF ((water(cas(il)).gt.ridicule/100).AND. &
                   (Pqiinf_par(cas(il)).le.0.0)) THEN
              ! on ne peut pas utiliser la méthode 1, car KE prédit de l'eau
@@ -578,13 +578,13 @@
              Pqiinf_stewart(il)=Pqiinf(cas(il))*ptrac(il)
              Eqi_stewart(il)=Eqi_par(cas(il)) *ptrac(il)
-           else !if ((water(il,i).gt.ridicule/100).and.(Pqiinf_par.le.0.0)) THEN
+           else !if ((water(il,i).gt.ridicule/100).AND.(Pqiinf_par.le.0.0)) THEN
              ! il n'y a pas d'obstacles à l'utilisation de 1)
              Pqiinf_stewart(il)=Pqiinf_par(cas(il))*ptrac(il)
-             if (iflag_con.eq.30) THEN
+             IF (iflag_con.EQ.30) THEN
                 Eqi_stewart(il)=Eqi_prime(cas(il))*ptrac(il)
              else
                 Eqi_stewart(il)=Eqi(cas(il))*ptrac(il)
              endif
-           endif !if ((water(il,i).gt.ridicule/100).and.(Pqiinf_par.le.0.0)) THEN
+           endif !if ((water(il,i).gt.ridicule/100).AND.(Pqiinf_par.le.0.0)) THEN
           else ! if (Pqisup(cas(il).gt.0.0) THEN
 #ifdef ISOVERIF
@@ -606,6 +606,6 @@
 #ifdef ISOVERIF        
         do il=1,ncas
-          if ((abs(water_cas(il)).ge.ridicule/10.) &
-                 .and.(Pqiinf_stewart(il).le.0.0)) THEN
+          IF ((abs(water_cas(il)).ge.ridicule/10.) &
+                 .AND.(Pqiinf_stewart(il).le.0.0)) THEN
               WRITE(*,*) 'compress_stewart 498: evap liq:'
               WRITE(*,*) 'water(il,i)=', water_cas(il)
@@ -643,10 +643,10 @@
 
          ! compression dans le cas condensation_facftmr
-         integer iflag_con         
-         integer nloc,nd,ncum
-         integer ncas
-         integer cas(ncum)
-         integer i
-         integer izone
+         INTEGER iflag_con
+         INTEGER nloc,nd,ncum
+         INTEGER ncas
+         INTEGER cas(ncum)
+         INTEGER i
+         INTEGER izone
          real  &
           water_cas(ncum),water(ncum), &
@@ -654,5 +654,5 @@
 !         real qp_cas(ncum)    
 #ifdef ISOVERIF           
-         real evap_cas(ncum),evap(ncum)
+         REAL evap_cas(ncum),evap(ncum)
 #endif         
          real  &
@@ -664,9 +664,9 @@
           Eqi(ncum),Eqi_cas(ncum)
 
-         real xtp_avantevaptrac_cas(niso,ncum), &
+         REAL xtp_avantevaptrac_cas(niso,ncum), &
                  qp_avantevaptrac_cas(ncum)
-          integer frac_sublim
+          INTEGER frac_sublim
           ! locals
-          integer il,ixt,ieau,iiso
+          INTEGER il,ixt,ieau,iiso
 
           ieau=index_trac(izone,iso_eau)
@@ -674,5 +674,5 @@
             Pqisup_cas(il)=Pxtisup(ieau,cas(il))  
 
-            if (Pqisup(cas(il)).gt.0.0) THEN
+            IF (Pqisup(cas(il)).gt.0.0) THEN
               Eqi_prime_cas(il)=Eqi_prime(cas(il)) &
                  *(Pxtisup(ieau,cas(il))/Pqisup(cas(il)))
@@ -689,5 +689,5 @@
             endif
 
-            if (Pqisup(cas(il))-Eqi_prime(cas(il)).gt.0.0) THEN
+            IF (Pqisup(cas(il))-Eqi_prime(cas(il)).gt.0.0) THEN
                water_cas(il)=water(cas(il)) &
                  *((Pxtisup(ieau,cas(il))-Eqi_prime_cas(il)) &
@@ -728,6 +728,6 @@
       !    Eqi_prime sont les même que Eqi_par
           do il=1,ncas  
-           if (Pqisup(cas(il)).gt.0.0) THEN
-            if ((water(cas(il)).gt.ridicule/100).and. &
+           IF (Pqisup(cas(il)).gt.0.0) THEN
+            IF ((water(cas(il)).gt.ridicule/100).AND. &
                   (Pqiinf_par(cas(il)).le.0.0)) THEN
              ! on ne peut pas utiliser la méthode 1, car KE prédit de l'eau
@@ -738,9 +738,9 @@
              Eqi_stewart(il)=Eqi_par(cas(il)) &
                 *(Pxtisup(ieau,cas(il))/Pqisup(cas(il)))
-           else !if ((water(il,i).gt.ridicule/100).and.(Pqiinf_par.le.0.0)) THEN
+           else !if ((water(il,i).gt.ridicule/100).AND.(Pqiinf_par.le.0.0)) THEN
              ! il n'y a pas d'obstacles à l'utilisation de 1)
              Pqiinf_stewart(il)=Pqiinf_par(cas(il)) &
                   *(Pxtisup(ieau,cas(il))/Pqisup(cas(il)))
-             if (iflag_con.eq.30) THEN
+             IF (iflag_con.EQ.30) THEN
                 Eqi_stewart(il)=Eqi_prime(cas(il)) &
                   *(Pxtisup(ieau,cas(il))/Pqisup(cas(il)))
@@ -749,5 +749,5 @@
                   *(Pxtisup(ieau,cas(il))/Pqisup(cas(il)))
              endif
-           endif !if ((water(il,i).gt.ridicule/100).and.(Pqiinf_par.le.0.0)) THEN
+           endif !if ((water(il,i).gt.ridicule/100).AND.(Pqiinf_par.le.0.0)) THEN
           else !if (Pqisup(cas(il).gt.0.0) THEN
 #ifdef ISOVERIF
@@ -769,6 +769,6 @@
 #ifdef ISOVERIF        
         do il=1,ncas
-          if ((abs(water_cas(il)).ge.ridicule/10.) &
-                 .and.(Pqiinf_stewart(il).le.0.0)) THEN
+          IF ((abs(water_cas(il)).ge.ridicule/10.) &
+                 .AND.(Pqiinf_stewart(il).le.0.0)) THEN
               WRITE(*,*) 'compress_stewart 498: evap glace:'
               WRITE(*,*) 'water(il,i)=', water_cas(il)
@@ -792,5 +792,5 @@
     USE isotrac_mod, ONLY: option_revap,evap_franche
 #ifdef ISOVERIF
-        use isotopes_verif_mod
+        USE isotopes_verif_mod
 #endif
 
@@ -798,22 +798,22 @@
 
         ! inputs         
-         integer ncas
-         integer cas(ncas)
-         integer klon
-         integer izone                  
-         real zxt_cas(niso,ncas),zxtrfln_cas(niso,ncas)
-         real Exi(niso,ncas)
-         real Eqi(ncas)
-         real fac_ftmr(ncas)
-         integer liq
-         real hdiag(ncas)
+         INTEGER ncas
+         INTEGER cas(ncas)
+         INTEGER klon
+         INTEGER izone
+         REAL zxt_cas(niso,ncas),zxtrfln_cas(niso,ncas)
+         REAL Exi(niso,ncas)
+         REAL Eqi(ncas)
+         REAL fac_ftmr(ncas)
+         INTEGER liq
+         REAL hdiag(ncas)
 
          ! output
-         real zxt(ntraciso,klon)
-         real zxtrfl(ntraciso,klon),zxtrfln(ntraciso,klon)
-         real xtrevap_tag(ntraciso,ncas)
+         REAL zxt(ntraciso,klon)
+         REAL zxtrfl(ntraciso,klon),zxtrfln(ntraciso,klon)
+         REAL xtrevap_tag(ntraciso,ncas)
 
          ! locals
-         integer il,ixt,iiso
+         INTEGER il,ixt,iiso
 
 !         WRITE(*,*) 'uncompress_stewart 1420 tmp: zxt=',
@@ -828,5 +828,5 @@
           enddo !do iiso=1,niso
 !#ifdef ISOVERIF
-!          if (il.eq.9) THEN
+!          if (il.EQ.9) THEN
 !            WRITE(*,*) 'uncompress 1521'
 !            WRITE(*,*) 'il,Eqi,fac_ftmr,evap_franche,Exi(2,il)=',
@@ -835,8 +835,8 @@
 !#endif
 
-          if ((option_revap.eq.1).and. &
-               (((liq.eq.1).and.(Eqi(il)*fac_ftmr(il).gt.evap_franche) &
-               .and.(hdiag(il).lt.0.99)).or. &
-               ((liq.eq.0).and. &
+          IF ((option_revap.EQ.1).AND. &
+               (((liq.EQ.1).AND.(Eqi(il)*fac_ftmr(il).gt.evap_franche) &
+               .AND.(hdiag(il).lt.0.99)).OR. &
+               ((liq.EQ.0).AND. &
                (Eqi(il)*fac_ftmr(il).ge.0.0)))) THEN
           ! le flux d'évap va dans un tag particulier
@@ -849,5 +849,5 @@
              enddo !do iiso=1,niso
                 
-          else !if ((Eqi(il)*fac_ftmr(il).gt.evap_franche).and.
+          else !if ((Eqi(il)*fac_ftmr(il).gt.evap_franche).AND.
             ! reequilibration standard
             do iiso=1,niso
@@ -862,5 +862,5 @@
 #endif              
             enddo ! do iiso=1,niso           
-          endif !if ((Eqi(il)*fac_ftmr(il).gt.evap_franche).and.
+          endif !if ((Eqi(il)*fac_ftmr(il).gt.evap_franche).AND.
          enddo !do il=1,ncas
 !         WRITE(*,*) 'compress_stewart 1453 tmp: zxt=',
@@ -885,25 +885,25 @@
 
         ! inputs         
-         integer ncas
-         integer cas(ncas)
-         integer klon
-         real zxt(ntraciso,klon)
-         real zxtrfl(ntraciso,klon)
-         real zrfl_ancien(klon)
-         real zqev_diag(klon)
-         real zrfln(klon)
-         real zxtrfl_ancien(ntraciso,klon)
-         integer izone
+         INTEGER ncas
+         INTEGER cas(ncas)
+         INTEGER klon
+         REAL zxt(ntraciso,klon)
+         REAL zxtrfl(ntraciso,klon)
+         REAL zrfl_ancien(klon)
+         REAL zqev_diag(klon)
+         REAL zrfln(klon)
+         REAL zxtrfl_ancien(ntraciso,klon)
+         INTEGER izone
 
          ! outputs
-         real zxt_cas(niso,ncas)         
-         real zxtrfl_cas(niso,ncas)         
-         real zqev_diag_cas(ncas)
-         real zrfln_cas(ncas)         
-         real zrfl_cas(ncas)
-         real ptrac(ncas)
+         REAL zxt_cas(niso,ncas)
+         REAL zxtrfl_cas(niso,ncas)
+         REAL zqev_diag_cas(ncas)
+         REAL zrfln_cas(ncas)
+         REAL zrfl_cas(ncas)
+         REAL ptrac(ncas)
          
          ! locals
-         integer il,ixt,ieau,iiso
+         INTEGER il,ixt,ieau,iiso
 
          ieau=index_trac(izone,iso_eau)
@@ -918,5 +918,5 @@
           zrfl_cas(il)=zxtrfl_ancien(ieau,cas(il))
 
-          if (zrfl_ancien(cas(il)).gt.0.0) THEN
+          IF (zrfl_ancien(cas(il)).gt.0.0) THEN
           ! proportion de izone dans l'évap = celle dans la goutte          
             ptrac(il)=zxtrfl_ancien(ieau,cas(il))/zrfl_ancien(cas(il))
@@ -924,5 +924,5 @@
             zqev_diag_cas(il)=zqev_diag(cas(il))*ptrac(il)
 !#ifdef ISOVERIF              
-!            if (il.eq.9) THEN
+!            if (il.EQ.9) THEN
 !              WRITE(*,*) 'compress tmp: il, ptrac=',il,ptrac(il)
 !              WRITE(*,*) 'ieau,zxtrfl_ancien(ieau,cas(il))=',
@@ -966,5 +966,5 @@
     USE isotopes_mod, ONLY: ridicule,iso_eau
 #ifdef ISOVERIF
-        use isotopes_verif_mod
+        USE isotopes_verif_mod
 #endif
 
@@ -972,24 +972,24 @@
 
         ! inputs         
-         integer ncas
-         integer cas(ncas)
-         integer klon
-         real zxt(ntraciso,klon)
-         real zxtrfl_ancien(ntraciso,klon)
-         real zqev_diag(klon)
-         real zrfln(klon)
-         integer izone
-         real zrfl_ancien(klon)
+         INTEGER ncas
+         INTEGER cas(ncas)
+         INTEGER klon
+         REAL zxt(ntraciso,klon)
+         REAL zxtrfl_ancien(ntraciso,klon)
+         REAL zqev_diag(klon)
+         REAL zrfln(klon)
+         INTEGER izone
+         REAL zrfl_ancien(klon)
 
          ! outputs
-         real zxt_cas(niso,ncas)         
-         real zxtrfl_cas(niso,ncas)         
-         real zqev_diag_cas(ncas)
-         real zrfln_cas(ncas)         
-         real zrfl_cas(ncas)
+         REAL zxt_cas(niso,ncas)
+         REAL zxtrfl_cas(niso,ncas)
+         REAL zqev_diag_cas(ncas)
+         REAL zrfln_cas(ncas)
+         REAL zrfl_cas(ncas)
          
          
          ! locals
-         integer il,ixt,ieau,iiso     
+         INTEGER il,ixt,ieau,iiso
 
          ieau=index_trac(izone,iso_eau)
@@ -1002,5 +1002,5 @@
           zrfl_cas(il)=zxtrfl_ancien(ieau,cas(il))
 
-          if (zrfl_ancien(cas(il)).gt.0.0) THEN
+          IF (zrfl_ancien(cas(il)).gt.0.0) THEN
              zrfln_cas(il)=zrfln(cas(il)) &
                  *(zxtrfl_ancien(ieau,cas(il))/zrfl_ancien(cas(il)))
@@ -1039,15 +1039,15 @@
 
       ! input
-      integer ncas
-      integer cas(ncas)
-      integer klon
-      integer izone      
-      real xtrevap_tag(ntraciso,ncas)
+      INTEGER ncas
+      INTEGER cas(ncas)
+      INTEGER klon
+      INTEGER izone
+      REAL xtrevap_tag(ntraciso,ncas)
 
       ! inout
-      real zxt(ntraciso,klon)
+      REAL zxt(ntraciso,klon)
 
       ! local
-      integer i,ixt,iiso,ixt_revap
+      INTEGER i,ixt,iiso,ixt_revap
 !#ifdef ISOVERIF      
 !      integer iso_verif_positif_choix_nostop
@@ -1071,6 +1071,6 @@
                    +xtrevap_tag(ixt,i)
 #ifdef ISOVERIF
-               if (iso_verif_positif_choix_nostop(zxt(ixt_revap,cas(i)), &
-                         0.0,'ajoute_revap 46').eq.1) THEN
+               IF (iso_verif_positif_choix_nostop(zxt(ixt_revap,cas(i)), &
+                         0.0,'ajoute_revap 46').EQ.1) THEN
                   WRITE(*,*) 'i,iiso,izone,ixt=',i,iiso,izone,ixt
                   WRITE(*,*) 'xtrevap_tag(ixt,i)=',xtrevap_tag(ixt,i)
@@ -1109,13 +1109,13 @@
 
       ! input
-      integer bassin
-      real lat,lon
+      INTEGER bassin
+      REAL lat,lon
 
       ! outut
-      logical is_in_bassin
+      LOGICAL is_in_bassin
 
       ! locals
-      !logical is_in_rectangle
-      !logical is_in_triangle
+      !LOGICAL is_in_rectangle
+      !LOGICAL is_in_triangle
       
       is_in_bassin=.FALSE.
@@ -1123,29 +1123,29 @@
       WRITE(*,*) 'is_in_basin 84: entree,bassin=',bassin
 #endif
-      if (use_bassin_atlantic .and. bassin==bassin_atlantic) THEN
+      IF (use_bassin_atlantic .AND. bassin==bassin_atlantic) THEN
 #ifdef ISOVERIF           
           WRITE(*,*) 'bassin Atlantique?'
 #endif          
-          if (is_in_rectangle(lon,lat,-67.0,28.0,20.0,-45.0)) THEN
+          IF (is_in_rectangle(lon,lat,-67.0,28.0,20.0,-45.0)) THEN
             ! boite sud
             is_in_bassin=.TRUE.
             RETURN
           endif
-          if (is_in_rectangle(lon,lat,-100.0,40.0,-5.3,28.0)) THEN
+          IF (is_in_rectangle(lon,lat,-100.0,40.0,-5.3,28.0)) THEN
             ! ouest gibraltar    
             is_in_bassin=.TRUE.
             RETURN
           endif
-          if (is_in_rectangle(lon,lat,-100.0,48.0,0.0,40.0)) THEN
+          IF (is_in_rectangle(lon,lat,-100.0,48.0,0.0,40.0)) THEN
             ! Ouest France
             is_in_bassin=.TRUE.
             RETURN
           endif 
-          if (is_in_rectangle(lon,lat,-90.0,80.0,10.0,46.0)) THEN
+          IF (is_in_rectangle(lon,lat,-90.0,80.0,10.0,46.0)) THEN
             ! Atlantic Nord
             is_in_bassin=.TRUE.
             RETURN
           endif
-          if (is_in_triangle(lon,lat, &
+          IF (is_in_triangle(lon,lat, &
                  -62.0,0.0,-62.0,30.0,-112.0,30.0)) THEN
             ! golfe du Mexique
@@ -1154,26 +1154,26 @@
           endif
 
-      else if (use_bassin_medit .and. bassin==bassin_medit) THEN
+      ELSE IF (use_bassin_medit .AND. bassin==bassin_medit) THEN
 #ifdef ISOVERIF           
           WRITE(*,*) 'bassin Medit?'
 #endif          
-          if (is_in_rectangle(lon,lat,0.0,48.0,45.0,29.0)) THEN
+          IF (is_in_rectangle(lon,lat,0.0,48.0,45.0,29.0)) THEN
             is_in_bassin=.TRUE.
             RETURN
           endif
-          if (is_in_rectangle(lon,lat,-5.3,42.0,45.0,29.0)) THEN
+          IF (is_in_rectangle(lon,lat,-5.3,42.0,45.0,29.0)) THEN
             is_in_bassin=.TRUE.
             RETURN
           endif
 
-      else if (use_bassin_indian .and. bassin==bassin_indian) THEN
+      ELSE IF (use_bassin_indian .AND. bassin==bassin_indian) THEN
 #ifdef ISOVERIF           
           WRITE(*,*) 'bassin indian?'
 #endif           
-          if (is_in_rectangle(lon,lat,20.0,30.0,110.0,-45.0)) THEN
+          IF (is_in_rectangle(lon,lat,20.0,30.0,110.0,-45.0)) THEN
             is_in_bassin=.TRUE.
             RETURN
           endif
-          if (is_in_triangle(lon,lat, &
+          IF (is_in_triangle(lon,lat, &
                  90.0,30.0,90.0,-45.0,150.0,-45.0)) THEN
             ! Ouest Australie
@@ -1182,51 +1182,51 @@
           endif   
 
-      else if (use_bassin_SouthIndian .and. bassin==bassin_SouthIndian) THEN
+      ELSE IF (use_bassin_SouthIndian .AND. bassin==bassin_SouthIndian) THEN
 #ifdef ISOVERIF           
           WRITE(*,*) 'bassin indian hemisphere Sud?'
 #endif           
-          if (is_in_rectangle(lon,lat,20.0,0.0,120.0,-45.0)) THEN
+          IF (is_in_rectangle(lon,lat,20.0,0.0,120.0,-45.0)) THEN
             is_in_bassin=.TRUE.
             RETURN
           endif
           
-      else if (use_bassin_MerArabie .and. bassin==bassin_MerArabie) THEN
+      ELSE IF (use_bassin_MerArabie .AND. bassin==bassin_MerArabie) THEN
 #ifdef ISOVERIF           
           WRITE(*,*) 'bassin Mer d''Arabie?'
 #endif           
-          if (is_in_rectangle(lon,lat,20.0,30.0,76.0,0.0)) THEN
+          IF (is_in_rectangle(lon,lat,20.0,30.0,76.0,0.0)) THEN
             is_in_bassin=.TRUE.
             RETURN
           endif 
 
-      else if (use_bassin_BengalGolf .and. bassin==bassin_BengalGolf) THEN
+      ELSE IF (use_bassin_BengalGolf .AND. bassin==bassin_BengalGolf) THEN
 #ifdef ISOVERIF           
           WRITE(*,*) 'bassin Golfe du Bengale?'
 #endif           
-          if (is_in_rectangle(lon,lat,76.0,30.0,110.0,0.0)) THEN
+          IF (is_in_rectangle(lon,lat,76.0,30.0,110.0,0.0)) THEN
             is_in_bassin=.TRUE.
             RETURN
           endif         
 
-      else if (use_bassin_pacific .and. bassin==bassin_pacific) THEN
+      ELSE IF (use_bassin_pacific .AND. bassin==bassin_pacific) THEN
 #ifdef ISOVERIF           
           WRITE(*,*) 'bassin Pacific?'
 #endif          
-         if (is_in_rectangle(lon,lat,-180.0,80.0,-100.0,-45.0)) THEN
+         IF (is_in_rectangle(lon,lat,-180.0,80.0,-100.0,-45.0)) THEN
              ! pacifique Est
             is_in_bassin=.TRUE.
             RETURN
           endif
-          if (is_in_rectangle(lon,lat,110.0,80.0,180.0,28.0)) THEN
+          IF (is_in_rectangle(lon,lat,110.0,80.0,180.0,28.0)) THEN
             ! Pacifique Nord Ouest
             is_in_bassin=.TRUE.
             RETURN
           endif 
-          if (is_in_rectangle(lon,lat,120.0,80.0,180.0,-45.0)) THEN
+          IF (is_in_rectangle(lon,lat,120.0,80.0,180.0,-45.0)) THEN
             ! Pacifique central Sud
             is_in_bassin=.TRUE.
             RETURN
           endif
-          if (is_in_triangle(lon,lat, &
+          IF (is_in_triangle(lon,lat, &
                   90.0,28.0,150.0,-45.0,150.0,28.0)) THEN
             ! Pacifque Sud Ouest
@@ -1234,5 +1234,5 @@
             RETURN
           endif
-          if (is_in_triangle(lon,lat, &
+          IF (is_in_triangle(lon,lat, &
                   -62.0,0.0,-112.0,30.0,-112.0,0.0)) THEN
             ! Ouest Amérique centrale
@@ -1240,5 +1240,5 @@
             RETURN
           endif
-          if (is_in_rectangle(lon,lat,-180.0,0.0,-67.0,-45.0)) THEN
+          IF (is_in_rectangle(lon,lat,-180.0,0.0,-67.0,-45.0)) THEN
             ! Ouest Chili
             is_in_bassin=.TRUE.
@@ -1246,36 +1246,36 @@
           endif
 
-      else if (use_bassin_austral .and. bassin==bassin_austral) THEN
+      ELSE IF (use_bassin_austral .AND. bassin==bassin_austral) THEN
 #ifdef ISOVERIF           
           WRITE(*,*) 'bassin austral?'
 #endif           
-          if (lat.lt.-45.0+0.2) THEN
+          IF (lat.lt.-45.0+0.2) THEN
                 is_in_bassin=.TRUE.
                 return    
           endif  
 
-      else if (use_bassin_HighLats .and. bassin==bassin_HighLats) THEN
+      ELSE IF (use_bassin_HighLats .AND. bassin==bassin_HighLats) THEN
 #ifdef ISOVERIF           
           WRITE(*,*) 'bassin hautes lats?'
 #endif           
-          if (abs(lat).gt.35.0) THEN
+          IF (abs(lat).gt.35.0) THEN
                 is_in_bassin=.TRUE.
                 return    
           endif
 
-      else if (use_bassin_tropics .and. bassin==bassin_tropics) THEN
+      ELSE IF (use_bassin_tropics .AND. bassin==bassin_tropics) THEN
 #ifdef ISOVERIF           
           WRITE(*,*) 'bassin tropics?'
 #endif           
-          if (abs(lat).lt.15.0) THEN
+          IF (abs(lat).lt.15.0) THEN
                 is_in_bassin=.TRUE.
                 return    
           endif
 
-       else if (use_bassin_midlats .and. bassin==bassin_midlats) THEN
+       ELSE IF (use_bassin_midlats .AND. bassin==bassin_midlats) THEN
 #ifdef ISOVERIF           
           WRITE(*,*) 'bassin mid lats?'
 #endif           
-          if ((abs(lat).ge.15.0).and. &
+          IF ((abs(lat).ge.15.0).AND. &
                  (abs(lat).le.35.0)) THEN
                 is_in_bassin=.TRUE.
@@ -1306,18 +1306,18 @@
 
       SUBROUTINE find_bassin(lat,lon,bassin)
-      use isotrac_mod, ONLY: izone_poubelle,ntraceurs_zone=>ntiso,option_traceurs, &
+      USE isotrac_mod, ONLY: izone_poubelle,ntraceurs_zone=>ntiso,option_traceurs, &
 &        bassin_map
 #ifdef ISOVERIF
-        use isotopes_verif_mod
+        USE isotopes_verif_mod
 #endif
       IMPLICIT NONE
 
       ! inputs
-      real lat,lon
+      REAL lat,lon
       ! output
-      integer bassin
+      INTEGER bassin
       !locals
-      logical continu
-      !logical is_in_bassin
+      LOGICAL continu
+      !LOGICAL is_in_bassin
 
       continu=.TRUE.
@@ -1332,5 +1332,5 @@
 !!      WRITE(*,*) 'find_bassin 169: lat,lon,bassin=',lat,lon,bassin
 !#endif       
-         if (is_in_bassin(lat,lon,bassin)) THEN
+         IF (is_in_bassin(lat,lon,bassin)) THEN
                 continu=.FALSE.
 #ifdef ISOVERIF                 
@@ -1343,5 +1343,5 @@
              bassin=bassin+1
          endif
-         if (bassin.eq.izone_poubelle) THEN
+         IF (bassin.EQ.izone_poubelle) THEN
                 continu=.FALSE.
                 bassin=izone_poubelle
@@ -1365,21 +1365,21 @@
         USE dimphy, ONLY: klev
         USE lmdz_geometry, ONLY: longitude_deg, latitude_deg
-        use isotrac_mod, ONLY: bassin_map,option_traceurs,boite_map
-#ifdef ISOVERIF
-        use isotopes_verif_mod
+        USE isotrac_mod, ONLY: bassin_map,option_traceurs,boite_map
+#ifdef ISOVERIF
+        USE isotopes_verif_mod
 #endif
         IMPLICIT NONE
-        real presnivs(klev)
-
-       if (option_traceurs.eq.3) THEN
+        REAL presnivs(klev)
+
+       IF (option_traceurs.EQ.3) THEN
            ! initialisation de bassin_map
            CALL bassin_map_init(latitude_deg,longitude_deg,bassin_map)
-       else if (option_traceurs.eq.20) THEN
+       ELSE IF (option_traceurs.EQ.20) THEN
            ! initialisation de bassin_map selon < ou > 35° lat
            WRITE(*,*) 'physiq 1681: init de la map pour tag 20'
            CALL bassin_map_init_opt20(latitude_deg,bassin_map)
-       else if (option_traceurs.eq.5) THEN
+       ELSE IF (option_traceurs.EQ.5) THEN
            CALL boite_AMMA_init(latitude_deg,longitude_deg,presnivs,boite_map)
-       else if (option_traceurs.eq.21) THEN
+       ELSE IF (option_traceurs.EQ.21) THEN
            CALL boite_UT_extra_init(latitude_deg,longitude_deg,presnivs,boite_map)
        endif
@@ -1391,5 +1391,5 @@
         USE dimphy, ONLY: klon
 #ifdef ISOVERIF
-        use isotopes_verif_mod
+        USE isotopes_verif_mod
 #endif
 
@@ -1397,9 +1397,9 @@
 
         ! inputs
-        real lat(klon),lon(klon)
+        REAL lat(klon),lon(klon)
         ! output
-        integer bassin_map(klon)
+        INTEGER bassin_map(klon)
         ! locals
-        integer i
+        INTEGER i
 
         do i=1,klon
@@ -1417,11 +1417,11 @@
         IMPLICIT NONE
         ! inputs 
-        real x,y
+        REAL x,y
         ! point en haut à gauche         
-        real x1,y1
+        REAL x1,y1
         ! point en bas à droite
-        real x2,y2
+        REAL x2,y2
         ! output
-        logical is_in_rectangle
+        LOGICAL is_in_rectangle
 
 !#ifdef ISOVERIF        
@@ -1429,6 +1429,6 @@
 !        WRITE(*,*) 'x1,y1,x2,y2=',x1,y1,x2,y2
 !#endif         
-        if ((x-x2.lt.0.1).and.(x-x1.gt.-0.1).and. &
-                  (y-y1.lt.0.1).and.(y-y2.gt.-0.1)) THEN
+        IF ((x-x2.lt.0.1).AND.(x-x1.gt.-0.1).AND. &
+                  (y-y1.lt.0.1).AND.(y-y2.gt.-0.1)) THEN
           is_in_rectangle=.TRUE.
         else
@@ -1444,18 +1444,18 @@
         IMPLICIT NONE
         ! inputs
-        real x,y
+        REAL x,y
         ! points dans le sens trigo
         ! à gauche
-        real x1,y1
+        REAL x1,y1
         ! en bas
-        real x2,y2
+        REAL x2,y2
         ! à droite
-        real x3,y3
+        REAL x3,y3
         ! output
-        logical is_in_triangle
+        LOGICAL is_in_triangle
         ! locals
-        real det1
-        real det2
-        real det3
+        REAL det1
+        REAL det2
+        REAL det3
 !#ifdef ISOVERIF
 !        WRITE(*,*) 'is_in_triange 271: x,y=',x,y
@@ -1466,5 +1466,5 @@
         det3=(x3-x)*(y1-y)-(y3-y)*(x1-x)
         is_in_triangle=.FALSE.
-        if ((det1*det2.gt.0.0).and.(det2*det3.gt.0.0)) THEN
+        IF ((det1*det2.gt.0.0).AND.(det2*det3.gt.0.0)) THEN
           is_in_triangle=.TRUE.
         else
@@ -1488,11 +1488,11 @@
 
         ! inout
-        real xt(ntraciso,klon,klev)
+        REAL xt(ntraciso,klon,klev)
         ! input
-        real t(klon,klev)
+        REAL t(klon,klev)
         ! locals
-        integer izone_temp 
-        integer ixt,ixt_recoit
-        integer k,i,izone,iiso
+        INTEGER izone_temp
+        INTEGER ixt,ixt_recoit
+        INTEGER k,i,izone,iiso
         !integer find_index
       
@@ -1501,5 +1501,5 @@
           do i=1,klon
 !#ifdef ISOVERIF
-!            if (i.eq.1) THEN
+!            if (i.EQ.1) THEN
 !                WRITE(*,*) 'recolorise 396: i,k,t=',i,k,t(i,k)
 !                WRITE(*,*) 'zone_temp=',zone_temp
@@ -1510,5 +1510,5 @@
 
 !#ifdef ISOVERIF
-!            if (i.eq.1) THEN
+!            if (i.EQ.1) THEN
 !                WRITE(*,*) 'recolorise 414: izone_temp=',izone_temp
 !            endif
@@ -1518,10 +1518,10 @@
                ! températures plus basses sont convertis
 !#ifdef ISOVERIF
-!            if (i.eq.1) THEN
+!            if (i.EQ.1) THEN
 !                WRITE(*,*) 'recolorise 405: izone,xt_eau=',
 !     :               izone,xt(index_trac(izone,iso_eau),i,k)  
 !            endif
 !#endif                 
-               if (izone.lt.izone_temp) THEN
+               IF (izone.lt.izone_temp) THEN
                   do iiso=1,niso
                    ixt=index_trac(izone,iiso) ! emmetteur
@@ -1532,5 +1532,5 @@
                endif  !if (izone.lt.izone_temp) THEN
 !#ifdef ISOVERIF
-!            if (i.eq.1) THEN
+!            if (i.EQ.1) THEN
 !                WRITE(*,*) 'recolorise 419: xt_eau,xt_recoit=',
 !     :               xt(index_trac(izone,iso_eau),i,k),
@@ -1575,11 +1575,11 @@
 
         ! inout
-        real xt(ntraciso,klon,klev)
+        REAL xt(ntraciso,klon,klev)
         ! input
-        real t(klon,klev)
+        REAL t(klon,klev)
         ! locals
-        integer izone_temp 
-        integer ixt,ixt_recoit
-        integer k,i,izone,iiso
+        INTEGER izone_temp
+        INTEGER ixt,ixt_recoit
+        INTEGER k,i,izone,iiso
         !integer find_index
 
@@ -1594,5 +1594,5 @@
                ! sauf la revap
                ! le tag de la revap est nzone_temp+1=ntraceurs_zone
-               if (izone.lt.izone_temp) THEN
+               IF (izone.lt.izone_temp) THEN
                   do iiso=1,niso
                    ixt=index_trac(izone,iiso) ! emmetteur
@@ -1630,15 +1630,15 @@
 
         ! inout
-        real xt(ntraciso,klon,klev)
+        REAL xt(ntraciso,klon,klev)
         ! input
-        real rh(klon,klev)
-        real lat(klon)
-        real pres(klev)
+        REAL rh(klon,klev)
+        REAL lat(klon)
+        REAL pres(klev)
         ! locals
-        integer izone_recoit
-        integer ixt,ixt_recoit
-        integer k,i,izone,iiso
-        logical continu
-        real rh_seuil
+        INTEGER izone_recoit
+        INTEGER ixt,ixt_recoit
+        INTEGER k,i,izone,iiso
+        LOGICAL continu
+        REAL rh_seuil
         parameter (rh_seuil=0.90)
         !integer index_zone_latpres
@@ -1656,8 +1656,8 @@
         do k=3,klev
           do i=1,klon
-            if (rh(i,k).gt.rh_seuil) THEN
+            IF (rh(i,k).gt.rh_seuil) THEN
                 izone_recoit=index_zone_latpres(lat(i),pres(k))
                 do izone=1,ntraceurs_zone
-                 if (izone.ne.izone_recoit) THEN
+                 IF (izone.NE.izone_recoit) THEN
                   do iiso=1,niso
                    ixt=index_trac(izone,iiso) ! emmetteur
@@ -1694,20 +1694,20 @@
 
         ! inout
-        real xt(ntraciso,klon,klev)
+        REAL xt(ntraciso,klon,klev)
         ! input
-        integer boite_map(klon,klev)
+        INTEGER boite_map(klon,klev)
         ! locals
-        integer i,k
-        integer izone_recoit,izone,iiso
-        integer ixt,ixt_recoit
+        INTEGER i,k
+        INTEGER izone_recoit,izone,iiso
+        INTEGER ixt,ixt_recoit
         
         do k=1,klev
           do i=1,klon
             izone_recoit=boite_map(i,k)
-            if (izone_recoit.gt.0) THEN
+            IF (izone_recoit.gt.0) THEN
                 ! on est dans une boite connue
                 ! toutes les molécules sont converties en cete couleur
                do izone=1,ntraceurs_zone
-                  if (izone.ne.izone_recoit) THEN
+                  IF (izone.NE.izone_recoit) THEN
                       ! on met les traceurs izone dans izone_recoit
                       do iiso=1,niso
@@ -1718,5 +1718,5 @@
                         xt(ixt,i,k)=0.0
                       enddo
-                  endif !if (izone.ne.izone_recoit) THEN
+                  endif !if (izone.NE.izone_recoit) THEN
                enddo !do izone=2,ntraceurs_zone
             endif !if (izone_recoit.gt.0) THEN
@@ -1748,15 +1748,15 @@
 
         ! inout
-        real xt(ntraciso,klon,klev)
+        REAL xt(ntraciso,klon,klev)
         ! input
-        real rlat(klon)
+        REAL rlat(klon)
         ! locals
-        integer i,k
-        integer iiso,ixt,ixt_recoit
+        INTEGER i,k
+        INTEGER iiso,ixt,ixt_recoit
        
 !        WRITE(*,*) 'iso_traceurs_routines 723: lim_tag20=',lim_tag20
         do k=1,klev
           do i=1,klon
-            if (abs(rlat(i)).gt.lim_tag20) THEN
+            IF (abs(rlat(i)).gt.lim_tag20) THEN
                 ! on met les traceurs izone_trop dans izone_extra
                 do iiso=1,niso
@@ -1784,5 +1784,5 @@
         SUBROUTINE isotrac_recolorise_conv(xt,rlat,presnivs,rain_con)
         USE dimphy, ONLY: klon,klev
-        use isotrac_mod, ONLY: lim_precip_tag22, &
+        USE isotrac_mod, ONLY: lim_precip_tag22, &
 &       izone_conv_BT,izone_conv_UT
 #ifdef ISOVERIF
@@ -1796,12 +1796,12 @@
 
         ! inout
-        real xt(ntraciso,klon,klev)
+        REAL xt(ntraciso,klon,klev)
         ! input
-        real rlat(klon)
-        real presnivs(klev)
-        real rain_con(klon)
+        REAL rlat(klon)
+        REAL presnivs(klev)
+        REAL rain_con(klon)
         ! locals
-        integer i,k
-        integer iiso,ixt,ixt_recoit,izone
+        INTEGER i,k
+        INTEGER iiso,ixt,ixt_recoit,izone
        
 !        WRITE(*,*) 'iso_traceurs_routines 723: lim_tag20=',lim_tag20
@@ -1811,12 +1811,12 @@
           do i=1,klon
 #ifdef ISOVERIF
-          if ((abs(rlat(i)).lt.30.0).and.(k.eq.1)) THEN
+          IF ((abs(rlat(i)).lt.30.0).AND.(k.EQ.1)) THEN
           endif
 #endif          
-            if ((abs(rlat(i)).lt.30.0).and. &
+            IF ((abs(rlat(i)).lt.30.0).AND. &
                   (rain_con(i)*86400.gt.lim_precip_tag22)) THEN
                 ! on met les traceurs izone_trop dans izone_conv fn z                
                 do iiso=1,niso
-                  if (presnivs(k).gt.650.0*100.0) THEN
+                  IF (presnivs(k).gt.650.0*100.0) THEN
                     ixt_recoit=index_trac(izone_conv_BT,iiso) 
                   else
@@ -1825,9 +1825,9 @@
                   do izone=1,ntraceurs_zone
                     ixt=index_trac(izone,iiso)
-                    if (ixt.ne.ixt_recoit) THEN
+                    IF (ixt.NE.ixt_recoit) THEN
                         xt(ixt_recoit,i,k)=xt(ixt_recoit,i,k) &
                                +xt(ixt,i,k)
                         xt(ixt,i,k)=0.0
-                    endif !if (ixt.ne.ixt_recoit) THEN
+                    endif !if (ixt.NE.ixt_recoit) THEN
                   enddo !do izone=1,ntraceurs_zone
                 enddo !do iiso=1,niso
@@ -1859,10 +1859,10 @@
         IMPLICIT NONE
 
-        real lat(klon),lon(klon)
-        real presnivs(klev)
+        REAL lat(klon),lon(klon)
+        REAL presnivs(klev)
         ! output
-        integer boite_map(klon,klev)
+        INTEGER boite_map(klon,klev)
         ! locals
-        integer i,k
+        INTEGER i,k
 
 !        WRITE(*,*) 'izone_aej,izone_mousson,izone_harmattan=',
@@ -1873,23 +1873,23 @@
 !                WRITE(*,*) 'i,k,lat,lon,pres=',
 !     :                   i,k,lat(i),lon(i),presnivs(k)
-                if ((presnivs(k).le.700.0*100.0).and. &
-                    (presnivs(k).gt.400.0*100.0).and. &
-                    (lat(i).gt.8.0).and. &
-                    (lat(i).lt.20.0).and. &
-                    (lon(i).gt.10.0).and. &
+                IF ((presnivs(k).le.700.0*100.0).AND. &
+                    (presnivs(k).gt.400.0*100.0).AND. &
+                    (lat(i).gt.8.0).AND. &
+                    (lat(i).lt.20.0).AND. &
+                    (lon(i).gt.10.0).AND. &
                     (lon(i).lt.30.0)) THEN
                    boite_map(i,k)=izone_aej
 !                   WRITE(*,*) '   -> zone AEJ'
-                else if ((presnivs(k).ge.850.0*100.0).and. &
-                    (lat(i).gt.-5.0).and. &
-                    (lat(i).le.8.0).and. &
-                    (lon(i).gt.-40.0).and. &
+                ELSE IF ((presnivs(k).ge.850.0*100.0).AND. &
+                    (lat(i).gt.-5.0).AND. &
+                    (lat(i).le.8.0).AND. &
+                    (lon(i).gt.-40.0).AND. &
                     (lon(i).lt.15.0)) THEN
                    boite_map(i,k)=izone_mousson
 !                   WRITE(*,*) '   -> zone flux de mousson'
-                else if ((presnivs(k).gt.700.0*100.0).and. &
-                    (lat(i).ge.20.0).and. &
-                    (lat(i).lt.30.0).and. &
-                    (lon(i).gt.-10.0).and. &
+                ELSE IF ((presnivs(k).gt.700.0*100.0).AND. &
+                    (lat(i).ge.20.0).AND. &
+                    (lat(i).lt.30.0).AND. &
+                    (lon(i).gt.-10.0).AND. &
                     (lon(i).lt.40.0)) THEN
                    boite_map(i,k)=izone_harmattan
@@ -1906,5 +1906,5 @@
         SUBROUTINE boite_UT_extra_init(lat,lon,presnivs,boite_map)
         USE dimphy, ONLY: klon,klev
-        use isotrac_mod, ONLY: izone_extra,izone_trop
+        USE isotrac_mod, ONLY: izone_extra,izone_trop
 #ifdef ISOVERIF
         USE isotopes_verif_mod
@@ -1912,10 +1912,10 @@
         IMPLICIT NONE
 
-        real lat(klon),lon(klon)
-        real presnivs(klev)
+        REAL lat(klon),lon(klon)
+        REAL presnivs(klev)
         ! output
-        integer boite_map(klon,klev)
+        INTEGER boite_map(klon,klev)
         ! locals
-        integer i,k
+        INTEGER i,k
 
 !        WRITE(*,*) 'izone_trop,izone_extra=',
@@ -1926,9 +1926,9 @@
 !                WRITE(*,*) 'i,k,lat,lon,pres=',
 !     :                   i,k,lat(i),lon(i),presnivs(k)
-                if ((presnivs(k).le.500.0*100.0) &
-                    .and.(abs(lat(i)).lt.15.0)) THEN
+                IF ((presnivs(k).le.500.0*100.0) &
+                    .AND.(abs(lat(i)).lt.15.0)) THEN
                    boite_map(i,k)=izone_trop
 !                   WRITE(*,*) '   -> zone trop'
-                else if (abs(lat(i)).gt.35.0) THEN
+                ELSE IF (abs(lat(i)).gt.35.0) THEN
                    boite_map(i,k)=izone_extra
 !                   WRITE(*,*) '   -> zone extratropiques'
@@ -1943,13 +1943,13 @@
 
         function index_zone_lat(lat)
-        use isotrac_mod, ONLY: lattag_min,dlattag,nzone_lat
+        USE isotrac_mod, ONLY: lattag_min,dlattag,nzone_lat
         IMPLICIT NONE
 
         ! inputs
-        real lat,pres
+        REAL lat,pres
         ! output 
-        integer index_zone_lat
-
-        if (lat.lt.lattag_min) THEN
+        INTEGER index_zone_lat
+
+        IF (lat.lt.lattag_min) THEN
                 index_zone_lat=1
         else
@@ -1963,11 +1963,11 @@
 
         function index_zone_pres(pres)
-        use isotrac_mod, ONLY: nzone_pres,zone_pres
+        USE isotrac_mod, ONLY: nzone_pres,zone_pres
         IMPLICIT NONE
 
         ! inputs
-        real lat,pres
+        REAL lat,pres
         ! output 
-        integer index_zone_pres
+        INTEGER index_zone_pres
         !integer find_index
 
@@ -1985,15 +1985,15 @@
 
         ! inputs
-        real pres
-        integer nzone_pres
-        real zone_pres(nzone_pres)
+        REAL pres
+        INTEGER nzone_pres
+        REAL zone_pres(nzone_pres)
         ! output 
-        integer find_index
-        logical continu
-
-        if (nzone_pres.gt.1) THEN
-          if (pres.ge.zone_pres(1)) THEN
+        INTEGER find_index
+        LOGICAL continu
+
+        IF (nzone_pres.gt.1) THEN
+          IF (pres.ge.zone_pres(1)) THEN
                 find_index=1
-          else if (pres.lt.zone_pres(nzone_pres-1)) THEN
+          ELSE IF (pres.lt.zone_pres(nzone_pres-1)) THEN
                 find_index=nzone_pres
           else !if (t(i,k).ge.zone_temp1) THEN
@@ -2001,5 +2001,5 @@
                 find_index=2
                 do while (continu)
-                  if (pres.ge.zone_pres(find_index)) THEN
+                  IF (pres.ge.zone_pres(find_index)) THEN
                      continu=.FALSE.
                      ! c'est izone_temp, zone trouvée
@@ -2015,14 +2015,14 @@
 
         function index_zone_latpres(lat,pres)
-        use isotrac_mod, ONLY: nzone_lat
+        USE isotrac_mod, ONLY: nzone_lat
         IMPLICIT NONE
 
         ! inputs
-        real lat,pres
+        REAL lat,pres
         ! output 
-        integer index_zone_latpres
+        INTEGER index_zone_latpres
         ! locals
-        integer index_lat
-        integer index_pres
+        INTEGER index_lat
+        INTEGER index_pres
         !integer index_zone_lat
         !integer index_zone_pres
@@ -2040,5 +2040,5 @@
         USE dimphy, ONLY: klon,klev
         USE isotopes_mod, ONLY: bidouille_anti_divergence,iso_eau
-        use isotrac_mod, ONLY: option_seuil_tag_tmin,izone_cond, &
+        USE isotrac_mod, ONLY: option_seuil_tag_tmin,izone_cond, &
 &       nzone_temp,zone_temp
 #ifdef ISOVERIF
@@ -2055,22 +2055,22 @@
 
         ! inputs
-        real qt
-        real cond
-        real tcond
-        real ep
-        real xt(ntraciso)
-        real zxtcond(ntraciso)
-        real seuil_in
+        REAL qt
+        REAL cond
+        REAL tcond
+        REAL ep
+        REAL xt(ntraciso)
+        REAL zxtcond(ntraciso)
+        REAL seuil_in
         ! outputs
-        real xtres(ntraciso)
+        REAL xtres(ntraciso)
         ! locals
-        integer izone_temp,izone 
-        integer ixt,ixt_recoit
-        integer iiso
+        INTEGER izone_temp,izone
+        INTEGER ixt,ixt_recoit
+        INTEGER iiso
         !integer find_index
-        real fcond, qmicro
+        REAL fcond, qmicro
 !        real f
 
-        if ((cond.gt.0.0).and.(qt.gt.0.0)) THEN
+        IF ((cond.gt.0.0).AND.(qt.gt.0.0)) THEN
             izone_temp=find_index(tcond,nzone_temp,zone_temp)
 !            WRITE(*,*) 'pgm 901 tmp: izone_temp=',izone_temp    
@@ -2086,5 +2086,5 @@
 #endif           
           ! bidouille
-          if (bidouille_anti_divergence) THEN
+          IF (bidouille_anti_divergence) THEN
               CALL iso_verif_traceur_jbidouille(xt)
               CALL iso_verif_traceur_jbidouille(zxtcond)
@@ -2111,5 +2111,5 @@
 !     :                   cond/qt,seuil_in,izone_temp
 
-             if (option_seuil_tag_tmin.eq.2) THEN
+             IF (option_seuil_tag_tmin.EQ.2) THEN
                  qmicro=0.0
                  do izone=nzone_temp+1,ntraceurs_zone 
@@ -2117,5 +2117,5 @@
                    qmicro=qmicro+xt(ixt)
                  enddo !do izone=nzone_temp+1,ntraceurs_zone
-                 if (qt-qmicro.gt.0.0) THEN
+                 IF (qt-qmicro.gt.0.0) THEN
                      fcond=(cond-qmicro)/(qt-qmicro)
                  else
@@ -2126,8 +2126,8 @@
              endif
        
-             if (fcond.gt.seuil_in) THEN
+             IF (fcond.gt.seuil_in) THEN
              ! on les transfert à izone_temp
              do izone=1,ntraceurs_zone
-               if ((izone.gt.nzone_temp).or.(izone.lt.izone_temp)) THEN
+               IF ((izone.gt.nzone_temp).OR.(izone.lt.izone_temp)) THEN
 !                 ieau=index_trac(izone,iso_eau)
                  do iiso=1,niso  
@@ -2144,5 +2144,5 @@
                  enddo !do iiso=1,niso
 !                 WRITE(*,*) 'iso_trac tmp 944: izone,xtres=',izone,xtres
-                endif !if (izone.ne.izone_cond) THEN
+                endif !if (izone.NE.izone_cond) THEN
               enddo !do izone=nzones_temp+1,ntraceurs_zone
 
@@ -2150,10 +2150,10 @@
                 ! on les laisse sur place
                do izone=1,ntraceurs_zone
-                if ((izone.gt.nzone_temp).or.(izone.lt.izone_temp)) THEN
+                IF ((izone.gt.nzone_temp).OR.(izone.lt.izone_temp)) THEN
                  do iiso=1,niso  
                    ixt= index_trac(izone,iiso)    
                    xtres(ixt)=(xt(ixt)-zxtcond(ixt))
                  enddo !do iiso=1,niso
-                endif !if (izone.ne.izone_cond) THEN
+                endif !if (izone.NE.izone_cond) THEN
                enddo !do izone=nzones_temp+1,ntraceurs_zone
 
@@ -2189,5 +2189,5 @@
 
              ! on rajoute le condensat qui ne precipite pas
-             if (ep.lt.1.0) THEN
+             IF (ep.lt.1.0) THEN
                do iiso=1,niso    
                    ixt= index_trac(izone_cond,iiso) 
@@ -2207,6 +2207,6 @@
         endif ! if (qt.gt.0.0) THEN
 #ifdef ISOVERIF
-        if (iso_verif_traceur_jm_nostop(xtres, &
-                'iso_trac_routines 166').eq.1) THEN
+        IF (iso_verif_traceur_jm_nostop(xtres, &
+                'iso_trac_routines 166').EQ.1) THEN
           WRITE(*,*) 'isotrac 1024: xt=',xt
           WRITE(*,*) 'zxtcond=',zxtcond
@@ -2220,7 +2220,7 @@
           CALL iso_verif_positif(xtres(ixt),'iso_trac_routines 953')
         enddo
-        if (nzone_temp.ge.5) THEN
-        if (iso_verif_tag17_q_deltaD_chns(xtres, &
-                 'iso_trac_routines 1025').eq.1) THEN
+        IF (nzone_temp.ge.5) THEN
+        IF (iso_verif_tag17_q_deltaD_chns(xtres, &
+                 'iso_trac_routines 1025').EQ.1) THEN
             WRITE(*,*) 'xt=',xt
             WRITE(*,*) 'zxtcond=',zxtcond
@@ -2240,5 +2240,5 @@
         SUBROUTINE bassin_map_init_opt20(lat,bassin_map)
         USE dimphy, ONLY: klon
-        use isotrac_mod, ONLY: izone_cont,izone_trop,lim_tag20
+        USE isotrac_mod, ONLY: izone_cont,izone_trop,lim_tag20
 #ifdef ISOVERIF
         USE isotopes_verif_mod
@@ -2247,13 +2247,13 @@
 
         ! inputs
-        real lat(klon)
+        REAL lat(klon)
         ! output
-        integer bassin_map(klon)
+        INTEGER bassin_map(klon)
         ! locals
-        integer i
+        INTEGER i
 
         WRITE(*,*) 'iso_traceurs_routines 1142: lim_tag20=',lim_tag20
         do i=1,klon
-         if (abs(lat(i)).gt.lim_tag20) THEN
+         IF (abs(lat(i)).gt.lim_tag20) THEN
              bassin_map(i)=izone_cont
          else  
@@ -2268,25 +2268,25 @@
         USE lmdz_geometry, ONLY: latitude_deg
         USE dimphy, ONLY: klon,klev
-        use isotrac_mod, ONLY: option_traceurs,boite_map
+        USE isotrac_mod, ONLY: option_traceurs,boite_map
         IMPLICIT NONE
 
         ! inputs
-        real, dimension(ntraciso,klon,klev), intent(in) :: xt_seri
-        real, dimension(klon,klev), intent(in) :: t_seri
-        real, dimension(klon,klev), intent(in) :: zx_rh
-        real, dimension(klev), intent(in) :: presnivs
-
-              if (option_traceurs.eq.4) THEN
+        REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: xt_seri
+        REAL, DIMENSION(klon,klev), INTENT(IN) :: t_seri
+        REAL, DIMENSION(klon,klev), INTENT(IN) :: zx_rh
+        REAL, DIMENSION(klev), INTENT(IN) :: presnivs
+
+              IF (option_traceurs.EQ.4) THEN
          CALL isotrac_recolorise_tmin(xt_seri,t_seri)
-      elseif ((option_traceurs.eq.5).or. &
-                  (option_traceurs.eq.21)) THEN
+      elseif ((option_traceurs.EQ.5).OR. &
+                  (option_traceurs.EQ.21)) THEN
         CALL isotrac_recolorise_boite(xt_seri,boite_map)
-      elseif (option_traceurs.eq.13) THEN
+      elseif (option_traceurs.EQ.13) THEN
         CALL isotrac_recolorise_tmin_sfrev(xt_seri,t_seri)
-      elseif (option_traceurs.eq.14) THEN
+      elseif (option_traceurs.EQ.14) THEN
         CALL isotrac_recolorise_saturation(xt_seri,zx_rh,latitude_deg,presnivs)
-      elseif (option_traceurs.eq.20) THEN
+      elseif (option_traceurs.EQ.20) THEN
         CALL isotrac_recolorise_extra(xt_seri,latitude_deg)
-      endif !if (option_traceurs.eq.4) THEN
+      endif !if (option_traceurs.EQ.4) THEN
         END SUBROUTINE  isotrac_recolorise_general
 
@@ -2302,12 +2302,12 @@
         ! version vectrisée de iso_verif_traceur_jbidouille
             ! inputs
-       integer n,m
-       real x(ntraciso,n,m)
+       INTEGER n,m
+       REAL x(ntraciso,n,m)
 
        ! locals
-       integer iiso,izone,ixt,i,j
-       real xtractot(n,m)
+       INTEGER iiso,izone,ixt,i,j
+       REAL xtractot(n,m)
                 
-        if (bidouille_anti_divergence) THEN
+        IF (bidouille_anti_divergence) THEN
         do iiso=1,niso
 
@@ -2334,5 +2334,5 @@
              do i=1,n
 !              if (abs(xtractot(i,j)).gt.ridicule*10) THEN
-               if (abs(xtractot(i,j)).gt.ridicule) THEN
+               IF (abs(xtractot(i,j)).gt.ridicule) THEN
                    ! modif le 19 fev 2011
                   x(ixt,i,j)=x(ixt,i,j)/xtractot(i,j)*x(iiso,i,j) 
@@ -2347,5 +2347,5 @@
 !           do j=1,m
 !             do i=1,n
-!              if ((abs(xtractot(i,j)).lt.1e-18).and.
+!              if ((abs(xtractot(i,j)).lt.1e-18).AND.
 !     :           (x(iiso,i,j).gt.ridicule)) THEN
 !                  x(ixt,i,j)=x(iiso,i,j)
@@ -2366,11 +2366,11 @@
        
        ! inputs
-       real x(ntraciso)
+       REAL x(ntraciso)
 
        ! locals
-       integer iiso,izone,ixt
-       real xtractot
+       INTEGER iiso,izone,ixt
+       REAL xtractot
         
-        if (bidouille_anti_divergence) THEN
+        IF (bidouille_anti_divergence) THEN
         do iiso=1,niso
 
@@ -2383,5 +2383,5 @@
               ! on réajuste pour que les traceurs fasses bien la somme
               ! des traceurs
-              if (abs(xtractot).gt.ridicule*10) THEN
+              IF (abs(xtractot).gt.ridicule*10) THEN
                 do izone=1,ntraceurs_zone
                   ixt=index_trac(izone,iiso) 
@@ -2413,11 +2413,11 @@
           
        ! inputs
-       real x(ntraciso)
+       REAL x(ntraciso)
 
        ! locals
-       integer iiso,izone,ixt
-       real xtractot,xtractotprec
+       INTEGER iiso,izone,ixt
+       REAL xtractot,xtractotprec
         
-        if (bidouille_anti_divergence) THEN
+        IF (bidouille_anti_divergence) THEN
 !            WRITE(*,*) 'pgm 532 tmp: x=',x
         do iiso=1,niso
@@ -2434,8 +2434,8 @@
 !     :          iiso,xtractotprec,xtractot
          
-          if (xtractot.gt.xtractotprec) THEN
+          IF (xtractot.gt.xtractotprec) THEN
               ! on réajuste pour que les traceurs fasses bien la somme
               ! des traceurs
-              if (abs(xtractot).gt.ridicule) THEN
+              IF (abs(xtractot).gt.ridicule) THEN
                 do izone=1,ntraceurs_zone
                   ixt=index_trac(izone,iiso) 
@@ -2473,13 +2473,13 @@
        
        ! inputs
-       integer n,m
-       real x(ntraciso,n,m)
+       INTEGER n,m
+       REAL x(ntraciso,n,m)
 
        ! locals
-       integer iiso,izone,ixt
-       real xtractot(n,m),xtractotprec(n,m)
-       integer i,j
+       INTEGER iiso,izone,ixt
+       REAL xtractot(n,m),xtractotprec(n,m)
+       INTEGER i,j
         
-        if (bidouille_anti_divergence) THEN
+        IF (bidouille_anti_divergence) THEN
 !            WRITE(*,*) 'pgm 532 tmp: x=',x
                
@@ -2508,8 +2508,8 @@
          do j=1,m 
          do i=1,n
-          if (xtractot(i,j).gt.xtractotprec(i,j)) THEN
+          IF (xtractot(i,j).gt.xtractotprec(i,j)) THEN
               ! on réajuste pour que les traceurs fasses bien la somme
               ! des traceurs
-              if (abs(xtractot(i,j)).gt.ridicule) THEN
+              IF (abs(xtractot(i,j)).gt.ridicule) THEN
                 do izone=1,ntraceurs_zone
                   ixt=index_trac(izone,iiso) 
@@ -2546,5 +2546,5 @@
         USE isotopes_mod, ONLY: bidouille_anti_divergence,iso_eau,ridicule
 #ifdef ISOVERIF
-        use isotopes_verif_mod
+        USE isotopes_verif_mod
 #endif        
         IMPLICIT NONE
@@ -2558,18 +2558,18 @@
     
        ! inputs
-       real x(ntraciso),q
+       REAL x(ntraciso),q
 
        ! locals
-       integer iiso,izone,ixt,ieau
-       real dqtmp,factmp
+       INTEGER iiso,izone,ixt,ieau
+       REAL dqtmp,factmp
         
-        if (bidouille_anti_divergence) THEN
+        IF (bidouille_anti_divergence) THEN
 !        WRITE(*,*) 'iso_verif_trac 578 tmp: q,xt=',
 !     :                q,x(1:ntraciso)
-        if (q.gt.0.0) THEN
+        IF (q.gt.0.0) THEN
               dqtmp=0.0
               do izone=1,ntraceurs_zone
                 ieau=index_trac(izone,iso_eau)
-                if (x(ieau).lt.0.0) THEN
+                IF (x(ieau).lt.0.0) THEN
 !                    WRITE(*,*) 'local_x<0 pour izone=',izone
                     dqtmp=dqtmp-x(ieau)
@@ -2581,5 +2581,5 @@
               enddo !do izone=1,ntraceurs_zone
 !              WRITE(*,*) 'dqtmp=',dqtmp
-              if (dqtmp.gt.0.0) THEN
+              IF (dqtmp.gt.0.0) THEN
 !                  WRITE(*,*) 'iso_verif_trac 593 warning: q,dqtmp,xt=',
 !     :                q,dqtmp,x(1:ntraciso)
@@ -2592,5 +2592,5 @@
                      do izone=1,ntraceurs_zone
                        ieau=index_trac(izone,iso_eau)
-                       if (x(ieau).gt.0.0) THEN
+                       IF (x(ieau).gt.0.0) THEN
                           do iiso=1,niso    
                              ixt=index_trac(izone,iiso)
@@ -2618,12 +2618,12 @@
            
        ! inputs
-       integer n
-       real x(ntraciso,n)
+       INTEGER n
+       REAL x(ntraciso,n)
 
        ! locals
-       integer iiso,izone,ixt,i
-       real xtractot
+       INTEGER iiso,izone,ixt,i
+       REAL xtractot
         
-        if (bidouille_anti_divergence) THEN
+        IF (bidouille_anti_divergence) THEN
         do i=1,n
         do iiso=1,niso
@@ -2637,5 +2637,5 @@
               ! on réajuste pour que les traceurs fasses bien la somme
               ! des traceurs
-              if (abs(xtractot).gt.ridicule*10) THEN
+              IF (abs(xtractot).gt.ridicule*10) THEN
                 do izone=1,ntraceurs_zone
                   ixt=index_trac(izone,iiso) 
@@ -2653,5 +2653,5 @@
 
         SUBROUTINE iso_verif_traceur_pbidouille(x,err_msg)
-        use isotopes_verif_mod
+        USE isotopes_verif_mod
         IMPLICIT NONE
         ! vérifier des choses sur les traceurs
@@ -2665,5 +2665,5 @@
        
        ! inputs
-       real x(ntraciso)
+       REAL x(ntraciso)
        character*(*) err_msg ! message d''erreur à afficher
 
@@ -2671,5 +2671,5 @@
        !integer iso_verif_traceur_pbid_ns
 
-        if (iso_verif_traceur_pbid_ns(x,err_msg).eq.1) THEN
+        IF (iso_verif_traceur_pbid_ns(x,err_msg).EQ.1) THEN
             stop
         endif
@@ -2678,7 +2678,7 @@
 
         function iso_verif_traceur_pbid_ns(x,err_msg)
-        use isotopes_mod, ONLY: iso_HDO,bidouille_anti_divergence
-        use isotrac_mod, ONLY: ridicule_trac
-        use isotopes_verif_mod
+        USE isotopes_mod, ONLY: iso_HDO,bidouille_anti_divergence
+        USE isotrac_mod, ONLY: ridicule_trac
+        USE isotopes_verif_mod
         IMPLICIT NONE
         ! vérifier des choses sur les traceurs
@@ -2692,9 +2692,9 @@
        
        ! inputs
-       real x(ntraciso)
+       REAL x(ntraciso)
        character*(*) err_msg ! message d''erreur à afficher
 
        ! output
-       integer iso_verif_traceur_pbid_ns
+       INTEGER iso_verif_traceur_pbid_ns
 
        ! locals
@@ -2702,11 +2702,11 @@
        !integer iso_verif_tracm_choix_nostop  
        !integer iso_verif_tracdD_choix_nostop  
-       integer iiso,izone,ixt
-       real xtractot
+       INTEGER iiso,izone,ixt
+       REAL xtractot
         
         ! verif noNaN
         iso_verif_traceur_pbid_ns=0
 
-        if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) THEN
+        IF (iso_verif_traceur_noNaN_nostop(x,err_msg).EQ.1) THEN
 !             stop
             iso_verif_traceur_pbid_ns=1
@@ -2714,6 +2714,6 @@
 
         ! verif masse
-        if (iso_verif_tracm_choix_nostop(x,err_msg, &
-                 errmax*10,errmaxrel*50).eq.1) THEN
+        IF (iso_verif_tracm_choix_nostop(x,err_msg, &
+                 errmax*10,errmaxrel*50).EQ.1) THEN
              ! on est plus laxiste car ça vient en général après une
              ! bidouille pour iso_eau normal
@@ -2722,5 +2722,5 @@
         endif  
 
-        if (bidouille_anti_divergence) THEN
+        IF (bidouille_anti_divergence) THEN
             ! on réajuste pour que les traceurs fasses bien la somme
             ! des traceurs
@@ -2728,7 +2728,7 @@
         endif !if (bidouille_anti_divergence) THEN
        ! verif deltaD
-       if (iso_HDO.gt.0) THEN
-        if (iso_verif_tracdD_choix_nostop(x,err_msg, &
-                 ridicule_trac,deltalimtrac).eq.1) THEN
+       IF (iso_HDO.gt.0) THEN
+        IF (iso_verif_tracdD_choix_nostop(x,err_msg, &
+                 ridicule_trac,deltalimtrac).EQ.1) THEN
 !             stop
               iso_verif_traceur_pbid_ns=1
@@ -2738,16 +2738,16 @@
 
         SUBROUTINE iso_verif_traceur_pbid_vect(x,n,m,err_msg)
-        use isotopes_mod, ONLY: iso_HDO,bidouille_anti_divergence
-        use isotopes_verif_mod
+        USE isotopes_mod, ONLY: iso_HDO,bidouille_anti_divergence
+        USE isotopes_verif_mod
         IMPLICIT NONE
        
        ! inputs
-       integer n,m
-       real x(ntraciso,n,m)
+       INTEGER n,m
+       REAL x(ntraciso,n,m)
        character*(*) err_msg ! message d''erreur à afficher       
 
        ! locals
-       integer iiso,izone,ixt
-       real xtractot
+       INTEGER iiso,izone,ixt
+       REAL xtractot
         
         ! verif noNaN
@@ -2758,5 +2758,5 @@
                  errmaxrel*50)
 
-        if (bidouille_anti_divergence) THEN
+        IF (bidouille_anti_divergence) THEN
             ! on réajuste pour que les traceurs fasses bien la somme
             ! des traceurs
@@ -2764,5 +2764,5 @@
         endif !if (bidouille_anti_divergence) THEN
        ! verif deltaD
-       if (iso_HDO.gt.0) THEN
+       IF (iso_HDO.gt.0) THEN
         CALL iso_verif_tracdd_vect(x,n,m,err_msg)
        endif
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/limit_read_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/limit_read_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/limit_read_mod.F90	(revision 5117)
@@ -163,8 +163,8 @@
     INTEGER :: i
 #ifdef ISO
-  real, intent(out), dimension(niso,klon) :: Roce 
+  REAL, INTENT(OUT), DIMENSION(niso,klon) :: Roce
   INTEGER :: ixt
-  real, intent(in),dimension(klon) :: rlat
-  real lat_locale
+  REAL, INTENT(IN),DIMENSION(klon) :: rlat
+  REAL lat_locale
 #endif 
 !#ifdef ISOVERIF
@@ -178,6 +178,6 @@
 
 #ifdef ISO
-     if (iso_HTO.gt.0) THEN
-     if (ok_prod_nucl_tritium) then ! si on active la production nucleaire de tritium
+     IF (iso_HTO.gt.0) THEN
+     IF (ok_prod_nucl_tritium) then ! si on active la production nucleaire de tritium
         DO i = 1, knon
           tuoce_out(i)=tuoce(knindex(i))
@@ -188,20 +188,20 @@
 
 #ifdef ISO
-  if (modif_sst.ge.1) THEN
+  IF (modif_sst.ge.1) THEN
   do i = 1, knon 
     lat_locale=rlat(knindex(i))  
     ! test: modification uniforme de la sst 
-    if (modif_sst.eq.1) THEN
+    IF (modif_sst.EQ.1) THEN
        sst_out(i)= sst_out(i)+deltaTtest  
-    elseif (modif_sst.eq.2) then   !if (modif_sst.eq.1) THEN
+    elseif (modif_sst.EQ.2) then   !if (modif_sst.EQ.1) THEN
         ! pattern parabolique en dehors des tropiques (sstlatcrit)
-        if (abs(lat_locale).gt.sstlatcrit) THEN
+        IF (abs(lat_locale).gt.sstlatcrit) THEN
           sst_out(i)= sst_out(i)+deltaTtestpoles &
                  *(lat_locale**2-sstlatcrit**2) &
                  /(90.0**2-sstlatcrit**2)
         endif !if (abs(lat_locale).gt.abs(sstlatcrit)) THEN
-    else if (modif_sst.eq.3) THEN
-        if (abs(lat_locale).gt.abs(sstlatcrit)) THEN
-            if (abs(lat_locale).gt.sstlatcrit+dsstlatcrit) THEN
+    ELSE IF (modif_sst.EQ.3) THEN
+        IF (abs(lat_locale).gt.abs(sstlatcrit)) THEN
+            IF (abs(lat_locale).gt.sstlatcrit+dsstlatcrit) THEN
                 sst_out(i)= sst_out(i)+deltaTtestpoles
             else
@@ -210,5 +210,5 @@
             endif
         endif
-    endif !if (modif_sst.eq.1) THEN
+    endif !if (modif_sst.EQ.1) THEN
     enddo !do i = 1, knon 
     endif !if (modif_sst.ge.1) THEN
@@ -233,5 +233,5 @@
 
         ! lecture pour le tritium
-        if ((iso_HTO.gt.0).and.(ok_prod_nucl_tritium)) THEN
+        IF ((iso_HTO.gt.0).AND.(ok_prod_nucl_tritium)) THEN
              ! lecture de la carte tritium ocean surface
              Roce(iso_HTO,i)=tcorr(iso_HTO)*tuoce_out(i)*1.E-18*2.
@@ -241,6 +241,6 @@
 #ifdef ISOVERIF
         do i=1,knon
-          if (iso_verif_positif_nostop(370.0-sst_out(i), &
-              'limit_read 368').eq.1) THEN
+          IF (iso_verif_positif_nostop(370.0-sst_out(i), &
+              'limit_read 368').EQ.1) THEN
              WRITE(*,*) 'i,knindex,sst_out=',i,knindex,sst_out(i)
              stop
@@ -514,5 +514,5 @@
           
 #ifdef ISO
-             IF ((iso_HTO.gt.0).and.(ok_prod_nucl_tritium)) THEN
+             IF ((iso_HTO.gt.0).AND.(ok_prod_nucl_tritium)) THEN
                ierr = nf90_inq_varid(nid, 'TUOCE', nvarid)
                IF (ierr /= nf90_noerr) CALL abort_gcm(modname,'Le champ <TUOCE> est absent',1)
@@ -523,6 +523,6 @@
 #ifdef ISOVERIF
              do ii=1,klon_glo
-               if (iso_verif_positif_nostop(370.0-sst_glo(ii),  &
-                'limit_read 384').eq.1) THEN
+               IF (iso_verif_positif_nostop(370.0-sst_glo(ii),  &
+                'limit_read 384').EQ.1) THEN
                  WRITE(*,*) 'ii,sst_glo=',ii,sst_glo(ii)
                  WRITE(*,*) 'jour,start,epais=',jour,start,epais
@@ -578,5 +578,5 @@
           END IF
 #ifdef ISO
-          IF ((iso_HTO.gt.0).and.(ok_prod_nucl_tritium)) THEN
+          IF ((iso_HTO.gt.0).AND.(ok_prod_nucl_tritium)) THEN
              CALL Scatter(tuoce_glo,tuoce)
           END IF
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_lscp_old.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_lscp_old.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_lscp_old.F90	(revision 5117)
@@ -32,6 +32,6 @@
   USE lmdz_lscp_ini, ONLY: cld_tau_lsc, cld_tau_con, cld_lc_lsc, cld_lc_con
   USE lmdz_lscp_ini, ONLY: reevap_ice, iflag_bergeron, iflag_fisrtilp_qsat, iflag_pdf 
-      use phys_output_var_mod, ONLY: cloudth_sth,cloudth_senv
-      use phys_output_var_mod, ONLY: cloudth_sigmath,cloudth_sigmaenv
+      USE phys_output_var_mod, ONLY: cloudth_sth,cloudth_senv
+      USE phys_output_var_mod, ONLY: cloudth_sigmath,cloudth_sigmaenv
 
 
@@ -56,8 +56,8 @@
 #endif
 #ifdef ISOTRAC
-    use isotrac_mod, ONLY: option_traceurs,option_tmin,seuil_tag_tmin_ls, &
+    USE isotrac_mod, ONLY: option_traceurs,option_tmin,seuil_tag_tmin_ls, &
 &       izone_poubelle, option_cond,izone_cond,index_iso, index_zone,izone_oce,izone_ddft
-    use isotrac_routines_mod, ONLY: iso_recolorise_condensation
-    use isotopes_routines_mod, ONLY: condiso_liq_ice_vectall_trac
+    USE isotrac_routines_mod, ONLY: iso_recolorise_condensation
+    USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall_trac
 #ifdef ISOVERIF
   USE isotopes_verif_mod, ONLY: iso_verif_traceur_nostop,iso_verif_traceur
@@ -131,15 +131,15 @@
 
 #ifdef ISO
-      real double_to_real
+      REAL double_to_real
       double precision real_to_double
       !integer niso
-      real xt(ntraciso,klon,klev)
-      real d_xt(ntraciso,klon,klev)
-      real d_xtl(ntraciso,klon,klev)
-      real d_xti(ntraciso,klon,klev)
-      real xtrain(ntraciso,klon)
-      real xtsnow(ntraciso,klon)
-      real pxtrainfl(ntraciso,klon,klev+1)
-      real pxtsnowfl(ntraciso,klon,klev+1)      
+      REAL xt(ntraciso,klon,klev)
+      REAL d_xt(ntraciso,klon,klev)
+      REAL d_xtl(ntraciso,klon,klev)
+      REAL d_xti(ntraciso,klon,klev)
+      REAL xtrain(ntraciso,klon)
+      REAL xtsnow(ntraciso,klon)
+      REAL pxtrainfl(ntraciso,klon,klev+1)
+      REAL pxtsnowfl(ntraciso,klon,klev+1)
       ! xt <-> q
       ! xtrain et xtsonw <-> rain et snow
@@ -192,5 +192,5 @@
 
   REAL qsl, qsi
-  real zct      ,zcl
+  REAL zct      ,zcl
   INTEGER ncoreczq  
   REAL ctot(klon,klev)
@@ -200,13 +200,13 @@
   REAL Tbef(klon),qlbef(klon),DT(klon),num,denom
 
-  logical lognormale(klon)
-  logical ice_thermo
+  LOGICAL lognormale(klon)
+  LOGICAL ice_thermo
   LOGICAL convergence(klon)
   INTEGER n_i(klon), iter
   REAL cste
 
-  real zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon)
-  real Zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon)
-  real erf   
+  REAL zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon)
+  REAL Zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon)
+  REAL erf
   REAL qcloud(klon)
  
@@ -234,15 +234,15 @@
 
 #ifdef ISO
-      real zxtrfl(ntraciso,klon)
-      real zxtrfln(ntraciso,klon)
+      REAL zxtrfl(ntraciso,klon)
+      REAL zxtrfln(ntraciso,klon)
       REAL zxtifl(ntraciso,klon), zxtifln(ntraciso,klon)  
-      real zxt(ntraciso,klon) ! equivalent local de xt
-      real zxtn(ntraciso,klon) ! isotpes nuageux
-      real zxtn_reduit(niso)
-      real zxtcond(ntraciso,klon)
-      real zxtoliq(ntraciso,klon)
-      real zq_ancien(klon)
+      REAL zxt(ntraciso,klon) ! equivalent local de xt
+      REAL zxtn(ntraciso,klon) ! isotpes nuageux
+      REAL zxtn_reduit(niso)
+      REAL zxtcond(ntraciso,klon)
+      REAL zxtoliq(ntraciso,klon)
+      REAL zq_ancien(klon)
       REAL zxtpreci(ntraciso,klon), zxtprecl(ntraciso,klon)
-      integer ixt
+      INTEGER ixt
 #ifdef ISOVERIF   
 !      integer iso_verif_aberrant_nostop
@@ -250,25 +250,25 @@
 !      integer iso_verif_positif_nostop
 !      integer iso_verif_positif_choix_nostop
-      integer trace_cas(klon)
+      INTEGER trace_cas(klon)
 !      integer iso_verif_traceur_nostop
 #endif      
-      integer iso_verif_nonan_nostop
-      real zxtice(ntraciso,klon),zxtliq(ntraciso,klon)
-      real zrfl_ancien(klon)
-      real zqev_diag(klon)
-      real zxtrfl_ancien(ntraciso,klon)
-      real zxt_ancien(ntraciso,klon)
+      INTEGER iso_verif_nonan_nostop
+      REAL zxtice(ntraciso,klon),zxtliq(ntraciso,klon)
+      REAL zrfl_ancien(klon)
+      REAL zqev_diag(klon)
+      REAL zxtrfl_ancien(ntraciso,klon)
+      REAL zxt_ancien(ntraciso,klon)
 #ifdef ISOTRAC
-        real zxtres(ntraciso) ! humidite spec nuageuse après condensation et precip
-        real zqcs(klon) ! humidite spec en ciel clair
-        real zxtcs(ntraciso,klon)        
-        real zcondn(klon) ! humidite spec de l'eau liquide dans le nuage
-        real zxtcondn(ntraciso,klon)
-        integer izone
+        REAL zxtres(ntraciso) ! humidite spec nuageuse après condensation et precip
+        REAL zqcs(klon) ! humidite spec en ciel clair
+        REAL zxtcs(ntraciso,klon)
+        REAL zcondn(klon) ! humidite spec de l'eau liquide dans le nuage
+        REAL zxtcondn(ntraciso,klon)
+        INTEGER izone
 #ifdef ISOVERIF           
-        real zq_verif
+        REAL zq_verif
 #endif        
 #endif 
-!      logical negation ! pour nier conditions logiques
+!      LOGICAL negation ! pour nier conditions logiques
 #endif
 
@@ -329,5 +329,5 @@
   rneblsvol(1:klon,1:klev)=0.0
 
-  if (prt_level>9)WRITE(lunout,*)'NUAGES4 A. JAM'
+  IF (prt_level>9)WRITE(lunout,*)'NUAGES4 A. JAM'
   IF (appel1er) THEN
      CALL getin_p('iflag_oldbug_fisrtilp',iflag_oldbug_fisrtilp)
@@ -353,10 +353,10 @@
           do k=1,klev
            do i=1,klon             
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
                          'il pleut 205',errmax,errmaxrel)
             endif !if (iso_eau.gt.0) THEN
-            if (iso_HDO.gt.0) THEN
-             if (q(i,k).gt.ridicule) THEN
+            IF (iso_HDO.gt.0) THEN
+             IF (q(i,k).gt.ridicule) THEN
                CALL iso_verif_aberrant(xt(iso_HDO,i,k)/q(i,k), &
                  'il pleut 210')
@@ -510,10 +510,10 @@
        !WRITE(*,*) 'ilp 478: boucle en k: k=',k
        do i=1,klon
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite_choix(zxtrfl(iso_eau,i), &
                  zrfl(i), &
                  'il pleut 310',errmax,errmaxrel)
         endif !if (iso_eau.gt.0) THEN
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
              CALL iso_verif_aberrant_choix(zxtrfl(iso_HDO,i) &
                  ,zrfl(i),ridicule_rain,deltalim_snow,'il pleut 316')
@@ -546,5 +546,5 @@
         zq(i)=q(i,k)
 #ifdef ISOVERIF
-        if (q(i,k).lt.0.0) THEN
+        IF (q(i,k).lt.0.0) THEN
                WRITE(*,*) 'ilp 400: avant clmain 31janv: i,k,q=', &
                  i,k,q(i,k)
@@ -570,10 +570,10 @@
              CALL iso_verif_positif(370.0-zt(i),'il pleut 425')
              CALL iso_verif_positif(zt(i)-100.0,'il pleut 426')
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(zxt(iso_eau,i),zq(i), &
                          'il pleut 289',errmax,errmaxrel)
           endif !if (iso_eau.gt.0) THEN
-          if (iso_HDO.gt.0) THEN
-             if (zq(i).gt.ridicule) THEN
+          IF (iso_HDO.gt.0) THEN
+             IF (zq(i).gt.ridicule) THEN
                CALL iso_verif_aberrant(zxt(iso_HDO,i)/zq(i), &
                  'il pleut 337')
@@ -609,5 +609,5 @@
            zcpair=RCPD*(1.0+RVTMP2*zq(i))
            zcpeau=RCPD*RVTMP2
-         if (fl_cor_ebil > 0) THEN
+         IF (fl_cor_ebil > 0) THEN
            ! zmqc: masse de precip qui doit etre thermalisee avec l'air de la couche atm 
            ! pour s'assurer que la precip arrivant au sol aura bien la temperature de la 
@@ -653,5 +653,5 @@
 #ifdef ISOVERIF
         !WRITE(*,*) 'ilp tmp 616'
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
        DO i = 1, klon           
           CALL iso_verif_egalite_choix(zxt(iso_eau,i),zq(i), &
@@ -707,5 +707,5 @@
              ! Ajout de la prise en compte des precip a thermiser
              ! avec petite reecriture 
-             if  (fl_cor_ebil > 0) then ! nouveau
+             IF  (fl_cor_ebil > 0) then ! nouveau
                 ! Calcul de l'evaporation du flux de precip herite
                 !   d'au-dessus
@@ -718,5 +718,5 @@
                 zrfln(i) = zrfl(i) - zqev*zmair(i)/dtime
                 ! Aucun flux liquide pour T < t_coup, on reevapore tout.
-                IF (zt(i) < t_coup.and.reevap_ice) THEN
+                IF (zt(i) < t_coup.AND.reevap_ice) THEN
                   zrfln(i)=0.
                   zqev = (zrfl(i)-zrfln(i))/zmair(i)*dtime
@@ -742,5 +742,5 @@
                      /RG/dtime
                 ! Aucun flux liquide pour T < t_coup
-                IF (zt(i) < t_coup.and.reevap_ice) zrfln(i)=0.
+                IF (zt(i) < t_coup.AND.reevap_ice) zrfln(i)=0.
                 ! Nouvelle vapeur 
                 zq(i) = zq(i) - (zrfln(i)-zrfl(i)) &
@@ -872,5 +872,5 @@
          zq(i) = zq(i) - (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
                   * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-       if (fl_cor_ebil > 0) then ! avec correction thermalisation des precips
+       IF (fl_cor_ebil > 0) then ! avec correction thermalisation des precips
          zmqc(i) = zmqc(i) + (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
                   * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
@@ -903,5 +903,5 @@
            ! Fusion de la glace
            zrfl(i)=zrfl(i)+zmelt*zifl(i)
-           if (fl_cor_ebil <= 0) THEN
+           IF (fl_cor_ebil <= 0) THEN
              ! the following line should not be here. Indeed, if zifl is modified
              ! now, zifl(i)*zmelt is no more the amount of ice that has melt
@@ -910,5 +910,5 @@
            end if
            ! Chaleur latente de fusion
-        if (fl_cor_ebil > 0) then ! avec correction thermalisation des precips
+        IF (fl_cor_ebil > 0) then ! avec correction thermalisation des precips
            zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
                       *RLMLT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
@@ -917,5 +917,5 @@
                       *RLMLT/RCPD/(1.0+RVTMP2*zq(i))
         end if
-           if (fl_cor_ebil > 0) then ! correction bug, deplacement ligne precedente
+           IF (fl_cor_ebil > 0) then ! correction bug, deplacement ligne precedente
              zifl(i)=zifl(i)*(1.-zmelt)
            end if
@@ -944,11 +944,11 @@
               CALL iso_verif_positif_choix(zxt(ixt,i),0.0,'ilp 614')
              enddo   
-             if (zq(i).gt.ridicule) THEN
-               if (iso_HDO.gt.0) THEN
+             IF (zq(i).gt.ridicule) THEN
+               IF (iso_HDO.gt.0) THEN
                   CALL iso_verif_aberrant_encadre(zxt(iso_HDO,i)/zq(i), &
                          'il pleut 856')
-                  if (iso_O18.gt.0) THEN
-                   if (iso_verif_O18_aberrant_nostop(zxt(iso_HDO,i)/zq(i), &
-                     zxt(iso_O18,i)/zq(i),'il pleut 859').eq.1) THEN
+                  IF (iso_O18.gt.0) THEN
+                   IF (iso_verif_O18_aberrant_nostop(zxt(iso_HDO,i)/zq(i), &
+                     zxt(iso_O18,i)/zq(i),'il pleut 859').EQ.1) THEN
                      WRITE(*,*) 'i,k,zq=',i,k,zq(i)
                      WRITE(*,*) 'zqev_diag(i)=',zqev_diag(i)
@@ -989,5 +989,5 @@
            zdelta = MAX(0.,SIGN(1.,RTT-zt(i)))
            zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-       if  (fl_cor_ebil .GT. 0) then ! nouveau
+       IF  (fl_cor_ebil .GT. 0) then ! nouveau
            zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
        else    
@@ -1018,5 +1018,5 @@
 
 !verification de la valeur de iflag_fisrtilp_qsat pour iflag_ice_thermo=1
-!       if ((iflag_ice_thermo.eq.1).and.(iflag_fisrtilp_qsat.ne.0)) THEN
+!       if ((iflag_ice_thermo.EQ.1).AND.(iflag_fisrtilp_qsat.NE.0)) THEN
 !         WRITE(*,*) " iflag_ice_thermo==1 requires iflag_fisrtilp_qsat==0", &
 !        " but iflag_fisrtilp_qsat=",iflag_fisrtilp_qsat, ". Might as well stop here."
@@ -1056,7 +1056,7 @@
 #ifdef ISOVERIF
         do i=1,klon
-          if (iso_eau.gt.0) THEN
-            if (iso_verif_egalite_choix_nostop(zxt(iso_eau,i),zq(i), &
-                  'il pleut 608',errmax,errmaxrel).eq.1) THEN
+          IF (iso_eau.gt.0) THEN
+            IF (iso_verif_egalite_choix_nostop(zxt(iso_eau,i),zq(i), &
+                  'il pleut 608',errmax,errmaxrel).EQ.1) THEN
               WRITE(*,*) 'i=',i
               stop
@@ -1070,5 +1070,5 @@
 #endif 
 
-        if (iflag_pdf.eq.0) THEN
+        IF (iflag_pdf.EQ.0) THEN
            ! version creneau de (Li, 1998)
            do i=1,klon
@@ -1078,5 +1078,5 @@
            enddo
 
-        else !  if (iflag_pdf.eq.0)
+        else !  if (iflag_pdf.EQ.0)
            ! ----------------------------------------------------------------
            ! P2.A.1> Avec les nouvelles PDFs, calcul des grandeurs nuageuses pour 
@@ -1092,5 +1092,5 @@
 #ifdef ISO
                 ! on conserve le même rapport pour les isotopes
-                if (zq_ancien(i).gt.0.0) THEN
+                IF (zq_ancien(i).gt.0.0) THEN
                    do ixt=1,ntraciso
                      zxt(ixt,i)=zxt(ixt,i)/zq_ancien(i)*zq(i)
@@ -1104,5 +1104,5 @@
                 ! verif
 #ifdef ISOVERIF
-                  if (iso_eau.gt.0) THEN
+                  IF (iso_eau.gt.0) THEN
                     CALL iso_verif_egalite_choix(zxt(iso_eau,i),zq(i), &
                        'il pleut 654',errmax,errmaxrel)
@@ -1117,6 +1117,6 @@
            enddo
 
-           if (iflag_cld_th>=5) THEN
-              if (iflag_cloudth_vert<=2) THEN
+           IF (iflag_cld_th>=5) THEN
+              IF (iflag_cloudth_vert<=2) THEN
                CALL cloudth(klon,klev,k,ztv, &
                    zq,zqta,fraca, &
@@ -1125,5 +1125,5 @@
                    cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
 
-              elseif (iflag_cloudth_vert>=3 .and. iflag_cloudth_vert<=5) THEN
+              elseif (iflag_cloudth_vert>=3 .AND. iflag_cloudth_vert<=5) THEN
                CALL cloudth_v3(klon,klev,k,ztv, &
                    zq,zqta,fraca, &
@@ -1152,5 +1152,5 @@
            endif
 
-           if (iflag_cld_th <= 4) THEN
+           IF (iflag_cld_th <= 4) THEN
               lognormale = .TRUE.
            elseif (iflag_cld_th >= 6) THEN
@@ -1187,5 +1187,5 @@
 
 !Boucle iterative: ATTENTION, l'option -1 n'est plus activable ici
-           if (iflag_fisrtilp_qsat.ge.0) THEN
+           IF (iflag_fisrtilp_qsat.ge.0) THEN
              ! Iteration pour condensation avec variation de qsat(T) 
              ! -----------------------------------------------------
@@ -1193,9 +1193,9 @@
                 
                do i=1,klon
-!                 do while ((abs(DT(i)).gt.DDT0).or.(n_i(i).eq.0))
+!                 do while ((abs(DT(i)).gt.DDT0).OR.(n_i(i).EQ.0))
                  ! !! convergence = .TRUE. tant que l'on n'a pas converge !!
                  ! ------------------------------
                  convergence(i)=abs(DT(i)).gt.DDT0
-                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) THEN
+                 IF ((convergence(i).OR.(n_i(i).EQ.0)).AND.lognormale(i)) THEN
                  ! si on n'a pas converge
 
@@ -1209,11 +1209,11 @@
 
                  Tbef(i)=Tbef(i)+DT(i) ! nouvelle temperature
-                 if (.not.ice_thermo) THEN
+                 IF (.NOT.ice_thermo) THEN
                     zdelta = MAX(0.,SIGN(1.,RTT-Tbef(i)))
                  else
-                    if (iflag_t_glace.eq.0) THEN
+                    IF (iflag_t_glace.EQ.0) THEN
                     zdelta = MAX(0.,SIGN(1.,t_glace_min_old-Tbef(i)))
-                    else if (iflag_t_glace.ge.1) THEN
-                       if (iflag_oldbug_fisrtilp.EQ.0) THEN
+                    ELSE IF (iflag_t_glace.ge.1) THEN
+                       IF (iflag_oldbug_fisrtilp.EQ.0) THEN
                           zdelta = MAX(0.,SIGN(1.,t_glace_max-Tbef(i)))
                        else
@@ -1225,5 +1225,5 @@
                  ! Calcul de rneb, qzn et zcond pour les PDF lognormales
                  zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-               if (fl_cor_ebil .GT. 0) THEN
+               IF (fl_cor_ebil .GT. 0) THEN
                  zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
                else
@@ -1247,5 +1247,5 @@
                  zpdf_e2(i)=1.-erf(zpdf_e2(i))
              
-                 if (zpdf_e1(i).lt.1.e-10) THEN
+                 IF (zpdf_e1(i).lt.1.e-10) THEN
                     rneb(i,k)=0.
                     zqn(i)=zqs(i)
@@ -1256,5 +1256,5 @@
 
                  ! If vertical heterogeneity, change fraction by volume as well
-                 if (iflag_cloudth_vert>=3) THEN
+                 IF (iflag_cloudth_vert>=3) THEN
                    ctot_vol(i,k)=rneb(i,k)
                    rneblsvol(i,k)=ctot_vol(i,k)
@@ -1271,10 +1271,10 @@
                  ! DT : variation de temperature due a la condensation 
 
-                 if (.not. ice_thermo) THEN
+                 IF (.NOT. ice_thermo) THEN
                  ! --------------------------
                  do i=1,klon
-                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) THEN
+                 IF ((convergence(i).OR.(n_i(i).EQ.0)).AND.lognormale(i)) THEN
                  qlbef(i)=max(0.,zqn(i)-zqs(i))
-               if (fl_cor_ebil .GT. 0) THEN
+               IF (fl_cor_ebil .GT. 0) THEN
                  num=-Tbef(i)+zt(i)+rneb(i,k)*RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*qlbef(i)
                else
@@ -1287,13 +1287,13 @@
                  enddo
 
-                 else ! if (.not. ice_thermo)
+                 else ! if (.NOT. ice_thermo)
                  ! --------------------------
-                 if (iflag_t_glace.ge.1) THEN
+                 IF (iflag_t_glace.ge.1) THEN
                  CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
                  endif
 
                  do i=1,klon
-                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) THEN
-                 if (iflag_t_glace.eq.0) THEN
+                 IF ((convergence(i).OR.(n_i(i).EQ.0)).AND.lognormale(i)) THEN
+                 IF (iflag_t_glace.EQ.0) THEN
                     zfice(i) = 1.0 - (Tbef(i)-t_glace_min_old) / (RTT-t_glace_min_old)
                     zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
@@ -1303,14 +1303,14 @@
                  endif
                  
-                 if (iflag_t_glace.ge.1.and.zfice(i)>0.) THEN
+                 IF (iflag_t_glace.ge.1.AND.zfice(i)>0.) THEN
                  dzfice(i)= exposant_glace * zfice(i)**(exposant_glace-1) &
                                / (t_glace_min - t_glace_max)
                  endif
                
-                 if ((zfice(i).eq.0).or.(zfice(i).eq.1)) THEN
+                 IF ((zfice(i).EQ.0).OR.(zfice(i).EQ.1)) THEN
                     dzfice(i)=0.
                  endif
 
-                 if (zfice(i).lt.1) THEN
+                 IF (zfice(i).lt.1) THEN
                     cste=RLVTT
                  else
@@ -1319,5 +1319,5 @@
 
                  qlbef(i)=max(0.,zqn(i)-zqs(i))
-               if (fl_cor_ebil .GT. 0) THEN
+               IF (fl_cor_ebil .GT. 0) THEN
                  num = -Tbef(i)+zt(i)+rneb(i,k)*((1-zfice(i))*RLVTT &
                       +zfice(i)*RLSTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*qlbef(i)
@@ -1349,10 +1349,10 @@
         endif ! iflag_pdf
 
-!        if (iflag_fisrtilp_qsat.eq.-1) THEN
+!        if (iflag_fisrtilp_qsat.EQ.-1) THEN
 !------------------------------------------
 !CR: ATTENTION option fausse mais a existe:
 ! pour la re-activer, prendre iflag_fisrtilp_qsat=0 et
 ! activer les lignes suivantes: 
-       IF (1.eq.0) THEN 
+       IF (1.EQ.0) THEN
        DO i=1,klon
            IF (rneb(i,k) .LE. 0.0) THEN
@@ -1405,5 +1405,5 @@
         ENDDO
         ! If vertical heterogeneity, change fraction by volume as well
-        if (iflag_cloudth_vert>=3) THEN
+        IF (iflag_cloudth_vert>=3) THEN
           ctot_vol(1:klon,k)=min(max(ctot_vol(1:klon,k),0.),1.)
           rneblsvol(1:klon,k)=ctot_vol(1:klon,k)
@@ -1437,12 +1437,12 @@
          do i=1,klon  
 #ifdef ISOTRAC
-            if (option_tmin.eq.1) THEN
+            IF (option_tmin.EQ.1) THEN
                 ! c'est mieux si zqn>=0.0
-            if (essai_convergence) THEN
+            IF (essai_convergence) THEN
             else
                 zqn(i)=max(0.0,zqn(i))
             endif    
 
-            if (rneb(i,k).lt.1.0) THEN
+            IF (rneb(i,k).lt.1.0) THEN
                 zqcs(i)=(zq(i)-zqn(i)*rneb(i,k))/(1.0-rneb(i,k))
 #ifdef ISOVERIF
@@ -1454,8 +1454,8 @@
                 zqcs(i)=0.0
             endif
-            endif ! if (option_tmin.eq.1) THEN
+            endif ! if (option_tmin.EQ.1) THEN
 #endif                  
 #ifdef ISOVERIF
-              if (iso_eau.gt.0) THEN
+              IF (iso_eau.gt.0) THEN
                  CALL iso_verif_egalite_choix(zxt(iso_eau,i),zq(i), &
                          'il pleut 748',errmax,errmaxrel)
@@ -1469,5 +1469,5 @@
 #endif              
 #endif
-              if ((bidouille_anti_divergence).and. &
+              IF ((bidouille_anti_divergence).AND. &
                  (iso_eau.gt.0)) THEN
                 zxt(iso_eau,i)= max(zq(i),0.0)  
@@ -1481,7 +1481,7 @@
 !                    enddo    
 !                endif !if (zxt(iso_eau,i).gt.0.0) THEN
-              endif !if ((bidouille_anti_divergence).and. 
-
-              if (zq(i).gt.1e-15) THEN
+              endif !if ((bidouille_anti_divergence).AND.
+
+              IF (zq(i).gt.1e-15) THEN
                 ! 2 fev 2010: on modifie seuil de zq  
                 ! avant, c'était 0. Vérifier que ça n'a pas de
@@ -1491,9 +1491,9 @@
                 enddo !do ixt=1,niso         
 #ifdef ISOTRAC
-               if (option_tmin.eq.1) THEN
+               IF (option_tmin.EQ.1) THEN
                  do ixt=1,ntraciso
                    zxtcs(ixt,i)=(zqcs(i))*(zxt(ixt,i)/zq(i))
                  enddo !do ixt=1,ntraciso
-               endif ! if (option_tmin.eq.1) THEN
+               endif ! if (option_tmin.EQ.1) THEN
 #endif                
               else !if (zq(i).gt.0.0) THEN
@@ -1504,19 +1504,19 @@
                 enddo !do ixt=1,niso 
 #ifdef ISOTRAC
-                if (option_tmin.eq.1) THEN
+                IF (option_tmin.EQ.1) THEN
                  do ixt=1,ntraciso
                    zxtcs(ixt,i)=0.0
                  enddo !do ixt=1,niso    
-                endif ! if (option_tmin.eq.1) THEN
+                endif ! if (option_tmin.EQ.1) THEN
 #endif                     
-                if ((bidouille_anti_divergence) &
-                         .and.(iso_eau.gt.0)) THEN
+                IF ((bidouille_anti_divergence) &
+                         .AND.(iso_eau.gt.0)) THEN
 !                   WRITE(*,*) 'ilp tmp 848: warning: bidouille'
                    zxtn(iso_eau,i)=zqn(i)
 #ifdef ISOTRAC
                    zxtn(itZonIso(izone_poubelle,iso_eau),i)=zqn(i)  
-                   if (option_tmin.eq.1) THEN
+                   IF (option_tmin.EQ.1) THEN
                      zxtcs(iso_eau,i)=zqcs(i)
-                   endif ! if (option_tmin.eq.1) THEN
+                   endif ! if (option_tmin.EQ.1) THEN
 !                   WRITE(*,*) 'zxtn(:,i)=',zxtn(:,i)
 #endif                   
@@ -1527,5 +1527,5 @@
                   CALL iso_verif_positif(zxtn(ixt,i),'il pleut 1062')
              enddo !do ixt=1,niso
-             if (iso_eau.gt.0) THEN
+             IF (iso_eau.gt.0) THEN
                    CALL iso_verif_egalite_choix(zxtn(iso_eau,i),zqn(i), &
                          'il pleut 932',errmax,errmaxrel)
@@ -1536,14 +1536,14 @@
              CALL iso_verif_traceur_pbidouille(zxtn(1,i), &
                  'il pleut 1277')
-             if (option_tmin.eq.1) THEN
+             IF (option_tmin.EQ.1) THEN
               CALL iso_verif_positif(zxtcs(ixt,i),'il pleut 895')
               do ixt=1,niso     
                CALL iso_verif_positif(zxtcs(ixt,i),'il pleut 897')
               enddo !do ixt=1,niso
-              if (iso_eau.gt.0) THEN
+              IF (iso_eau.gt.0) THEN
                CALL iso_verif_egalite_choix(zxtcs(iso_eau,i), &
                     zqcs(i),'il pleut 733',errmax,errmaxrel)
               endif !if ((iso_eau.gt.0)) THEN
-             endif ! if (option_tmin.eq.1) THEN
+             endif ! if (option_tmin.EQ.1) THEN
 #endif 
 #endif                   
@@ -1555,18 +1555,18 @@
               enddo !do ixt=1,niso
 #ifdef ISOTRAC
-              if (option_tmin.eq.1) THEN
+              IF (option_tmin.EQ.1) THEN
               do ixt=1,ntraciso
                zxtcs(ixt,i)=max(0.0,zxtcs(ixt,i))
               enddo
-              endif ! if (option_tmin.eq.1) THEN
+              endif ! if (option_tmin.EQ.1) THEN
 #endif                            
 
 #ifdef ISOVERIF
-               if (iso_eau.gt.0) THEN
+               IF (iso_eau.gt.0) THEN
                   CALL iso_verif_egalite_choix(zxtn(iso_eau,i),zqn(i), &
                          'il pleut 746',errmax,errmaxrel)
                endif !if (iso_eau.gt.0) THEN
-               if (iso_HDO.gt.0) THEN
-                if (zqn(i).gt.ridicule) THEN
+               IF (iso_HDO.gt.0) THEN
+                IF (zqn(i).gt.ridicule) THEN
                    CALL iso_verif_aberrant(zxtn(iso_HDO,i)/zqn(i), &
                          'il pleut 977')
@@ -1576,6 +1576,6 @@
              CALL iso_verif_traceur_pbidouille  &
                         (zxtn(1,i),'il pleut 1300')
-             if (option_tmin.eq.1) THEN
-               if (iso_eau.gt.0) THEN
+             IF (option_tmin.EQ.1) THEN
+               IF (iso_eau.gt.0) THEN
                    CALL iso_verif_egalite_choix(zxtcs(iso_eau,i), &
                          zqcs(i), &
@@ -1585,5 +1585,5 @@
                         (zxtcs(1,i),'il pleut 1300')
              
-             endif ! if (option_tmin.eq.1) THEN
+             endif ! if (option_tmin.EQ.1) THEN
 #endif                
 #endif   
@@ -1607,11 +1607,11 @@
 
      IF (.NOT. ice_thermo) THEN
-        if (iflag_fisrtilp_qsat.lt.1) THEN
+        IF (iflag_fisrtilp_qsat.lt.1) THEN
            DO i = 1, klon
              zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
            ENDDO
-        else if (iflag_fisrtilp_qsat.gt.0) THEN
+        ELSE IF (iflag_fisrtilp_qsat.gt.0) THEN
            DO i= 1, klon
-    if (fl_cor_ebil .GT. 0) THEN
+    IF (fl_cor_ebil .GT. 0) THEN
              zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
     else
@@ -1621,13 +1621,13 @@
         endif
      ELSE
-         if (iflag_t_glace.ge.1) THEN
+         IF (iflag_t_glace.ge.1) THEN
             CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
          endif
-         if (iflag_fisrtilp_qsat.lt.1) THEN
+         IF (iflag_fisrtilp_qsat.lt.1) THEN
            DO i = 1, klon
 ! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
 !              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
 !                                     t_glace_max, exposant_glace)
-              if (iflag_t_glace.eq.0) THEN
+              IF (iflag_t_glace.EQ.0) THEN
                     zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (RTT-t_glace_min_old)
                     zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
@@ -1642,10 +1642,10 @@
 !              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
 !                                     t_glace_max, exposant_glace)
-              if (iflag_t_glace.eq.0) THEN
+              IF (iflag_t_glace.EQ.0) THEN
                     zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (RTT-t_glace_min_old)
                     zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
                     zfice(i) = zfice(i)**exposant_glace_old
               endif
-        if (fl_cor_ebil .GT. 0) THEN
+        IF (fl_cor_ebil .GT. 0) THEN
               zt(i) = zt(i) + (1.-zfice(i))*zcond(i) & 
                          * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i))) &
@@ -1667,5 +1667,5 @@
       do i=1,klon
         ! verif
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
           CALL iso_verif_egalite_choix(zxtn(iso_eau,i),zqn(i), &
                  'il pleut 810',errmax,errmaxrel)
@@ -1728,5 +1728,5 @@
 #endif       
 #ifdef ISOVERIF       
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
           do i=1,klon      
               CALL iso_verif_egalite_choix(zxtcond(iso_eau,i),zcond(i), &
@@ -1734,14 +1734,14 @@
           enddo ! do i=1,klon     
         endif
-        if (iso_HDO.gt.0) THEN
+        IF (iso_HDO.gt.0) THEN
            do i=1,klon  
                   CALL iso_verif_aberrant_choix(zxtcond(iso_hdo,i), &
                  zcond(i),ridicule_rain,deltalim_snow,'il pleut 1276')
            enddo ! do i=1,klon  
-        endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
+        endif !if ((iso_eau.gt.0).AND.(ixt.EQ.iso_eau)) THEN
 #ifdef ISOTRAC
         do i=1,klon
-             if (iso_verif_traceur_nostop(zxtcond(1,i),'il pleut 1455') &
-                         .eq.1) THEN
+             IF (iso_verif_traceur_nostop(zxtcond(1,i),'il pleut 1455') &
+                         .EQ.1) THEN
                WRITE(*,*) 'zxtn(:,i)=',zxtn(:,i)
                WRITE(*,*) 'zxt(:,i)=',zxt(:,i)
@@ -1776,5 +1776,5 @@
 
 #ifdef ISOTRAC        
-        if (option_tmin.ge.1) THEN
+        IF (option_tmin.ge.1) THEN
         do i=1,klon    
         ! colorier la vapeur résiduelle selon température de
@@ -1785,11 +1785,11 @@
         ! le condensat, car la condensation LS est un processus sous
         ! maille -> ne tagguer que le résidus de qn.
-          if ((zcond(i).gt.0.0).and.(zq(i).gt.0.0)) THEN
-            if (rneb(i,k).gt.0.0) THEN
+          IF ((zcond(i).gt.0.0).AND.(zq(i).gt.0.0)) THEN
+            IF (rneb(i,k).gt.0.0) THEN
               zcondn(i)=zcond(i)/rneb(i,k)
               do ixt=1,ntraciso
                 zxtcondn(ixt,i)=zxtcond(ixt,i)/rneb(i,k)
               enddo !do ixt=1,ntraciso
-            else !if (rneb.eq.0.0)
+            else !if (rneb.EQ.0.0)
               zcondn(i)=0.0
               do ixt=1,ntraciso
@@ -1799,5 +1799,5 @@
               CALL iso_verif_egalite(zcond(i),0.0,'ilp 1225')
 #endif              
-            endif !if (rneb.eq.0.0)
+            endif !if (rneb.EQ.0.0)
             
 #ifdef ISOVERIF
@@ -1816,5 +1816,5 @@
 #endif            
           ! bidouille
-          if (bidouille_anti_divergence) THEN
+          IF (bidouille_anti_divergence) THEN
                 zxtcondn(iso_eau,i)=zcondn(i)
 #ifdef ISOVERIF                
@@ -1824,14 +1824,14 @@
           endif
 
-            if (option_traceurs.eq.17) THEN
+            IF (option_traceurs.EQ.17) THEN
             CALL iso_recolorise_condensation(zqn(i),zcondn(i), &
                  zxtn(1,i),zxtcondn(1,i),zt(i),1.0,zxtres, &
                  seuil_tag_tmin_ls)
-            else !if (option_traceurs.eq.17) THEN
+            else !if (option_traceurs.EQ.17) THEN
                 ! cas du tag 18 ou 19
                 CALL iso_recolorise_condensation(zqn(i),zcondn(i), &
                  zxtn(1,i),zxtcondn(1,i),zqs(i),1.0,zxtres, &
                  seuil_tag_tmin_ls)
-            endif !if (option_traceurs.eq.17) THEN
+            endif !if (option_traceurs.EQ.17) THEN
             do ixt=1+niso,ntraciso
                zxt(ixt,i)=rneb(i,k)*zxtres(ixt) &
@@ -1841,11 +1841,11 @@
          CALL iso_verif_traceur(zxt(1,i),'ilp 1025')
          do izone=izone_oce,izone_ddft
-          if ((izone.eq.izone_oce).or.(izone.eq.izone_ddft)) THEN
+          IF ((izone.EQ.izone_oce).OR.(izone.EQ.izone_ddft)) THEN
            ! avec condensation, on ne peut que perdre des traceurs à
            ! part le tag résuel et le condensat
-           if (iso_verif_positif_choix_nostop( &
+           IF (iso_verif_positif_choix_nostop( &
                  zxt_ancien(itZonIso(izone,iso_eau),i) &
                 -zxt(itZonIso(izone,iso_eau),i),1e-8,'ilp 1270') &
-                .eq.1) THEN
+                .EQ.1) THEN
             WRITE(*,*) 'i,izone,rneb=',i,izone,rneb(i,k)
             WRITE(*,*) 'zxt(:,i)=',zxt(:,i)
@@ -1858,5 +1858,5 @@
             stop
            endif !if (iso_verif_positif_nostop(
-          endif !if ((izone.eq.izone_oce).or.(izone.eq.izone_ddft)) THEN
+          endif !if ((izone.EQ.izone_oce).OR.(izone.EQ.izone_ddft)) THEN
          enddo !do izone=izone_oce,izone_revap
 #endif                     
@@ -1869,9 +1869,9 @@
 #endif        
         endif ! if (option_tmin.ge.1) THEN
-        if (option_cond.eq.1) THEN
+        IF (option_cond.EQ.1) THEN
         ! colorier le condensat en un tag spécifique
         do i=1,klon        
           do ixt=1+niso,ntraciso
-            if (index_zone(ixt).eq.izone_cond) THEN
+            IF (index_zone(ixt).EQ.izone_cond) THEN
               zxtcond(ixt,i)=zxtcond(index_iso(ixt),i)
             else
@@ -1904,15 +1904,15 @@
          enddo !do ixt=1,niso
 #endif
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(zxt(iso_eau,i),zq(i), &
                          'il pleut 644',errmax,errmaxrel)
          endif !if (iso_eau.gt.0) THEN
-         if (iso_HDO.gt.0) THEN
-            if (zq(i).gt.ridicule) THEN
+         IF (iso_HDO.gt.0) THEN
+            IF (zq(i).gt.ridicule) THEN
              CALL iso_verif_aberrant_encadre(zxt(iso_HDO,i)/zq(i), &
                          'il pleut 648')
-              if (iso_O18.gt.0) THEN
-                if (iso_verif_O18_aberrant_nostop(zxt(iso_HDO,i)/zq(i), &
-                 zxt(iso_O18,i)/zq(i),'il pleut 2059').eq.1) THEN
+              IF (iso_O18.gt.0) THEN
+                IF (iso_verif_O18_aberrant_nostop(zxt(iso_HDO,i)/zq(i), &
+                 zxt(iso_O18,i)/zq(i),'il pleut 2059').EQ.1) THEN
                    WRITE(*,*) 'i,k,zq=',i,k,zq(i)
                    stop
@@ -1994,5 +1994,5 @@
       ! tombent
       do i=1,klon
-         if (rneb(i,k).gt.0.0) THEN
+         IF (rneb(i,k).gt.0.0) THEN
             do ixt=1,ntraciso
                zxtoliq(ixt,i)=zxtcond(ixt,i)
@@ -2005,6 +2005,6 @@
        do i=1,klon   
          do ixt=1,ntraciso
-           if (iso_verif_noNAN_nostop(zxtoliq(ixt,i), &
-                 'il pleut 1628').eq.1) THEN
+           IF (iso_verif_noNAN_nostop(zxtoliq(ixt,i), &
+                 'il pleut 1628').EQ.1) THEN
              WRITE(*,*) 'i,k,ixt=',i,k,ixt
              WRITE(*,*) 'rneb(i,k)=',rneb(i,k)
@@ -2020,16 +2020,16 @@
        do i=1,klon   
            ! cam verif
-           if (iso_eau.gt.0) THEN
+           IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(zxtoliq(iso_eau,i),zoliq(i), &
                   'il pleut 678',errmax,errmaxrel)
            endif !if (iso_eau.gt.0) THEN
-           if (zoliq(i).gt.ridicule) THEN
-            if (iso_HDO.gt.0) THEN
+           IF (zoliq(i).gt.ridicule) THEN
+            IF (iso_HDO.gt.0) THEN
                 ! Camille 9 mars 2023: on est moins stricte avec le condensat
                 CALL iso_verif_aberrant_choix(zxtoliq(iso_HDO,i),zoliq(i), &
                  ridicule_rain,deltalim_snow, 'il pleut 895a')
-              if (iso_O18.gt.0) THEN
-                if (iso_verif_O18_aberrant_nostop(zxtoliq(iso_HDO,i)/zoliq(i), &
-                 zxtoliq(iso_O18,i)/zoliq(i),'il pleut 895b').eq.1) THEN
+              IF (iso_O18.gt.0) THEN
+                IF (iso_verif_O18_aberrant_nostop(zxtoliq(iso_HDO,i)/zoliq(i), &
+                 zxtoliq(iso_O18,i)/zoliq(i),'il pleut 895b').EQ.1) THEN
                    WRITE(*,*) 'i,k,zoliq,zfice=',i,k,zoliq(i),zfice(i)
                    !stop
@@ -2055,5 +2055,5 @@
                  !  quantite d'eau a eliminer: zchau (Sundqvist, 1978)
                  !  meme chose pour la glace: zfroi (Zender & Kiehl, 1997)
-                 if (ptconv(i,k)) THEN
+                 IF (ptconv(i,k)) THEN
                     zcl   =cld_lc_con
                     zct   =1./cld_tau_con
@@ -2071,5 +2071,5 @@
                  ! surfacique modifiee, qui est plus grande et reduit
                  ! sinon l'eau in-cloud de facon artificielle
-                 if ((iflag_cloudth_vert>=3).AND.(iflag_rain_incloud_vol==1)) THEN
+                 IF ((iflag_cloudth_vert>=3).AND.(iflag_rain_incloud_vol==1)) THEN
                     zchau    = zct   *dtime/REAL(ninter) * zoliq(i) &
                          *(1.0-EXP(-(zoliq(i)/ctot_vol(i,k)/zcl   )**2)) *(1.-zfice(i))
@@ -2111,5 +2111,5 @@
       do i=1,klon
        IF (rneb(i,k).GT.0.0) THEN
-        if (zcond(i).gt.ridicule**2) THEN
+        IF (zcond(i).gt.ridicule**2) THEN
             ! le 21 dec: on change .gt.0 en .gt.ridicule**2 pour éviter valeur
             ! ridiculement petites
@@ -2118,5 +2118,5 @@
            enddo !do ixt=1,niso           
         else !if (zcond(i).gt.0.0) THEN
-           if (zoliq(i).lt.ridicule) THEN
+           IF (zoliq(i).lt.ridicule) THEN
                do ixt=1,ntraciso
                 zxtoliq(ixt,i)=0.0
@@ -2129,5 +2129,5 @@
 #ifdef ISOTRAC
               do ixt=niso+1,ntraciso
-                if (index_zone(ixt).eq.izone_poubelle) THEN
+                IF (index_zone(ixt).EQ.izone_poubelle) THEN
                     zxtoliq(ixt,i)=zoliq(i)*Rdefault(ixt)
                 else
@@ -2161,9 +2161,9 @@
       do i=1,klon  
         IF (rneb(i,k).GT.0.0) THEN
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(zxtoliq(iso_eau,i),zoliq(i), &
                  'il pleut 749',errmax,errmaxrel)
           endif !if (iso_eau.gt.0) THEN
-          if (iso_HDO.gt.0) THEN
+          IF (iso_HDO.gt.0) THEN
                 CALL iso_verif_aberrant_choix(zxtoliq(iso_HDO,i),zoliq(i), &
                  ridicule_rain, deltalim_snow, 'il pleut 963')
@@ -2201,5 +2201,5 @@
 !     &           * (paprs(i,k)-paprs(i,k+1))/(RG*dtime)
 !          enddo  
-            if (zcond(i).gt.ridicule**2) THEN
+            IF (zcond(i).gt.ridicule**2) THEN
                 ! modif le 19 dec 2012 pour éviter zcond pathologiquement petits
                 do ixt=1,ntraciso
@@ -2210,5 +2210,5 @@
                 enddo !do ixt=1,niso
             else !if (zcond(i).gt.0.0) THEN
-                if (zcond(i)-zoliq(i).gt.0.0) THEN
+                IF (zcond(i)-zoliq(i).gt.0.0) THEN
                     do ixt=1,niso
                         zxtrfl(ixt,i)=zxtrfl(ixt,i) &
@@ -2224,5 +2224,5 @@
 #ifdef ISOTRAC
                    do ixt=niso+1,ntraciso
-                      if (index_zone(ixt).eq.izone_poubelle) THEN
+                      IF (index_zone(ixt).EQ.izone_poubelle) THEN
                         zxtrfl(ixt,i)=zxtrfl(ixt,i) &
                         +Rdefault(ixt) &
@@ -2240,8 +2240,8 @@
 #ifdef ISOVERIF
             do ixt=1,ntraciso
-             if ((iso_verif_noNAN_nostop(zxtrfl(ixt,i), &
-                         'il pleut 772').eq.1).or. &
+             IF ((iso_verif_noNAN_nostop(zxtrfl(ixt,i), &
+                         'il pleut 772').EQ.1).OR. &
                          (iso_verif_noNAN_nostop(zxtoliq(ixt,i), &
-                         'il pleut 772b').eq.1)) THEN
+                         'il pleut 772b').EQ.1)) THEN
                WRITE(*,*) 'zcond(i)=',zcond(i)
                WRITE(*,*) 'zxtcond(ixt,i)=',zxtcond(ixt,i)
@@ -2254,10 +2254,10 @@
 #endif
 #ifdef ISOVERIF
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(d_xtl(iso_eau,i,k), &
                  d_ql(i,k),'il pleut 771',errmax,errmaxrel)
-              if (iso_verif_egalite_choix_nostop( &
+              IF (iso_verif_egalite_choix_nostop( &
                  zxtrfl(iso_eau,i),zrfl(i), &
-                 'il pleut 771b',errmax,errmaxrel).eq.1)THEN
+                 'il pleut 771b',errmax,errmaxrel).EQ.1)THEN
                  WRITE(*,*) 'trace_cas(i)=',trace_cas(i)
                  WRITE(*,*) 'zxtcond(iso_eau,i)',zxtcond(iso_eau,i)
@@ -2268,5 +2268,5 @@
               endif
             endif !if (iso_eau.gt.0) THEN
-            if (iso_HDO.gt.0) THEN
+            IF (iso_HDO.gt.0) THEN
                 IF ((t(i,1)) .LT. RTT) THEN
                 CALL iso_verif_aberrant_choix(zxtrfl(iso_hdo,i), &
@@ -2279,5 +2279,5 @@
 #endif
          ! bidouille
-         if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) THEN
+         IF ((bidouille_anti_divergence).AND.(iso_eau.gt.0)) THEN
                zxtrfl(iso_eau,i)= zrfl(i)   
 !             if (zxtrfl(iso_eau,i).gt.0.0) THEN
@@ -2314,5 +2314,5 @@
              zqpreci(i)=(zcond(i)-zoliq(i))*zfice(i)
              zqprecl(i)=(zcond(i)-zoliq(i))*(1.-zfice(i))
-           if (fl_cor_ebil .GT. 0) THEN
+           IF (fl_cor_ebil .GT. 0) THEN
              zcp=RCPD*(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
              coef1 = rneb(i,k)*RLSTT/zcp*zdqsdT_raw(i)
@@ -2364,6 +2364,6 @@
          IF (rneb(i,k).GT.0.0) THEN
 !CR on prend en compte la phase glace
-!JLD inutile car on ne passe jamais ici si .not.ice_thermo
-!           if (.not.ice_thermo) THEN
+!JLD inutile car on ne passe jamais ici si .NOT.ice_thermo
+!           if (.NOT.ice_thermo) THEN
 !           d_ql(i,k) = zoliq(i)
 !           d_qi(i,k) = 0.
@@ -2387,5 +2387,5 @@
               zifl(i) = zifl(i)+zrfl(i)
               zrfl(i) = 0.
-           if (fl_cor_ebil .GT. 0) THEN
+           IF (fl_cor_ebil .GT. 0) THEN
               zt(i)=zt(i)+zsolid*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
                       *(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
@@ -2457,5 +2457,5 @@
 #ifdef ISOVERIF
       DO i = 1, klon
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
           CALL iso_verif_egalite_choix(pxtrainfl(iso_eau,i,k),prfl(i,k), &
                  'il pleut 804',errmax,errmaxrel)
@@ -2464,12 +2464,12 @@
           CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
                  'il pleut 1612',errmax,errmaxrel)
-          if (iso_verif_positif_choix_nostop(pxtrainfl(iso_eau,i,k), &
-                 ridicule_rain,'ilp 1547').eq.1) THEN
+          IF (iso_verif_positif_choix_nostop(pxtrainfl(iso_eau,i,k), &
+                 ridicule_rain,'ilp 1547').EQ.1) THEN
             WRITE(*,*) 'prfl(i,k)=',prfl(i,k)
             stop
           endif  
         endif !if (iso_eau.gt.0) THEN
-        if (iso_HDO.gt.0) THEN
-          if (prfl(i,k).gt.ridicule_rain) THEN
+        IF (iso_HDO.gt.0) THEN
+          IF (prfl(i,k).gt.ridicule_rain) THEN
             CALL iso_verif_aberrant(pxtrainfl(iso_HDO,i,k)/prfl(i,k), &
                   'il pleut 1020')
@@ -2477,5 +2477,5 @@
           CALL iso_verif_aberrant_choix(pxtsnowfl(iso_HDO,i,k),psfl(i,k), &
                  ridicule_rain, deltalim_snow, 'il pleut 1024')
-          if (zq(i).gt.ridicule) THEN
+          IF (zq(i).gt.ridicule) THEN
               CALL iso_verif_aberrant_encadre(zxt(iso_HDO,i)/zq(i), &
                  'il pleut 1204')
@@ -2504,7 +2504,7 @@
          ! cam verif
 #ifdef ISOVERIF
-           if (iso_eau.gt.0) THEN
-             if (iso_verif_egalite_choix_nostop(d_xt(iso_eau,i,k), &
-                  d_q(i,k),'il pleut 838',errmax,errmaxrel).eq.1) THEN
+           IF (iso_eau.gt.0) THEN
+             IF (iso_verif_egalite_choix_nostop(d_xt(iso_eau,i,k), &
+                  d_q(i,k),'il pleut 838',errmax,errmaxrel).EQ.1) THEN
                 WRITE(*,*) 'i,k=',i,k
                 WRITE(*,*) 'zxt,zq=',zxt(iso_eau,i),zq(i)
@@ -2513,9 +2513,9 @@
              endif
            endif !if (iso_eau.gt.0) THEN
-           if (1.eq.0) THEN
-           if (iso_HDO.gt.0) THEN
-            if (abs(d_q(i,k)).gt.max(errmaxrel*q(i,k),errmax)) THEN
-              if (iso_verif_aberrant_nostop( &
-                 d_xt(iso_HDO,i,k)/d_q(i,k),'il pleut 1229').eq.1) THEN
+           IF (1.EQ.0) THEN
+           IF (iso_HDO.gt.0) THEN
+            IF (abs(d_q(i,k)).gt.max(errmaxrel*q(i,k),errmax)) THEN
+              IF (iso_verif_aberrant_nostop( &
+                 d_xt(iso_HDO,i,k)/d_q(i,k),'il pleut 1229').EQ.1) THEN
 !                WRITE(*,*) 'd_q(i,k)=',d_q(i,k)
 !                WRITE(*,*) 'q(i,k)=',q(i,k)
@@ -2527,5 +2527,5 @@
             endif !if (zq(i).gt.ridicule) THEN
            endif !if (iso_HDO.gt.0) THEN
-          endif !if (1.eq.0) THEN
+          endif !if (1.EQ.0) THEN
 #endif
          ! end cam verif
@@ -2545,8 +2545,8 @@
         zprec_cond(i) = MAX(zcond(i)-zoliq(i),0.0) &
              * (paprs(i,k)-paprs(i,k+1))/RG
-        IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
+        IF (rneb(i,k).GT.0.0.AND.zprec_cond(i).gt.0.) THEN
            !AA lessivage nucleation LMD5 dans la couche elle-meme
           IF (iflag_t_glace.EQ.0) THEN
-           if (t(i,k) .GE. t_glace_min_old) THEN
+           IF (t(i,k) .GE. t_glace_min_old) THEN
               zalpha_tr = a_tr_sca(3)
            else
@@ -2554,5 +2554,5 @@
            endif
           ELSE ! of IF (iflag_t_glace.EQ.0)
-           if (t(i,k) .GE. t_glace_min) THEN
+           IF (t(i,k) .GE. t_glace_min) THEN
               zalpha_tr = a_tr_sca(3)
            else
@@ -2574,7 +2574,7 @@
      DO kk = k-1, 1, -1
         DO i = 1, klon
-           IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
+           IF (rneb(i,k).GT.0.0.AND.zprec_cond(i).gt.0.) THEN
              IF (iflag_t_glace.EQ.0) THEN
-              if (t(i,kk) .GE. t_glace_min_old) THEN
+              IF (t(i,kk) .GE. t_glace_min_old) THEN
                  zalpha_tr = a_tr_sca(1)
               else
@@ -2582,5 +2582,5 @@
               endif
              ELSE ! of IF (iflag_t_glace.EQ.0)
-              if (t(i,kk) .GE. t_glace_min) THEN
+              IF (t(i,kk) .GE. t_glace_min) THEN
                  zalpha_tr = a_tr_sca(1)
               else
@@ -2598,5 +2598,5 @@
       ! verif en fin de boucle
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
         do i=1,klon       
         CALL iso_verif_egalite_choix(zxtrfl(iso_eau,i) &
@@ -2654,13 +2654,13 @@
 #endif         
 #ifdef ISOVERIF
-       if (iso_eau.gt.0) THEN
+       IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite_choix(xtrain(iso_eau,i),rain(i), &
                  'il pleut 926a',errmax,errmaxrel)
-        if (snow(i)*dtime.gt.ridicule) THEN
+        IF (snow(i)*dtime.gt.ridicule) THEN
            CALL iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
                   'il pleut 938a',errmax,errmaxrel)
         endif !if (snow(i)*dtime.gt.ridicule) THEN
        endif !if (iso_eau.gt.0) THEN
-       if (iso_HDO.gt.0) THEN
+       IF (iso_HDO.gt.0) THEN
            CALL iso_verif_aberrant_choix(xtrain(iso_hdo,i),rain(i), &
                  ridicule_rain,deltalim,'il pleut 926b')
@@ -2691,5 +2691,5 @@
   ! latent heat is considered.
 !CR: si thermo de la glace, neige deja prise en compte
-  IF (.not.ice_thermo) THEN
+  IF (.NOT.ice_thermo) THEN
   DO k = 1, klev
      DO i = 1, klon
@@ -2702,7 +2702,7 @@
   ENDIF
 
-  if (ncoreczq>0) THEN
+  IF (ncoreczq>0) THEN
      WRITE(lunout,*)'WARNING : ZQ dans fisrtilp ',ncoreczq,' val < 1.e-15.'
-  endif
+  ENDIF
 
 
@@ -2712,5 +2712,5 @@
        do k=1,klev
         do i=1,klon
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
            CALL iso_verif_egalite_choix(d_xtl(iso_eau,i,k),d_ql(i,k), &
                   'il pleut 1289',errmax,errmaxrel)
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_wake.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_wake.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_wake.F90	(revision 5117)
@@ -31,5 +31,5 @@
   USE lmdz_ioipsl_getin_p, ONLY: getin_p
   USE dimphy
-  use lmdz_phys_para
+  USE lmdz_phys_para
   USE lmdz_print_control, ONLY: prt_level
 #ifdef ISO
@@ -330,5 +330,5 @@
       REAL, DIMENSION(ntraciso,klon,klev) :: D_xt1, D_xt2, D_dxt
       REAL, DIMENSION(ntraciso,klon,klev) :: omgbdxt
-      integer ixt
+      INTEGER ixt
 #endif
 
@@ -398,5 +398,5 @@
   ! alpk = 0.05
 
- if (first) THEN
+ IF (first) THEN
   igout = klon/2+1/klon
 
@@ -468,5 +468,5 @@
 
   first=.FALSE.
- endif
+ END IF
 
  IF (iflag_wk_pop_dyn == 0) THEN
@@ -712,11 +712,11 @@
         enddo !do ixt=1,ntraciso
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) THEN
+        IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite(deltaqw(i,k),deltaxtw(iso_eau,i,k),'wake 723a')
               CALL iso_verif_egalite(qu(i,k),xtu(iso_eau,i,k),'wake 723b')
         endif
-        if (iso_HDO.gt.0) THEN
-               if (iso_verif_aberrant_enc_choix_nostop(xtu(iso_hdo,i,k),qu(i,k),ridicule,deltalim, &
-                        'wake 723c xtu').eq.1) THEN
+        IF (iso_HDO.gt.0) THEN
+               IF (iso_verif_aberrant_enc_choix_nostop(xtu(iso_hdo,i,k),qu(i,k),ridicule,deltalim, &
+                        'wake 723c xtu').EQ.1) THEN
                      stop
                endif
@@ -1074,5 +1074,5 @@
     ! ------------------------------------------------------------
 
-    ! wk_adv is the logical flag enabling wake evolution in the time advance
+    ! wk_adv is the LOGICAL flag enabling wake evolution in the time advance
     ! loop
     DO i = 1, klon
@@ -1455,5 +1455,5 @@
         enddo !do ixt=1,ntraciso
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite(deltaqw(i,k-1),deltaxtw(iso_eau,i,k-1),'wake 1460a')
         CALL iso_verif_egalite(deltaqw(i,k),deltaxtw(iso_eau,i,k),'wake 1460b')
@@ -1503,5 +1503,5 @@
         enddo !do ixt=1,ntraciso
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite(d_q1(i,k),d_xt1(iso_eau,i,k),'wake 1502a')
         CALL iso_verif_egalite(d_q2(i,k),d_xt2(iso_eau,i,k),'wake 1502b')
@@ -1631,5 +1631,5 @@
         enddo !do ixt=1,ntraciso
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite(dqke(i,k),dxtKE(iso_eau,i,k),'wake 1621a')
         CALL iso_verif_egalite(dqdwn(i,k),dxtdwn(iso_eau,i,k),'wake 1621b')
@@ -1708,5 +1708,5 @@
         enddo !do ixt=1,ntraciso
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
         CALL iso_verif_egalite(dqke(i,k),dxtKE(iso_eau,i,k),'wake 1692a')
         CALL iso_verif_egalite(deltaqw(i,k),deltaxtw(iso_eau,i,k),'wake 1692b')
@@ -1727,5 +1727,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_vect2D(d_deltaxtw,d_deltaqw, &
                  'wake 1359',ntraciso,klon,klev)
@@ -1797,5 +1797,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
         DO k= 1,klev 
           DO i = 1,klon 
@@ -1840,5 +1840,5 @@
 #ifdef ISOVERIF
       WRITE(*,*) 'wake 1859'
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
         DO k= 1,klev 
           DO i = 1,klon 
@@ -1848,5 +1848,5 @@
         enddo ! DO k= 1,klev 
       endif !if (iso_eau.gt.0) THEN
-      if (iso_hdo.gt.0) THEN
+      IF (iso_hdo.gt.0) THEN
       CALL iso_verif_aberrant_enc_vect2D( &
             xte,qe, &
@@ -2231,5 +2231,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-      if (iso_hdo.gt.0) THEN
+      IF (iso_hdo.gt.0) THEN
       CALL iso_verif_aberrant_enc_vect2D( &
               xtu,qu, &
@@ -2332,5 +2332,5 @@
         !! print *,'wake, sum_half_dth(i), sum_dth(i) ', &
         !!                sum_half_dth(i), sum_dth(i)
-        IF ((hw0(i) < 1.) .or. (dthmin(i) >= -delta_t_min) ) THEN
+        IF ((hw0(i) < 1.) .OR. (dthmin(i) >= -delta_t_min) ) THEN
           wape2(i) = -1.
           !! print *,'wake, rej 1'
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyaqua_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyaqua_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyaqua_mod.F90	(revision 5117)
@@ -35,5 +35,5 @@
                                 day_ini,day_end
     USE indice_sol_mod
-    USE nrtype, ONLY: pi
+    USE lmdz_physical_constants, ONLY: pi
 !    USE ioipsl
     USE lmdz_phys_para, ONLY: is_master
@@ -147,5 +147,5 @@
     !END IF
     
-    if (year_len/=360) THEN
+    IF (year_len/=360) THEN
       write (*,*) year_len
       write (*,*) 'iniaqua: 360 day calendar is required !'
@@ -248,5 +248,5 @@
     ! else
     phy_alb(:, :) = albedo ! albedo land only (old value condsurf_jyg=0.3)
-    ! endif !alb_ocean
+    ! END IF !alb_ocean
 
     DO i = 1, year_len
@@ -961,5 +961,5 @@
       END IF
 
-      if (type_profil==20) THEN
+      IF (type_profil==20) THEN
       PRINT*,'Profile SST 20'
 !     Méthode 13 "Qmax2K" plateau réel é|  l'Equateur augmenté +2K
@@ -970,5 +970,5 @@
       endif
 
-      if (type_profil==21) THEN
+      IF (type_profil==21) THEN
       PRINT*,'Profile SST 21'
 !     Méthode 13 "Qmax2K" plateau réel é|  l'Equateur augmenté +2K
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyetat0_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyetat0_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyetat0_mod.F90	(revision 5117)
@@ -41,5 +41,5 @@
   USE iostart,          ONLY: close_startphy, get_field, get_var, open_startphy
   USE infotrac_phy,     ONLY: nqtot, nbtr, type_trac, tracers
-  USE readTracFiles_mod,ONLY: maxlen, new2oldH2O
+  USE lmdz_readTracFiles,ONLY: maxlen, new2oldH2O
   USE traclmdz_mod,     ONLY: traclmdz_from_restart
   USE carbon_cycle_mod, ONLY: carbon_cycle_init, carbon_cycle_cpl, carbon_cycle_tr, carbon_cycle_rad, co2_send, RCO2_glo
@@ -47,7 +47,7 @@
   USE ocean_slab_mod,   ONLY: nslay, tslab, seaice, tice, ocean_slab_init
   USE time_phylmdz_mod, ONLY: init_iteration, pdtphys, itau_phy
-  USE wxios, ONLY: missing_val_xios => missing_val, using_xios
-  use netcdf, ONLY: missing_val_netcdf => nf90_fill_real
-  use config_ocean_skin_m, ONLY: activate_ocean_skin
+  USE lmdz_wxios, ONLY: missing_val_xios => missing_val, using_xios
+  USE netcdf, ONLY: missing_val_netcdf => nf90_fill_real
+  USE config_ocean_skin_m, ONLY: activate_ocean_skin
 #ifdef ISO
   USE infotrac_phy, ONLY: niso
@@ -77,5 +77,5 @@
   REAL qsurf(klon, nbsrf)
   REAL snow(klon, nbsrf)
-  real fder(klon)
+  REAL fder(klon)
   REAL run_off_lic_0(klon)
   REAL fractint(klon)
@@ -328,5 +328,5 @@
 !===================================================================
 
-   if ( iflag_physiq <= 1 ) THEN
+   IF ( iflag_physiq <= 1 ) THEN
 !===================================================================
   ! Lecture des temperatures du sol profond:
@@ -399,5 +399,5 @@
 !  found=phyetat0_srf(treedrg,"treedrg","drag from vegetation" , 0.)
     !lecture du profile de freinage des arbres
-    IF (.not. found ) THEN
+    IF (.NOT. found ) THEN
       treedrg(:,1:klev,1:nbsrf)= 0.0
     ELSE
@@ -410,5 +410,5 @@
   ENDIF
 
-  endif ! iflag_physiq <= 1
+  ENDIF ! iflag_physiq <= 1
 
   ! Lecture de l'age de la neige:
@@ -552,5 +552,5 @@
 #ifdef ISOVERIF 
       WRITE(*,*) 'phyetat0 1074'
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
       CALL iso_verif_egalite_vect2D(  &
                  xtsnow,snow, &
@@ -628,6 +628,6 @@
   ENDIF ! Slab        
 
-  if (activate_ocean_skin >= 1) THEN
-     if (activate_ocean_skin == 2 .and. type_ocean == 'couple') THEN
+  IF (activate_ocean_skin >= 1) THEN
+     IF (activate_ocean_skin == 2 .AND. type_ocean == 'couple') THEN
         found = phyetat0_get(delta_sal, "delta_sal", &
              "ocean-air interface salinity minus bulk salinity", 0.)
@@ -671,10 +671,10 @@
 !        WRITE(*,*) 'xtsnow(:,994,2)=',xtsnow(:,994,2)
 !#endif
-  if ( iflag_physiq <= 1 ) THEN
+  IF ( iflag_physiq <= 1 ) THEN
   CALL pbl_surface_init(fder, snow, qsurf, tsoil)
 #ifdef ISO
   CALL pbl_surface_init_iso(xtsnow,Rland_ice)
 #endif
-  endif
+  ENDIF
 
   ! Initialize module ocean_cpl_mod for the case of coupled ocean
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyredem.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyredem.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyredem.F90	(revision 5117)
@@ -50,5 +50,5 @@
   USE ocean_slab_mod, ONLY: nslay, tslab, seaice, tice, fsic
   USE time_phylmdz_mod, ONLY: annee_ref, day_end, itau_phy, pdtphys
-  use config_ocean_skin_m, ONLY: activate_ocean_skin
+  USE config_ocean_skin_m, ONLY: activate_ocean_skin
 
   IMPLICIT none
@@ -66,5 +66,5 @@
   REAL qsurf(klon, nbsrf)
   REAL snow(klon, nbsrf)
-  real fder(klon)
+  REAL fder(klon)
   REAL run_off_lic_0(klon)
   REAL trs(klon, nbtr)
@@ -387,12 +387,12 @@
     END IF
 
-    if (ok_gwd_rando) CALL put_field(pass,"du_gwd_rando", &
+    IF (ok_gwd_rando) CALL put_field(pass,"du_gwd_rando", &
          "tendency on zonal wind due to flott gravity waves", du_gwd_rando)
 
-    IF (.not. ok_hines .and. ok_gwd_rando) CALL put_field(pass,"du_gwd_front", &
+    IF (.NOT. ok_hines .AND. ok_gwd_rando) CALL put_field(pass,"du_gwd_front", &
          "tendency on zonal wind due to acama gravity waves", du_gwd_front)
 
-    if (activate_ocean_skin >= 1) THEN
-       if (activate_ocean_skin == 2 .and. type_ocean == 'couple') THEN
+    IF (activate_ocean_skin >= 1) THEN
+       IF (activate_ocean_skin == 2 .AND. type_ocean == 'couple') THEN
           CALL put_field(pass, "delta_sal", &
                "ocean-air interface salinity minus bulk salinity", delta_sal)
@@ -505,5 +505,5 @@
 #endif
 #ifdef ISOTRAC
-    use isotrac_mod, ONLY: index_zone,index_iso,strtrac
+    USE isotrac_mod, ONLY: index_zone,index_iso,strtrac
 #endif
       !USE phyredem, ONLY: put_field_srf1
@@ -523,12 +523,12 @@
       REAL xtrun_off_lic_0(niso,klon)
       REAL Rland_ice(niso,klon)
-      real run_off_lic_0(klon)
-      integer, intent(in) :: pass
+      REAL run_off_lic_0(klon)
+      INTEGER, INTENT(IN) :: pass
 
       ! locals
-      real iso_tmp(klon)
-      real iso_tmp_lonlev(klon,klev)
-      real iso_tmp_lonsrf(klon,nbsrf)
-      integer i,ixt,k,nsrf
+      REAL iso_tmp(klon)
+      REAL iso_tmp_lonlev(klon,klev)
+      REAL iso_tmp_lonsrf(klon,nbsrf)
+      INTEGER i,ixt,k,nsrf
       INTEGER nid, nvarid
       INTEGER ierr
@@ -536,12 +536,12 @@
       CHARACTER*2 str2
       CHARACTER*50 outiso
-      integer lnblnk
+      INTEGER lnblnk
 #ifdef ISOTRAC
-      integer iiso,izone
+      INTEGER iiso,izone
 #endif      
 
       WRITE(*,*) 'phyisoredem 41: entrée'
 #ifdef ISOVERIF
-     if (iso_eau.gt.0) THEN
+     IF (iso_eau.gt.0) THEN
       do k=1,klev
         do i=1,klon
@@ -609,5 +609,5 @@
 
       ! variables seulement pour niso:
-      if (ixt.le.niso) THEN
+      IF (ixt.le.niso) THEN
       iso_tmp_lonsrf(:,:)=xtsnow(ixt,:,:)
       CALL put_field_srf1(pass, "XTSNOW"//TRIM(outiso), "NEIGE",       iso_tmp_lonsrf)
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/phys_output_ctrlout_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/phys_output_ctrlout_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/phys_output_ctrlout_mod.F90	(revision 5117)
@@ -16,5 +16,5 @@
   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/ histmth, histday, histhf, histins /),'!!!!!!!!!!!!
   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-  !  CHARACTER(len=20), dimension(nfiles) :: TEF = type_ecri_files
+  !  CHARACTER(len=20), DIMENSION(nfiles) :: TEF = type_ecri_files
 
   !!! saving lon and lat as variables for CMIP6 DataRequest
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/phys_output_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/phys_output_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/phys_output_mod.F90	(revision 5117)
@@ -36,5 +36,5 @@
     USE dimphy
     USE infotrac_phy, ONLY: nqtot, tracers, niso, ntraciso=>ntiso
-    USE strings_mod,  ONLY: maxlen
+    USE lmdz_strings,  ONLY: maxlen
     USE ioipsl
     USE phys_cal_mod, ONLY: hour, calend
@@ -48,9 +48,9 @@
     USE time_phylmdz_mod, ONLY: day_ini, itau_phy, start_time, annee_ref, day_ref
     ! ug Pour les sorties XIOS
-    USE wxios
+    USE lmdz_wxios
 #ifdef ISO
     USE isotopes_mod, ONLY: isoName,iso_HTO
 #ifdef ISOTRAC
-    use isotrac_mod, ONLY: index_zone,index_iso,strtrac
+    USE isotrac_mod, ONLY: index_zone,index_iso,strtrac
 #endif
 #endif
@@ -188,5 +188,5 @@
     ALLOCATE(o_dxtthe(ntraciso))
     ALLOCATE(o_dxtch4(ntraciso))
-    if (iso_HTO.gt.0) THEN
+    IF (iso_HTO.gt.0) THEN
       ALLOCATE(o_dxtprod_nucl(ntraciso))
       ALLOCATE(o_dxtcosmo(ntraciso))
@@ -361,5 +361,5 @@
     IF (using_xios) THEN
 !!! Ouverture de chaque fichier XIOS !!!!!!!!!!!
-      IF (.not. ok_all_xml) THEN
+      IF (.NOT. ok_all_xml) THEN
         IF (prt_level >= 10) THEN
          PRINT*,'phys_output_open: CALL wxios_add_file with phys_out_filenames(iff)=',trim(phys_out_filenames(iff))
@@ -615,5 +615,5 @@
   SUBROUTINE convers_timesteps(str,dtime,timestep)
 
-    use ioipsl
+    USE ioipsl
     USE phys_cal_mod
     USE time_phylmdz_mod, ONLY: day_ref, annee_ref
@@ -642,12 +642,12 @@
     ENDIF
 
-    IF ( type == 'day'.or.type == 'days'.or.type == 'jours'.or.type == 'jour' ) timestep = ttt * dayseconde
-    IF ( type == 'mounths'.or.type == 'mth'.or.type == 'mois' ) THEN
+    IF ( type == 'day'.OR.type == 'days'.OR.type == 'jours'.OR.type == 'jour' ) timestep = ttt * dayseconde
+    IF ( type == 'mounths'.OR.type == 'mth'.OR.type == 'mois' ) THEN
        WRITE(lunout,*)'annee_ref,day_ref mon_len',annee_ref,day_ref,mth_len
        timestep = ttt * dayseconde * mth_len
     ENDIF
-    IF ( type == 'hours'.or.type == 'hr'.or.type == 'heurs') timestep = ttt * dayseconde / 24.
-    IF ( type == 'mn'.or.type == 'minutes'  ) timestep = ttt * 60.
-    IF ( type == 's'.or.type == 'sec'.or.type == 'secondes'   ) timestep = ttt
+    IF ( type == 'hours'.OR.type == 'hr'.OR.type == 'heurs') timestep = ttt * dayseconde / 24.
+    IF ( type == 'mn'.OR.type == 'minutes'  ) timestep = ttt * 60.
+    IF ( type == 's'.OR.type == 'sec'.OR.type == 'secondes'   ) timestep = ttt
     IF ( type == 'TS' ) timestep = ttt * dtime
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/phys_output_var_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/phys_output_var_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/phys_output_var_mod.F90	(revision 5117)
@@ -142,7 +142,7 @@
   LOGICAL, SAVE :: vars_defined = .FALSE. ! ug PAS THREADPRIVATE ET C'EST NORMAL
 
-  REAL, allocatable:: zustr_gwd_hines(:), zvstr_gwd_hines(:) ! (klon)
-  REAL, allocatable:: zustr_gwd_front(:), zvstr_gwd_front(:) ! (klon)
-  REAL, allocatable:: zustr_gwd_rando(:), zvstr_gwd_rando(:) ! (klon)
+  REAL, ALLOCATABLE:: zustr_gwd_hines(:), zvstr_gwd_hines(:) ! (klon)
+  REAL, ALLOCATABLE:: zustr_gwd_front(:), zvstr_gwd_front(:) ! (klon)
+  REAL, ALLOCATABLE:: zustr_gwd_rando(:), zvstr_gwd_rando(:) ! (klon)
   !$OMP THREADPRIVATE(zustr_gwd_hines, zvstr_gwd_hines)
   !$OMP THREADPRIVATE(zustr_gwd_front, zvstr_gwd_front)
@@ -185,6 +185,6 @@
   !======================================================================
   SUBROUTINE phys_output_var_init
-    use dimphy
-    use config_ocean_skin_m, ONLY: activate_ocean_skin
+    USE dimphy
+    USE config_ocean_skin_m, ONLY: activate_ocean_skin
 
     IMPLICIT NONE
@@ -236,9 +236,9 @@
 
     IF (ok_hines) allocate(zustr_gwd_hines(klon), zvstr_gwd_hines(klon))
-    IF (.not.ok_hines.and.ok_gwd_rando) &
+    IF (.NOT.ok_hines.AND.ok_gwd_rando) &
                   allocate(zustr_gwd_front(klon), zvstr_gwd_front(klon))
     IF (ok_gwd_rando) allocate(zustr_gwd_rando(klon), zvstr_gwd_rando(klon))
 
-    if (activate_ocean_skin >= 1) allocate(tkt(klon), tks(klon), taur(klon), &
+    IF (activate_ocean_skin >= 1) allocate(tkt(klon), tks(klon), taur(klon), &
          sss(klon))
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/physiq_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/physiq_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/physiq_mod.F90	(revision 5117)
@@ -40,6 +40,6 @@
     USE indice_sol_mod
     USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac,ivap,iliq,isol
-    USE readTracFiles_mod, ONLY: addPhase
-    USE strings_mod,  ONLY: strIdx
+    USE lmdz_readTracFiles, ONLY: addPhase
+    USE lmdz_strings,  ONLY: strIdx
     USE iophy
     USE limit_read_mod, ONLY: init_limit_read
@@ -74,7 +74,7 @@
     USE tropopause_m,     ONLY: dyn_tropopause
     USE ice_sursat_mod,  ONLY: flight_init, airplane
-    USE vampir
+    USE lmdz_vampir
     USE lmdz_write_field_phy
-    USE wxios, ONLY: g_ctx, wxios_set_context
+    USE lmdz_wxios, ONLY: g_ctx, wxios_set_context
     USE lmdz_lscp, ONLY: lscp
     USE lmdz_call_cloud_optics_prop, ONLY: call_cloud_optics_prop
@@ -103,5 +103,5 @@
     USE lmdz_xios, ONLY: xios_update_calendar, xios_context_finalize, xios_get_field_attr, &
             xios_field_is_active, xios_context, xios_set_current_context
-    USE wxios, ONLY: missing_val, using_xios
+    USE lmdz_wxios, ONLY: missing_val, using_xios
     USE paramLMDZ_phy_mod
 
@@ -465,5 +465,5 @@
     !! d_ps----output-R-tendance physique de la pression au sol
     !!======================================================================
-    integer jjmp1
+    INTEGER jjmp1
     !  parameter (jjmp1=jjm+1-1/jjm) ! => (jjmp1=nbp_lat-1/(nbp_lat-1))
     !  integer iip1
@@ -547,5 +547,5 @@
     
     
-    real facteur
+    REAL facteur
 
     REAL wmax_th(klon)
@@ -589,5 +589,5 @@
     REAL v(klon,klev)
 
-    REAL, intent(in):: rot(klon, klev)
+    REAL, INTENT(IN):: rot(klon, klev)
     ! relative vorticity, in s-1, needed for frontal waves
 
@@ -678,5 +678,5 @@
     INTEGER igwd,idx(klon),itest(klon)
 
-    !      REAL,allocatable,save :: run_off_lic_0(:)
+    !      REAL,ALLOCATABLE,save :: run_off_lic_0(:)
     !$OMP THREADPRIVATE(run_off_lic_0)
     !ym      SAVE run_off_lic_0
@@ -815,10 +815,10 @@
     ! continument (pcon dans
     ! thermcell_main.F90)
-    real fraca0(klon)           ! Fraction des thermiques au LCL
-    real w0(klon)               ! Vitesse des thermiques au LCL
-    real w_conv(klon)           ! Vitesse verticale de grande \'echelle au LCL
-    real tke0(klon,klev+1)      ! TKE au d\'ebut du pas de temps
-    real therm_tke_max0(klon)   ! TKE dans les thermiques au LCL 
-    real env_tke_max0(klon)     ! TKE dans l'environnement au LCL 
+    REAL fraca0(klon)           ! Fraction des thermiques au LCL
+    REAL w0(klon)               ! Vitesse des thermiques au LCL
+    REAL w_conv(klon)           ! Vitesse verticale de grande \'echelle au LCL
+    REAL tke0(klon,klev+1)      ! TKE au d\'ebut du pas de temps
+    REAL therm_tke_max0(klon)   ! TKE dans les thermiques au LCL
+    REAL env_tke_max0(klon)     ! TKE dans l'environnement au LCL
     INTEGER, SAVE :: iflag_thermcell_tke ! transtport TKE by thermals
     !$OMP THREADPRIVATE(iflag_thermcell_tke)
@@ -832,6 +832,6 @@
     !--------Statistical Boundary Layer Closure: ALP_BL--------
     !---Profils de TKE dans et hors du thermique
-    real therm_tke_max(klon,klev)   ! Profil de TKE dans les thermiques
-    real env_tke_max(klon,klev)     ! Profil de TKE dans l'environnement
+    REAL therm_tke_max(klon,klev)   ! Profil de TKE dans les thermiques
+    REAL env_tke_max(klon,klev)     ! Profil de TKE dans l'environnement
 
     !-------Activer les tendances de TKE due a l'orograp??ie---------
@@ -892,7 +892,7 @@
     SAVE lmt_pas                ! frequence de mise a jour
     !$OMP THREADPRIVATE(lmt_pas) 
-    real zmasse(klon, nbp_lev),exner(klon, nbp_lev) 
+    REAL zmasse(klon, nbp_lev),exner(klon, nbp_lev)
     !     (column-density of mass of air in a cell, in kg m-2)
-    real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
+    REAL, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
 
     !IM sorties
@@ -947,5 +947,5 @@
     REAL zxfluxv(klon, klev)
 #ifdef ISO
-    real fluxxt(ntraciso,klon,klev, nbsrf)
+    REAL fluxxt(ntraciso,klon,klev, nbsrf)
     REAL zxfluxxt(ntraciso,klon, klev)
 #endif
@@ -976,13 +976,13 @@
     REAL za
     REAL zx_t, zx_qs, zdelta, zcor
-    real zqsat(klon,klev)
+    REAL zqsat(klon,klev)
 
     INTEGER i, k, iq, nsrf, l, itr
 #ifdef ISO
-    real zxt_apres(ntraciso,klon)
+    REAL zxt_apres(ntraciso,klon)
     REAL xt_iso(klon,klev),xtl_iso(klon,klev)
     REAL zxt_factor(ntraciso,klon),zxt_avant(ntraciso,klon)
     INTEGER ixt
-    real wake_deltaq_prec(klon,klev)  
+    REAL wake_deltaq_prec(klon,klev)
 #endif
 
@@ -1038,10 +1038,10 @@
 
     ! tendance nulles
-    REAL, dimension(klon,klev):: du0, dv0, dt0, dq0, dql0, dqi0, dqbs0
-#ifdef ISO
-    REAL, dimension(ntraciso,klon,klev):: dxt0, dxtl0, dxti0
-#endif
-    REAL, dimension(klon)     :: dsig0, ddens0
-    INTEGER, dimension(klon)  :: wkoccur1
+    REAL, DIMENSION(klon,klev):: du0, dv0, dt0, dq0, dql0, dqi0, dqbs0
+#ifdef ISO
+    REAL, DIMENSION(ntraciso,klon,klev):: dxt0, dxtl0, dxti0
+#endif
+    REAL, DIMENSION(klon)     :: dsig0, ddens0
+    INTEGER, DIMENSION(klon)  :: wkoccur1
     ! tendance buffer pour appel de add_phys_tend
     REAL, DIMENSION(klon,klev)  :: d_q_ch4_dtime
@@ -1099,5 +1099,5 @@
     INTEGER, SAVE :: iflag_cld_th
     !$OMP THREADPRIVATE(iflag_cld_th)
-!IM logical ptconv(klon,klev)  !passe dans phys_local_var_mod
+!IM LOGICAL ptconv(klon,klev)  !passe dans phys_local_var_mod
     !IM cf. AM 081204 BEG
     LOGICAL ptconvth(klon,klev)
@@ -1213,5 +1213,5 @@
 
     ! Parameters
-    LOGICAL ok_ade, ok_aie    ! Apply aerosol (in)direct effects or not
+    LOGICAL ok_ade, ok_aie    ! Apply aerosol (IN)direct effects or not
     LOGICAL ok_alw            ! Apply aerosol LW effect or not
     LOGICAL ok_cdnc ! ok cloud droplet number concentration (O. Boucher 01-2013)
@@ -1298,5 +1298,5 @@
     INTEGER, ALLOCATABLE, SAVE :: iGCM(:), jGCM(:)
     !$OMP THREADPRIVATE(iGCM, jGCM)
-    logical, dimension(nfiles)            :: phys_out_filestations
+    logical, DIMENSION(nfiles)            :: phys_out_filestations
     logical, parameter :: lNMC=.FALSE.
 
@@ -1308,17 +1308,17 @@
     LOGICAL, SAVE :: mskocean_beta
     !$OMP THREADPRIVATE(mskocean_beta)
-    REAL, dimension(klon, klev) :: beta ! facteur sur cldtaurad et
+    REAL, DIMENSION(klon, klev) :: beta ! facteur sur cldtaurad et
     ! cldemirad pour evaluer les
     ! retros liees aux CRF
-    REAL, dimension(klon, klev) :: cldtaurad   ! epaisseur optique
+    REAL, DIMENSION(klon, klev) :: cldtaurad   ! epaisseur optique
     ! pour radlwsw pour
     ! tester "CRF off"
-    REAL, dimension(klon, klev) :: cldtaupirad ! epaisseur optique
+    REAL, DIMENSION(klon, klev) :: cldtaupirad ! epaisseur optique
     ! pour radlwsw pour
     ! tester "CRF off"
-    REAL, dimension(klon, klev) :: cldemirad   ! emissivite pour
+    REAL, DIMENSION(klon, klev) :: cldemirad   ! emissivite pour
     ! radlwsw pour tester
     ! "CRF off"
-    REAL, dimension(klon, klev) :: cldfrarad   ! fraction nuageuse
+    REAL, DIMENSION(klon, klev) :: cldfrarad   ! fraction nuageuse
 
     REAL :: calday, zxsnow_dummy(klon)
@@ -1335,9 +1335,9 @@
 
     INTEGER :: nbtr_tmp ! Number of tracer inside concvl
-    REAL, dimension(klon,klev) :: sh_in ! Specific humidity entering in phytrac
-    REAL, dimension(klon,klev) :: ch_in ! Condensed humidity entering in phytrac (eau liquide)
-    integer iostat
-
-    REAL, dimension(klon,klev+1) :: l_mix_ave, wprime_ave
+    REAL, DIMENSION(klon,klev) :: sh_in ! Specific humidity entering in phytrac
+    REAL, DIMENSION(klon,klev) :: ch_in ! Condensed humidity entering in phytrac (eau liquide)
+    INTEGER iostat
+
+    REAL, DIMENSION(klon,klev+1) :: l_mix_ave, wprime_ave
     REAL zzz
     !albedo SB >>>
@@ -1350,5 +1350,5 @@
     REAL qql1(klon),qql2(klon),corrqql
 #ifdef ISO
-    real xtql1(ntraciso,klon),xtql2(ntraciso,klon),corrxtql(ntraciso)
+    REAL xtql1(ntraciso,klon),xtql2(ntraciso,klon),corrxtql(ntraciso)
 #endif
 
@@ -1356,11 +1356,11 @@
     LOGICAL, PARAMETER :: ok_conserv_d_q_con=.FALSE.
 
-    REAL, dimension(klon,klev) :: t_env,q_env
-#ifdef ISO
-    real, dimension(ntraciso,klon,klev) ::  xt_env
-#endif
-
-    REAL, dimension(klon) :: pr_et
-    REAL, dimension(klon) :: w_et, jlr_g_c, jlr_g_s
+    REAL, DIMENSION(klon,klev) :: t_env,q_env
+#ifdef ISO
+    REAL, DIMENSION(ntraciso,klon,klev) ::  xt_env
+#endif
+
+    REAL, DIMENSION(klon) :: pr_et
+    REAL, DIMENSION(klon) :: w_et, jlr_g_c, jlr_g_s
 
     REAL pi
@@ -1376,9 +1376,9 @@
     ! 14 mai 2023                                                          !
     !======================================================================!
-    if (debut) then                                                        !
+    IF (debut) then                                                        !
        iflag_physiq=0
        CALL getin_p('iflag_physiq', iflag_physiq)                          !
     endif                                                                  !
-    if ( iflag_physiq == 2 ) THEN
+    IF ( iflag_physiq == 2 ) THEN
 #ifdef ISO
        abort_message='isotopes pas encore dans physiqex'
@@ -1501,5 +1501,5 @@
 
        !CR: check sur le nb de traceurs de l eau
-       IF ((iflag_ice_thermo>0).and.(nqo==2)) THEN
+       IF ((iflag_ice_thermo>0).AND.(nqo==2)) THEN
           WRITE (lunout, *) ' iflag_ice_thermo==1 requires 3 H2O tracers ', &
                '(H2O_g, H2O_l, H2O_s) but nqo=', nqo, '. Might as well stop here.'
@@ -1757,5 +1757,5 @@
            WRITE(*,*) 'ok_isotopes=',niso > 0
 #endif
-        if (niso > 0) CALL iso_init()
+        IF (niso > 0) CALL iso_init()
 #ifdef ISOTRAC
 IF(nzone > 0) THEN
@@ -1921,5 +1921,5 @@
       IF (.NOT. create_etat0_limit) CALL init_readaerosolstrato(flag_aerosol_strat)  !! initialise aero strato from file for XIOS interpolation (unstructured_grid)
 
-      if (ok_cosp) THEN
+      IF (ok_cosp) THEN
 #ifdef CPP_COSP
         ! A.I : Initialisations pour le 1er passage a Cosp
@@ -2137,5 +2137,5 @@
                "On va utiliser le melange convectif des traceurs qui"
           WRITE(lunout,*)"est calcule dans convect4.3"
-          WRITE(lunout,*)" !!! penser aux logical flags de phytrac"
+          WRITE(lunout,*)" !!! penser aux LOGICAL flags de phytrac"
 
           DO i = 1, klon
@@ -2324,5 +2324,5 @@
                cell_area, ind_cell_glo) 
 
-          if (grid_type==unstructured) THEN 
+          IF (grid_type==unstructured) THEN
              CALL chemini(  pplay, &
                   nbp_lon, nbp_lat, &
@@ -2483,5 +2483,5 @@
     itap   = itap + 1
     IF (is_master .OR. prt_level > 9) THEN
-      IF (prt_level > 5 .or. MOD(itap,5) == 0) THEN
+      IF (prt_level > 5 .OR. MOD(itap,5) == 0) THEN
          WRITE(LUNOUT,*)'Entering physics elapsed seconds since start ', current_time
          WRITE(LUNOUT,100)year_cur,mth_cur,day_cur,hour/3600.
@@ -2610,9 +2610,9 @@
       WRITE(*,*) 'physiq tmp 1762a: ixt,iqiso_vap=',ixt,iqIsoPha(ixt,ivap)
       WRITE(*,*) 'physiq tmp 1762b: ixt,iqiso_liq=',ixt,iqIsoPha(ixt,iliq)
-      if (nqo.eq.3) THEN
+      IF (nqo.EQ.3) THEN
         WRITE(*,*) 'physiq tmp 1762c: ixt,iqiso_liq=',ixt,iqIsoPha(ixt,iliq)
-      endif !if (nqo.eq.3) THEN
-#endif
-      if (ixt.gt.niso) WRITE(*,*) 'izone=',tracers(iqIsoPha(ixt,ivap))%iso_iZone
+      endif !if (nqo.EQ.3) THEN
+#endif
+      IF (ixt.gt.niso) WRITE(*,*) 'izone=',tracers(iqIsoPha(ixt,ivap))%iso_iZone
       DO k = 1, klev
        DO i = 1, klon
@@ -2620,7 +2620,7 @@
           xt_seri(ixt,i,k)  = qx(i,k,iqIsoPha(ixt,ivap))
           xtl_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,iliq))
-          if (nqo.eq.2) THEN
+          IF (nqo.EQ.2) THEN
              xts_seri(ixt,i,k) = 0.
-          else if (nqo.eq.3) THEN
+          ELSE IF (nqo.EQ.3) THEN
              xts_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,isol))
           endif
@@ -2706,12 +2706,12 @@
     ! Diagnostiquer la tendance dynamique
 #ifdef ISOVERIF
-      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+      IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
         do i=1,klon 
          do k=1,klev 
-            if (q_seri(i,k).gt.ridicule) THEN
-               if (iso_verif_o18_aberrant_nostop( &
+            IF (q_seri(i,k).gt.ridicule) THEN
+               IF (iso_verif_o18_aberrant_nostop( &
                     xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                     xt_seri(iso_O18,i,k)/q_seri(i,k), &
-                    'physiq 2099 qv').eq.1) THEN
+                    'physiq 2099 qv').EQ.1) THEN
                   WRITE(*,*) 'physic 2444: i,k,q_seri(i,k)=',i,k,q_seri(i,k)
                   WRITE(*,*) 'xt_seri(:,i,k)=',xt_seri(:,i,k)
@@ -2719,18 +2719,18 @@
               endif !  if (iso_verif_o18_aberrant_nostop 
             endif !if (q_seri(i,k).gt.errmax) THEN
-            if (ql_seri(i,k).gt.ridicule) THEN
-               if (iso_verif_o18_aberrant_nostop( &
+            IF (ql_seri(i,k).gt.ridicule) THEN
+               IF (iso_verif_o18_aberrant_nostop( &
                     xtl_seri(iso_HDO,i,k)/ql_seri(i,k), &
                     xtl_seri(iso_O18,i,k)/ql_seri(i,k), &
-                    'physiq 2099 ql').eq.1) THEN
+                    'physiq 2099 ql').EQ.1) THEN
                   WRITE(*,*) 'i,k,ql_seri(i,k)=',i,k,ql_seri(i,k)
                   !stop
               endif !  if (iso_verif_o18_aberrant_nostop 
             endif !if (q_seri(i,k).gt.errmax) THEN
-            if (qs_seri(i,k).gt.ridicule) THEN
-               if (iso_verif_o18_aberrant_nostop( &
+            IF (qs_seri(i,k).gt.ridicule) THEN
+               IF (iso_verif_o18_aberrant_nostop( &
                     xts_seri(iso_HDO,i,k)/qs_seri(i,k), &
                     xts_seri(iso_O18,i,k)/qs_seri(i,k), &
-                    'physiq 2099 qs').eq.1) THEN
+                    'physiq 2099 qs').EQ.1) THEN
                   WRITE(*,*) 'i,k,qs_seri(i,k)=',i,k,qs_seri(i,k)
                   !stop
@@ -2739,5 +2739,5 @@
           enddo !k=1,klev
          enddo  !i=1,klon
-        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+        endif !if ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
 #ifdef ISOTRAC  
          DO k = 1, klev
@@ -2806,5 +2806,5 @@
 #endif    
 #ifdef ISOVERIF      
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
          DO k = 1, klev
          DO i = 1, klon   
@@ -2822,8 +2822,8 @@
          enddo   
          endif 
-         if (iso_HDO.gt.0) THEN
+         IF (iso_HDO.gt.0) THEN
             DO k = 1, klev
              DO i = 1, klon
-              if (q_seri(i,k).gt.3e-3) THEN
+              IF (q_seri(i,k).gt.3e-3) THEN
               CALL iso_verif_positif(deltaD(xt_seri(iso_HDO,i,k) &
                  /q_seri(i,k))+400.0,'physiq 2045a')
@@ -3023,5 +3023,5 @@
            'reevap 2417: apres evap tot')
       enddo
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix( &
                  xt_seri(iso_eau,i,k),q_seri(i,k), &
@@ -3034,15 +3034,15 @@
                 'reevap 2209b, après réévap totale',errmax,errmaxrel)
        endif !if (iso_eau.gt.0) THEN
-      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
-            if (q_seri(i,k).gt.ridicule) THEN
-               if (iso_verif_o18_aberrant_nostop( &
+      IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
+            IF (q_seri(i,k).gt.ridicule) THEN
+               IF (iso_verif_o18_aberrant_nostop( &
                     xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                     xt_seri(iso_O18,i,k)/q_seri(i,k), &
-                    'reevap 2408: apres reevap totale').eq.1) THEN
+                    'reevap 2408: apres reevap totale').EQ.1) THEN
                   WRITE(*,*) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k)
                   stop
               endif !  if (iso_verif_o18_aberrant_nostop
             endif !if (q_seri(i,k).gt.errmax) THEN
-        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+        endif !if ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
 #ifdef ISOTRAC      
              CALL iso_verif_traceur(xt_seri(1,i,k), &
@@ -3189,5 +3189,5 @@
 ! A detruire en 2024 une fois les tests documentes et les choix faits        !
 ! Conservation des variables avant l'appel à l a diffusion pour les tehrmic  !
-    if (iflag_thermals_tenv / 10 == 1 ) then                                 !
+    IF (iflag_thermals_tenv / 10 == 1 ) then                                 !
         do k=1,klev                                                          !
            do i=1,klon                                                       !
@@ -3201,5 +3201,5 @@
            enddo                                                             !
         enddo                                                                !
-    else if (iflag_thermals_tenv / 10 == 2 ) then                            !
+    ELSE IF (iflag_thermals_tenv / 10 == 2 ) then                            !
         do k=1,klev                                                          !
            do i=1,klon                                                       !
@@ -3214,6 +3214,6 @@
 
        !jyg+nrlmd<
-!!jyg       IF (prt_level .ge. 2 .and. mod(iflag_pbl_split,2) .eq. 1) THEN
-       IF (prt_level >= 2 .and. mod(iflag_pbl_split,10) >= 1) THEN
+!!jyg       IF (prt_level .ge. 2 .AND. mod(iflag_pbl_split,2) .EQ. 1) THEN
+       IF (prt_level >= 2 .AND. mod(iflag_pbl_split,10) >= 1) THEN
           print *,'debut du splitting de la PBL, wake_s = ', wake_s(:)
           print *,'debut du splitting de la PBL, wake_deltat = ', wake_deltat(:,1)
@@ -3344,5 +3344,5 @@
       !WRITE(*,*) 'd_xt_vdf(iso_eau,1,1),d_q_vdf(1,1)=',d_xt_vdf(iso_eau,1,1),d_q_vdf(1,1)
       !WRITE(*,*) 'bidouille_anti_divergence=',bidouille_anti_divergence
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
 !        WRITE(*,*) 'physiq 2665: d_q_vdf,d_xt_vdf(iso_eau,554,19)=',d_q_vdf(554,19),d_xt_vdf(iso_eau,554,19)
 !        WRITE(*,*) 'd_q_vdf,d_xt_vdf(iso_eau,2,1)=',d_q_vdf(2,1),d_xt_vdf(iso_eau,2,1)
@@ -3369,12 +3369,12 @@
       enddo  !i=1,klon
       endif !if (iso_eau.gt.0) THEN
-      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+      IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
         do i=1,klon 
          do k=1,klev 
-            if (q_seri(i,k).gt.ridicule) THEN
-               if (iso_verif_o18_aberrant_nostop( &
+            IF (q_seri(i,k).gt.ridicule) THEN
+               IF (iso_verif_o18_aberrant_nostop( &
                     xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                     xt_seri(iso_O18,i,k)/q_seri(i,k), &
-                    'physiq 4177, apres pbl_surface').eq.1) THEN
+                    'physiq 4177, apres pbl_surface').EQ.1) THEN
                   WRITE(*,*) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k)
                   stop
@@ -3383,5 +3383,5 @@
           enddo !k=1,klev
          enddo  !i=1,klon
-        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+        endif !if ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
         !WRITE(*,*) 'physiq tmp 2689'
 #endif
@@ -3661,5 +3661,5 @@
         enddo !do i = 1, klon
        enddo    !do k = 1, klev 
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
       CALL iso_verif_egalite_vect2D( &
                  xt_seri,q_seri, &
@@ -3669,17 +3669,17 @@
                  'physiq 2704b, wake_deltaq',ntraciso,klon,klev)
       endif
-      if (iso_HDO.gt.0) THEN
+      IF (iso_HDO.gt.0) THEN
       CALL iso_verif_aberrant_enc_vect2D( &
                  xt_seri,q_seri, &
                  'physiq 2709, avant calcul undi',ntraciso,klon,klev)
       endif
-      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+      IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
         do k = 1, klev
         do i = 1, klon
-            if (q_seri(i,k).gt.ridicule) THEN
-               if (iso_verif_o18_aberrant_nostop( &
+            IF (q_seri(i,k).gt.ridicule) THEN
+               IF (iso_verif_o18_aberrant_nostop( &
                     xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                     xt_seri(iso_O18,i,k)/q_seri(i,k), &
-                    'physiq 2947, avant calcul undi').eq.1) THEN
+                    'physiq 2947, avant calcul undi').EQ.1) THEN
                   WRITE(*,*) 'physic 3315: i,k,q_seri(i,k)=',i,k,q_seri(i,k)
                   stop
@@ -3688,5 +3688,5 @@
         enddo !do i = 1, klon
         enddo !do k = 1, klev
-        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+        endif !if ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
 #endif 
 #endif   
@@ -3710,13 +3710,13 @@
                 enddo
 #ifdef ISOVERIF
-                if (iso_eau.gt.0) THEN
+                IF (iso_eau.gt.0) THEN
                   CALL iso_verif_egalite(wake_deltaq(i,k),wake_deltaxt(iso_eau,i,k),'physiq 3337')
                   CALL iso_verif_egalite(q_w(i,k),xt_w(iso_eau,i,k),'physiq 3338')
                 endif
-                if (iso_HDO.gt.0) THEN
-                  if ((iso_verif_aberrant_enc_choix_nostop(xt_x(iso_hdo,i,k),q_x(i,k), &
-                        ridicule,deltalim,'physic 3462a xt_x').eq.1).or. &
+                IF (iso_HDO.gt.0) THEN
+                  IF ((iso_verif_aberrant_enc_choix_nostop(xt_x(iso_hdo,i,k),q_x(i,k), &
+                        ridicule,deltalim,'physic 3462a xt_x').EQ.1).OR. &
                         (iso_verif_aberrant_enc_choix_nostop(xt_w(iso_hdo,i,k),q_w(i,k), &
-                        ridicule,deltalim,'physic 3462b xt_w').eq.1)) THEN
+                        ridicule,deltalim,'physic 3462b xt_w').EQ.1)) THEN
                      WRITE(*,*) 'i,k=',i,k
                      WRITE(*,*) 'q_x(i,k),q_seri(i,k),wake_s(i),wake_deltaq(i,k)=', &
@@ -3748,5 +3748,5 @@
 
 #ifdef ISOVERIF
-         if (iso_eau.gt.0) THEN
+         IF (iso_eau.gt.0) THEN
            DO k=1,klev
             DO i=1,klon
@@ -3835,5 +3835,5 @@
            enddo ! do ixt=1,ntraciso 
            CALL iso_verif_positif(q_seri(i,k),'physic 3133a')
-           if (iso_eau.gt.0) THEN
+           IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix( &
                  xt_seri(iso_eau,i,k),q_seri(i,k), &
@@ -3846,16 +3846,16 @@
                 'physic 2559c',errmax,errmaxrel)
            endif !if (iso_eau.gt.0) THEN
-           if (iso_HDO.gt.0) THEN
-             if (q_seri(i,k).gt.ridicule) THEN
+           IF (iso_HDO.gt.0) THEN
+             IF (q_seri(i,k).gt.ridicule) THEN
               CALL iso_verif_aberrant_encadre( &
                  xt_seri(iso_hdo,i,k)/q_seri(i,k), &
                 'physic 2657a')
              endif !if (q_seri(i,k).gt.ridicule) THEN
-             if (q_x(i,k).gt.ridicule) THEN
+             IF (q_x(i,k).gt.ridicule) THEN
               CALL iso_verif_aberrant_encadre( &
                  xt_x(iso_hdo,i,k)/q_x(i,k), &
                 'physic 2657b')
              endif !if (q_x(i,k).gt.ridicule) THEN
-             if (q_w(i,k).gt.ridicule) THEN
+             IF (q_w(i,k).gt.ridicule) THEN
               CALL iso_verif_aberrant_encadre( &
                  xt_w(iso_hdo,i,k)/q_w(i,k), &
@@ -3863,6 +3863,6 @@
              endif !if (q_x(i,k).gt.ridicule) THEN
            endif !if (iso_HDO.gt.0) THEN
-           if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
-            if (q_seri(i,k).gt.ridicule) THEN
+           IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
+            IF (q_seri(i,k).gt.ridicule) THEN
              CALL iso_verif_O18_aberrant( &
                     xt_seri(iso_HDO,i,k)/q_seri(i,k), &
@@ -3870,23 +3870,23 @@
                     'physiq 3285')
             endif ! if (q_seri(i,k).gt.ridicule) THEN
-           endif ! if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
-           if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-             if ((q_seri(i,k).gt.ridicule).and.(k.lt.nlevmaxO17)) THEN
+           endif ! if ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
+           IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+             IF ((q_seri(i,k).gt.ridicule).AND.(k.lt.nlevmaxO17)) THEN
               CALL iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
                  /q_seri(i,k),xt_seri(iso_o18,i,k) &
                  /q_seri(i,k),'physiq 2781: avat clmain')
              endif !if (q_seri(i,k).gt.ridicule) THEN
-           endif ! if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+           endif ! if ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
 #ifdef ISOTRAC 
            CALL iso_verif_traceur(xt_seri(1,i,k),'physiq 2975a')
            CALL iso_verif_traceur(xt_x(1,i,k),'physiq 2975b')
            CALL iso_verif_traceur(xt_w(1,i,k),'physiq 2975b')
-           if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k), &
+           IF (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k), &
                  'physiq 3060, avantconcvl',1e-5) &
-                 .eq.1) THEN
+                 .EQ.1) THEN
               WRITE(*,*) 'i,k=',i,k
               stop
             endif !if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k),
-            if (option_tmin.eq.1) THEN
+            IF (option_tmin.EQ.1) THEN
                CALL iso_verif_trac17_q_deltaD(xt_seri(1,i,k), &
                  'physiq 1456, avant concvl')
@@ -3897,5 +3897,5 @@
 #endif
 !ISOVERIF         
-          if ((bidouille_anti_divergence).and. &
+          IF ((bidouille_anti_divergence).AND. &
                  (iso_eau.gt.0)) THEN
            do k=1,klev
@@ -3906,5 +3906,5 @@
             enddo !do i=1,klon
            enddo !do k=1,klev
-          endif !if ((bidouille_anti_divergence).and. &       
+          endif !if ((bidouille_anti_divergence).AND. &
 #endif 
           !jyg<
@@ -3975,10 +3975,10 @@
       CALL iso_verif_noNaN_vect2D(xt_seri, &
                  'physiq 3203b apres conv',ntraciso,klon,klev)
-      if (iso_HDO.gt.0) THEN
+      IF (iso_HDO.gt.0) THEN
       CALL iso_verif_aberrant_enc_vect2D( &
                  xt_seri,q_seri, &
                  'physiq 3619a',ntraciso,klon,klev)
       endif
-      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+      IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
       CALL iso_verif_O18_aberrant_enc_vect2D( &
                  xt_seri,q_seri, &
@@ -4119,5 +4119,5 @@
           ! où i n'est pas un point convectif et donc ibas_con(i)=0
           ! c'est un pb indépendant des isotopes
-          if (ibas_con(i) > 0) THEN
+          IF (ibas_con(i) > 0) THEN
              ema_pcb(i)  = paprs(i,ibas_con(i))
           else
@@ -4286,10 +4286,10 @@
 #ifdef ISOVERIF
      WRITE(*,*) 'physiq 3425: apres convection'
-      if (iso_HDO.gt.0) THEN
+      IF (iso_HDO.gt.0) THEN
       CALL iso_verif_aberrant_enc_vect2D( &
                  xt_seri,q_seri, &
                  'physiq 3691a',ntraciso,klon,klev)
       endif
-      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+      IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
       CALL iso_verif_O18_aberrant_enc_vect2D( &
                  xt_seri,q_seri, &
@@ -4377,5 +4377,5 @@
         DO k = 1,klev
           DO i=1,klon
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite(q_seri(i,k),xt_seri(iso_eau,i,k),'physiq 3981a')
               CALL iso_verif_egalite(dq_dwn(i,k),dxt_dwn(iso_eau,i,k),'physiq 3981b')
@@ -4419,5 +4419,5 @@
         DO k = 1,klev
           DO i=1,klon
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
               CALL iso_verif_egalite(d_q_wake(i,k),d_xt_wake(iso_eau,i,k),'physiq 4023a')
               CALL iso_verif_egalite(q_x(i,k),xt_x(iso_eau,i,k),'physiq 4023b')
@@ -4520,27 +4520,27 @@
          do k=1,klev
            do i=1,klon
-             if (iso_eau.gt.0) THEN
+             IF (iso_eau.gt.0) THEN
                 CALL iso_verif_egalite_choix(xt_seri(iso_eau,i,k), &
                        q_seri(i,k),'physiq 2765',errmax,errmaxrel)
              endif !if (iso_eau.gt.0) THEN
-             if (iso_HDO.gt.0) THEN
-               if (q_seri(i,k).gt.ridicule) THEN
+             IF (iso_HDO.gt.0) THEN
+               IF (q_seri(i,k).gt.ridicule) THEN
                   CALL iso_verif_aberrant_encadre(xt_seri(iso_HDO,i,k)/ &
                        q_seri(i,k),'physiq 2770')
                endif !if (abs(d_q_ajs(i,k)).gt.ridicule) THEN
              endif !if (iso_HDO.gt.0) THEN
-             if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
-               if (q_seri(i,k).gt.ridicule) THEN
-                 if (iso_verif_o18_aberrant_nostop( &
+             IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
+               IF (q_seri(i,k).gt.ridicule) THEN
+                 IF (iso_verif_o18_aberrant_nostop( &
                     xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                     xt_seri(iso_O18,i,k)/q_seri(i,k), &
-                    'physiq 3978, avant calltherm').eq.1) THEN
+                    'physiq 3978, avant calltherm').EQ.1) THEN
                   WRITE(*,*) 'physic 4115: i,k,q_seri(i,k)=',i,k,q_seri(i,k)
                   stop
                  endif !  if (iso_verif_o18_aberrant_nostop 
                endif !if (q_seri(i,k).gt.errmax) THEN
-             endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
-             if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-               if ((q_seri(i,k).gt.ridicule).and.(k.lt.nlevmaxO17)) THEN
+             endif !if ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
+             IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+               IF ((q_seri(i,k).gt.ridicule).AND.(k.lt.nlevmaxO17)) THEN
                  CALL iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
                  /q_seri(i,k),xt_seri(iso_o18,i,k) &
@@ -4550,7 +4550,7 @@
 #ifdef ISOTRAC      
         CALL iso_verif_traceur(xt_seri(1,i,k),'physiq 3389')
-        if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k), &
+        IF (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k), &
                  'physiq 3481, avant ajsec',1e-5) &
-                 .eq.1) THEN
+                 .EQ.1) THEN
               WRITE(*,*) 'i,k=',i,k
 #ifdef ISOVERIF
@@ -4565,5 +4565,5 @@
 #endif
 !#ifdef ISOVERIF         
-       if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) THEN
+       IF ((iso_eau.gt.0).AND.(bidouille_anti_divergence)) THEN
         do k=1,klev   
         do i=1,klon
@@ -4575,5 +4575,5 @@
                   klon,klev)
 #endif        
-      endif !if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) THEN
+      endif !if ((iso_eau.gt.0).AND.(bidouille_anti_divergence)) THEN
 #endif
 !#ifdef ISO      
@@ -4603,5 +4603,5 @@
 ! Tests Fredho, instensibilite au pas de temps -------------------------------
 ! A detruire en 2024 une fois les tests documentes et les choix faits        !
-          if (iflag_thermals_tenv /10 == 0 ) then                            !
+          IF (iflag_thermals_tenv /10 == 0 ) then                            !
             do k=1,klev                                                      !
                do i=1,klon                                                   !
@@ -4615,5 +4615,5 @@
                enddo                                                         !
             enddo                                                            !
-          else if (iflag_thermals_tenv / 10 == 2 ) then                      !
+          ELSE IF (iflag_thermals_tenv / 10 == 2 ) then                      !
             do k=1,klev                                                      !
                do i=1,klon                                                   !
@@ -4626,5 +4626,5 @@
                enddo                                                         !
             enddo                                                            !
-          else if (iflag_thermals_tenv / 10 == 3 ) then                      !
+          ELSE IF (iflag_thermals_tenv / 10 == 3 ) then                      !
             do k=1,klev                                                      !
                do i=1,klon                                                   !
@@ -4691,5 +4691,5 @@
           ! Ne change pas les resultats avec les isotopes tant qu'on
           ! tourne avec le defaut : iflag_thermals_tenv=0
-          if ( iflag_thermals_tenv /= 0 ) THEN
+          IF ( iflag_thermals_tenv /= 0 ) THEN
               abort_message ='iflag_thermals_env/=0 : non prevu avec les isotopes'
               CALL abort_physic (modname,abort_message,1)
@@ -4789,5 +4789,5 @@
           ! Transport de la TKE par les panaches thermiques.
           ! FH : 2010/02/01
-               if (iflag_thermcell_tke==1) THEN
+               IF (iflag_thermcell_tke==1) THEN
                CALL thermcell_dtke(klon,klev,nbsrf,pdtphys,fm_therm,entr_therm,rg,paprs,pbl_tke)
                endif
@@ -4809,5 +4809,5 @@
        ! Dans le cas contraire, on demarre au niveau 1.
 
-       IF (iflag_thermals>=13.or.iflag_thermals<=0) THEN
+       IF (iflag_thermals>=13.OR.iflag_thermals<=0) THEN
 
           IF (iflag_thermals==0) THEN
@@ -4831,22 +4831,22 @@
 #ifdef ISOVERIF
       WRITE(*,*) 'physiq 3691c: avant CALL ajsec'
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
       CALL iso_verif_egalite_vect2D( &
                  xt_seri,q_seri, &
                  'physiq 3727, avant ajsec',ntraciso,klon,klev)
       endif
-      if (iso_HDO.gt.0) THEN
+      IF (iso_HDO.gt.0) THEN
       CALL iso_verif_aberrant_enc_vect2D( &
                  xt_seri,q_seri, &
                  'physiq 3732, avant ajsec',ntraciso,klon,klev)
       endif    
-      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+      IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
         do k = 1, klev
         do i = 1, klon 
-            if (q_seri(i,k).gt.ridicule) THEN
-               if (iso_verif_o18_aberrant_nostop( &
+            IF (q_seri(i,k).gt.ridicule) THEN
+               IF (iso_verif_o18_aberrant_nostop( &
                     xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                     xt_seri(iso_O18,i,k)/q_seri(i,k), &
-                    'physiq 4051, avant ajsec').eq.1) THEN
+                    'physiq 4051, avant ajsec').EQ.1) THEN
                   WRITE(*,*) 'physiq 4367: i,k,q_seri(i,k)=',i,k,q_seri(i,k)
                   stop
@@ -4855,5 +4855,5 @@
         enddo !do i = 1, klon
         enddo !do k = 1, klev
-        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+        endif !if ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_vect(xt_seri,klon,klev, &
@@ -4943,10 +4943,10 @@
 #endif         
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
       CALL iso_verif_egalite_vect2D( &
                  xt_seri,q_seri, &
                  'physiq 3709, avant ilp',ntraciso,klon,klev)
       endif
-      if (iso_HDO.gt.0) THEN
+      IF (iso_HDO.gt.0) THEN
       CALL iso_verif_aberrant_enc_vect2D( &
                  xt_seri,q_seri, &
@@ -4957,6 +4957,6 @@
        do k=1,klev
         do i=1,klon
-           if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
-            if ((q_seri(i,k).gt.ridicule).and.(k.lt.nlevmaxO17)) THEN
+           IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
+            IF ((q_seri(i,k).gt.ridicule).AND.(k.lt.nlevmaxO17)) THEN
              CALL iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
                  /q_seri(i,k),xt_seri(iso_o18,i,k) &
@@ -4964,22 +4964,22 @@
             endif !if (q_seri(i,k).gt.ridicule) THEN
            endif !if (iso_O17.gt.0) THEN
-           if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
-            if (q_seri(i,k).gt.ridicule) THEN
-               if (iso_verif_o18_aberrant_nostop( &
+           IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
+            IF (q_seri(i,k).gt.ridicule) THEN
+               IF (iso_verif_o18_aberrant_nostop( &
                     xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                     xt_seri(iso_O18,i,k)/q_seri(i,k), &
-                    'physiq 4177, avant il pleut').eq.1) THEN
+                    'physiq 4177, avant il pleut').EQ.1) THEN
                   WRITE(*,*) 'physic 4475: i,k,q_seri(i,k)=',i,k,q_seri(i,k)
                   stop
               endif !  if (iso_verif_o18_aberrant_nostop 
             endif !if (q_seri(i,k).gt.errmax) THEN
-        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+        endif !if ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
 #ifdef ISOTRAC      
         CALL iso_verif_traceur(xt_seri(1,i,k),'physiq 3609')
         CALL iso_verif_traceur_pbidouille(xt_seri(1,i,k), &
                  'physiq 3609')
-        if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k), &
+        IF (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k), &
                  'physiq 3707, avant fisrtilp',1e-5) &
-                 .eq.1) THEN
+                 .EQ.1) THEN
               WRITE(*,*) 'i,k=',i,k
 #ifdef ISOVERIF
@@ -4987,5 +4987,5 @@
 #endif
          endif
-         if (option_tmin.eq.1) THEN
+         IF (option_tmin.EQ.1) THEN
                CALL iso_verif_trac17_q_deltaD(xt_seri(1,i,k), &
                  'physiq 3905, avant ilp')
@@ -5008,5 +5008,5 @@
 #endif     
 !ISOVERIF
-          if ((bidouille_anti_divergence).and. &
+          IF ((bidouille_anti_divergence).AND. &
                  (iso_eau.gt.0)) THEN
            do k=1,klev
@@ -5015,5 +5015,5 @@
             enddo !do i=1,klon
            enddo !do k=1,klev
-          endif !if ((bidouille_anti_divergence).and. &   
+          endif !if ((bidouille_anti_divergence).AND. &
 #endif
 !ISO
@@ -5074,9 +5074,9 @@
       DO k = 1, klev
         do i=1,klon
-        if (iso_O18.gt.0.and.iso_HDO.gt.0) THEN
-        if (ql_seri(i,k).gt.ridicule) THEN
+        IF (iso_O18.gt.0.AND.iso_HDO.gt.0) THEN
+        IF (ql_seri(i,k).gt.ridicule) THEN
                CALL iso_verif_aberrant( &
                  xtl_seri(iso_HDO,i,k)/ql_seri(i,k),'physiq 4330')
-               if (iso_O18.gt.0) THEN
+               IF (iso_O18.gt.0) THEN
                  CALL iso_verif_o18_aberrant( &
                         xtl_seri(iso_HDO,i,k)/ql_seri(i,k), &
@@ -5178,10 +5178,10 @@
 #endif
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
       CALL iso_verif_egalite_vect2D( &
                  xt_seri,q_seri, &
                  'physiq 2599, apres ajout lsc',ntraciso,klon,klev)
       endif
-      if (iso_HDO.gt.0) THEN
+      IF (iso_HDO.gt.0) THEN
       CALL iso_verif_aberrant_enc_vect2D( &
                  xt_seri,q_seri, &
@@ -5192,16 +5192,16 @@
       DO k = 1, klev
       DO i = 1, klon
-          if (iso_eau.gt.0) THEN
+          IF (iso_eau.gt.0) THEN
            CALL iso_verif_egalite_choix( &
                  xtl_seri(iso_eau,i,k),ql_seri(i,k), &
                   'physiq 2601',errmax,errmaxrel)
           endif !if (iso_eau.gt.0) THEN
-          if (iso_HDO.gt.0) THEN
-            if (q_seri(i,k).gt.ridicule) THEN
-              if (iso_O18.gt.0) THEN
-               if (iso_verif_o18_aberrant_nostop( &
+          IF (iso_HDO.gt.0) THEN
+            IF (q_seri(i,k).gt.ridicule) THEN
+              IF (iso_O18.gt.0) THEN
+               IF (iso_verif_o18_aberrant_nostop( &
                     xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                     xt_seri(iso_O18,i,k)/q_seri(i,k), &
-                    'physiq 2863, after il pleut').eq.1) THEN
+                    'physiq 2863, after il pleut').EQ.1) THEN
                   WRITE(*,*) 'physic 4656: i,k,q_seri(i,k)=',i,k,q_seri(i,k)
                   stop
@@ -5209,12 +5209,12 @@
               endif ! if (iso_O18.gt.0) THEN
             endif !if (q_seri(i,k).gt.errmax) THEN
-            if (ql_seri(i,k).gt.ridicule) THEN
+            IF (ql_seri(i,k).gt.ridicule) THEN
                CALL iso_verif_aberrant_choix(xtl_seri(iso_HDO,i,k),ql_seri(i,k), &
                         ridicule,deltalim_snow,'physiq 2871')
-               if (iso_O18.gt.0) THEN
-                 if (iso_verif_o18_aberrant_nostop( &
+               IF (iso_O18.gt.0) THEN
+                 IF (iso_verif_o18_aberrant_nostop( &
                         xtl_seri(iso_HDO,i,k)/ql_seri(i,k), &
                         xtl_seri(iso_O18,i,k)/ql_seri(i,k), &
-                        'physiq 2872, after il pleut').eq.1) THEN
+                        'physiq 2872, after il pleut').EQ.1) THEN
                         WRITE(*,*) 'i,k,ql_seri(i,k)=',i,k,ql_seri(i,k)
                         WRITE(*,*) 'd_ql_lsc(i,k)=',d_ql_lsc(i,k)
@@ -5230,8 +5230,8 @@
        ENDDO ! i=1,klon
       ENDDO !DO k = 1, klev
-      if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+      IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN
         do i=1,klon 
           do k=1,nlev
-           if ((q_seri(i,k).gt.ridicule).and.(k.lt.nlevmaxO17)) THEN
+           IF ((q_seri(i,k).gt.ridicule).AND.(k.lt.nlevmaxO17)) THEN
             CALL iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
                  /q_seri(i,k),xt_seri(iso_o18,i,k) &
@@ -5246,13 +5246,13 @@
 #ifdef ISOVERIF       
       CALL iso_verif_traceur_vect(xt_seri,klon,klev,'physiq 3794')
-      if (option_tmin.eq.1) THEN
-      if (nzone_temp.ge.5) THEN
+      IF (option_tmin.EQ.1) THEN
+      IF (nzone_temp.ge.5) THEN
             CALL iso_verif_tag17_q_deltaD_vect(xt_seri,klon,klev, &
                 'physiq 3385: apres ilp')
       endif ! if (nzone_temp.ge.5) THEN
-      endif !if (option_tmin.eq.1) THEN
+      endif !if (option_tmin.EQ.1) THEN
 #endif   
 !#ifdef ISOVERIF                
-      if (bidouille_anti_divergence) THEN
+      IF (bidouille_anti_divergence) THEN
           CALL iso_verif_traceur_jbid_vect(xt_seri, &
                   klon,klev)
@@ -5261,5 +5261,5 @@
         ! si tag 22, on recolorise les zones très convectives dans les
         ! tropiques
-        if (option_traceurs.eq.22) THEN
+        IF (option_traceurs.EQ.22) THEN
           CALL isotrac_recolorise_conv(xt_seri,latitude_deg,presnivs,rain_con)
         endif
@@ -5298,5 +5298,5 @@
 
     !IM cf FH
-    !     IF (iflag_cld_th.eq.-1) THEN ! seulement pour Tiedtke
+    !     IF (iflag_cld_th.EQ.-1) THEN ! seulement pour Tiedtke
     IF (iflag_cld_th<=-1) THEN ! seulement pour Tiedtke
        snow_tiedtke=0.
@@ -5417,5 +5417,5 @@
     !        do i=1,klon
     !              zzz=prfl(:,k)+psfl(:,k)
-    !           if (.not.ptconvth.zzz.gt.0.)
+    !           if (.NOT.ptconvth.zzz.gt.0.)
     !        enddo prfl, psfl,
     !     enddo
@@ -5452,19 +5452,19 @@
       ENDDO !DO i = 1, klon
 #ifdef ISOVERIF
-      if (iso_eau.gt.0) THEN
+      IF (iso_eau.gt.0) THEN
         DO i = 1, klon          
           CALL iso_verif_egalite_choix(xtsnow_fall(iso_eau,i), &
                  snow_fall(i),'physiq 3387', &
                  errmax,errmaxrel)
-          if (iso_verif_positif_nostop(xtrain_lsc(iso_eau,i), &
-                 'physiq 4298').eq.1) THEN
-            if (rain_lsc(i).ge.0.0) THEN
+          IF (iso_verif_positif_nostop(xtrain_lsc(iso_eau,i), &
+                 'physiq 4298').EQ.1) THEN
+            IF (rain_lsc(i).ge.0.0) THEN
               WRITE(*,*) 'rain_fall(i)=',rain_lsc(i)
               stop
             endif !if (rain_con(i).ge.0.0) THEN
           endif  !if (iso_verif_positif_nostop
-          if (iso_verif_positif_nostop(xtrain_fall(iso_eau,i), &
-                 'physiq 3405').eq.1) THEN
-            if (rain_fall(i).ge.0.0) THEN
+          IF (iso_verif_positif_nostop(xtrain_fall(iso_eau,i), &
+                 'physiq 3405').EQ.1) THEN
+            IF (rain_fall(i).ge.0.0) THEN
               WRITE(*,*) 'rain_fall(i)=',rain_fall(i)
               stop
@@ -5473,5 +5473,5 @@
         ENDDO !DO i = 1, klon   
       endif !if (iso_eau.gt.0) THEN
-      if (iso_HDO.gt.0) THEN
+      IF (iso_HDO.gt.0) THEN
           DO i = 1, klon
           CALL iso_verif_aberrant_choix(xtsnow_fall(iso_hdo,i), &
@@ -5501,5 +5501,5 @@
 #endif 
 #ifdef ISO 
-        if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) THEN
+        IF ((iso_eau.gt.0).AND.(bidouille_anti_divergence)) THEN
         do i=1,klon
             xtrain_fall(iso_eau,i)=rain_fall(i)
@@ -5514,5 +5514,5 @@
           zx_t = t_seri(i,k)
           IF (thermcep) THEN
-             !!           if (iflag_ice_thermo.eq.0) then                 !jyg
+             !!           if (iflag_ice_thermo.EQ.0) then                 !jyg
              zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
              !!           else                                            !jyg
@@ -6329,5 +6329,5 @@
     ENDIF
 
-    IF (.not. ok_hines .and. ok_gwd_rando) THEN
+    IF (.NOT. ok_hines .AND. ok_gwd_rando) THEN
        ! ym missing init for east_gwstress & west_gwstress -> added in phys_local_var_mod
        CALL acama_GWD_rando(PHYS_TSTEP, pplay, latitude_deg, t_seri, u_seri, &
@@ -6397,5 +6397,5 @@
     !IM calcul composantes axiales du moment angulaire et couple des montagnes
 
-    IF (is_sequential .and. ok_orodr) THEN 
+    IF (is_sequential .AND. ok_orodr) THEN
        CALL aaam_bud (27,klon,klev,jD_cur-jD_ref,jH_cur, &
             ra,rg,romega, &
@@ -6589,12 +6589,12 @@
                  'physiq 5924, juste apres methox',ntraciso,klon,klev)
 END IF
-      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+      IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
         do i=1,klon 
          do k=1,klev 
-            if (q_seri(i,k).gt.ridicule) THEN
-               if (iso_verif_o18_aberrant_nostop( &
+            IF (q_seri(i,k).gt.ridicule) THEN
+               IF (iso_verif_o18_aberrant_nostop( &
                     xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                     xt_seri(iso_O18,i,k)/q_seri(i,k), &
-                    'physiq 5937a, juste apres methox, qv').eq.1) THEN
+                    'physiq 5937a, juste apres methox, qv').EQ.1) THEN
                   WRITE(*,*) 'physic 2444: i,k,q_seri(i,k)=',i,k,q_seri(i,k)
                   WRITE(*,*) 'xt_seri(:,i,k)=',xt_seri(:,i,k)
@@ -6602,18 +6602,18 @@
               endif !  if (iso_verif_o18_aberrant_nostop 
             endif !if (q_seri(i,k).gt.errmax) THEN
-            if (ql_seri(i,k).gt.ridicule) THEN
-               if (iso_verif_o18_aberrant_nostop( &
+            IF (ql_seri(i,k).gt.ridicule) THEN
+               IF (iso_verif_o18_aberrant_nostop( &
                     xtl_seri(iso_HDO,i,k)/ql_seri(i,k), &
                     xtl_seri(iso_O18,i,k)/ql_seri(i,k), &
-                    'physiq 5937b, juste apres methox, ql').eq.1) THEN
+                    'physiq 5937b, juste apres methox, ql').EQ.1) THEN
                   WRITE(*,*) 'i,k,ql_seri(i,k)=',i,k,ql_seri(i,k)
                   !stop
               endif !  if (iso_verif_o18_aberrant_nostop 
             endif !if (q_seri(i,k).gt.errmax) THEN
-            if (qs_seri(i,k).gt.ridicule) THEN
-               if (iso_verif_o18_aberrant_nostop( &
+            IF (qs_seri(i,k).gt.ridicule) THEN
+               IF (iso_verif_o18_aberrant_nostop( &
                     xts_seri(iso_HDO,i,k)/qs_seri(i,k), &
                     xts_seri(iso_O18,i,k)/qs_seri(i,k), &
-                    'physiq 5937c, juste apres methox, qs').eq.1) THEN
+                    'physiq 5937c, juste apres methox, qs').EQ.1) THEN
                   WRITE(*,*) 'i,k,qs_seri(i,k)=',i,k,qs_seri(i,k)
                   !stop
@@ -6622,5 +6622,5 @@
           enddo !k=1,klev
          enddo  !i=1,klon
-        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+        endif !if ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN
 #endif
 #endif
@@ -6634,5 +6634,5 @@
        ! adeclarer 
 #ifdef CPP_COSP
-       IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
+       IF (itap.EQ.1.OR.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
 
           IF (prt_level .GE.10) THEN
@@ -6665,5 +6665,5 @@
 
 #ifdef CPP_COSP2
-       IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
+       IF (itap.EQ.1.OR.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
 
           IF (prt_level .GE.10) THEN
@@ -6689,5 +6689,5 @@
 
 #ifdef CPP_COSPV2
-       IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
+       IF (itap.EQ.1.OR.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
 !        IF (MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
 
@@ -6738,10 +6738,10 @@
       CALL iso_verif_noNaN_vect2D(xt_seri, &
            'physiq 5607: apres appel tritium',ntraciso,klon,klev)
-       if (iso_HTO.gt.0) then ! Tritium
+       IF (iso_HTO.gt.0) then ! Tritium
        ixt=iso_HTO
        do i=1,klon
        do k=1,klev
-          if (iso_verif_positif_strict_nostop(xt_seri(ixt,i,k), &
-            'physiq 5620 : xt_seri(HTO) nul ou negatif').eq.1) THEN
+          IF (iso_verif_positif_strict_nostop(xt_seri(ixt,i,k), &
+            'physiq 5620 : xt_seri(HTO) nul ou negatif').EQ.1) THEN
           WRITE(*,*) 'ixt,i,klon,k,klev=',ixt,i,klon,k,klev
           WRITE(*,*) 'xt_seri(iso_HTO,i,k)=',xt_seri(ixt,i,k)
@@ -6762,5 +6762,5 @@
 
   IF (ok_airs) THEN
-  IF (itap==1.or.MOD(itap,NINT(freq_airs/phys_tstep))==0) THEN
+  IF (itap==1.OR.MOD(itap,NINT(freq_airs/phys_tstep))==0) THEN
      WRITE(*,*) 'je vais appeler simu_airs, ok_airs, freq_airs=', ok_airs, freq_airs
      CALL simu_airs(itap,rneb, t_seri, cldemi, fiwc, ref_ice, pphi, pplay, paprs,&
@@ -7066,9 +7066,9 @@
           ENDIF
           !--ice_sursat: nqo=4, on ajoute rneb
-          IF (nqo>=4 .and. ok_ice_sursat) THEN
+          IF (nqo>=4 .AND. ok_ice_sursat) THEN
              d_qx(i,k,irneb) = ( rneb_seri(i,k) - qx(i,k,irneb) ) / phys_tstep
           ENDIF
 
-           IF (nqo>=4 .and. ok_bs) THEN
+           IF (nqo>=4 .AND. ok_bs) THEN
              d_qx(i,k,ibs) = ( qbs_seri(i,k) - qx(i,k,ibs) ) / phys_tstep
           ENDIF
@@ -7087,5 +7087,5 @@
           iq=iqIsoPha(ixt,iliq)
           d_qx(i,k,iq) = ( xtl_seri(ixt,i,k) - qx(i,k,iq) ) / phys_tstep
-          if (nqo.eq.3) THEN
+          IF (nqo.EQ.3) THEN
              iq=iqIsoPha(ixt,isol)
              d_qx(i,k,iq) = ( xts_seri(ixt,i,k) - qx(i,k,iq) ) / phys_tstep
@@ -7268,5 +7268,5 @@
 
     ! Petit appelle de sorties pour accompagner le travail sur phyex
-    if ( iflag_physiq == 1 ) THEN
+    IF ( iflag_physiq == 1 ) THEN
         CALL output_physiqex(debut,jD_eq,pdtphys,presnivs,paprs,u,v,t,qx,cldfra,0.*t,0.*t,0.*t,pbl_tke,theta)
     endif
@@ -7298,5 +7298,5 @@
          do k=1,klev
           do i=1,klon
-            if (iso_eau.gt.0) THEN
+            IF (iso_eau.gt.0) THEN
                CALL iso_verif_egalite_choix(xt_ancien(iso_eau,i,k), &
                  q_ancien(i,k),'physiq 3728: avant phyisoredem', &
@@ -7341,5 +7341,5 @@
           ENDIF
 
-          IF (is_omp_master .and. grid_type==unstructured) CALL xios_context_finalize
+          IF (is_omp_master .AND. grid_type==unstructured) CALL xios_context_finalize
        ENDIF
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmdiso/reevap.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmdiso/reevap.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/phylmdiso/reevap.F90	(revision 5117)
@@ -19,8 +19,8 @@
 
     INTEGER klon,klev,iflag_ice_thermo
-    REAL, DIMENSION(klon,klev), INTENT(in) :: t_seri
-    REAL, DIMENSION(klon,klev,nqtot), INTENT(in) ::     qx
-    REAL, DIMENSION(klon,klev), INTENT(out) :: d_t_eva
-    REAL, DIMENSION(klon,klev,nqtot), INTENT(out) ::        d_qx_eva
+    REAL, DIMENSION(klon,klev), INTENT(IN) :: t_seri
+    REAL, DIMENSION(klon,klev,nqtot), INTENT(IN) ::     qx
+    REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_eva
+    REAL, DIMENSION(klon,klev,nqtot), INTENT(OUT) ::        d_qx_eva
 
     REAL za,zb,zdelta,zlvdcp,zlsdcp
@@ -45,6 +45,6 @@
        DO i = 1, klon
 
-        if (ixt==1) THEN
-         if (fl_cor_ebil > 0) THEN
+        IF (ixt==1) THEN
+         IF (fl_cor_ebil > 0) THEN
           !zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
           !zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
@@ -72,5 +72,5 @@
              d_t_eva(i,k) = za
 
-          endif !if (ixt.eq.1) THEN
+          endif !if (ixt.EQ.1) THEN
             !zb = MAX(0.0,ql_seri(i,k)+qs_seri(i,k))
             !d_q_eva(i,k) = zb
